--- loncom/interface/loncommon.pm 2013/06/05 13:25:41 1.1075.2.39 +++ loncom/interface/loncommon.pm 2013/12/30 01:31:55 1.1075.2.60 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1075.2.39 2013/06/05 13:25:41 raeburn Exp $ +# $Id: loncommon.pm,v 1.1075.2.60 2013/12/30 01:31:55 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1234,7 +1234,11 @@ sub help_open_topic { $topic=~s/\W/\_/g; if (!$stayOnPage) { - $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');"; + if ($env{'browser.mobile'}) { + $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');"; + } else { + $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))"; + } } elsif ($stayOnPage eq 'popup') { $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))"; } else { @@ -1348,8 +1352,10 @@ sub help_open_menu { sub top_nav_help { my ($text) = @_; $text = &mt($text); - my $stay_on_page = 1; - + my $stay_on_page; + unless ($env{'environment.remote'} eq 'on') { + $stay_on_page = 1; + } my $link = ($stay_on_page) ? "javascript:helpMenu('display')" : "javascript:helpMenu('open')"; my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page); @@ -1358,22 +1364,23 @@ sub top_nav_help { return <<"END"; $banner_link - $text +$text END } sub help_menu_js { - my ($text) = @_; + my ($httphost) = @_; my $stayOnPage = 1; my $width = 620; my $height = 600; my $helptopic=&general_help(); - my $details_link = '/adm/help/'.$helptopic.'.hlp'; + my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp'; my $nothing=&Apache::lonhtmlcommon::javascript_nothing(); my $start_page = &Apache::loncommon::start_page('Help Menu', undef, {'frameset' => 1, 'js_ready' => 1, + 'use_absolute' => $httphost, 'add_entries' => { 'border' => '0', 'rows' => "110,*",},}); @@ -1719,8 +1726,6 @@ RESIZE =head1 Excel and CSV file utility routines -=over 4 - =cut ############################################################### @@ -1728,6 +1733,8 @@ RESIZE =pod +=over 4 + =item * &csv_translate($text) Translate $text to allow it to be output as a 'comma separated values' @@ -2161,7 +2168,7 @@ sub select_level_form { =pod -=item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoma,$excdoms) +=item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) Returns a string containing a '. + ''. $lt{'yes'}.' 
'. @@ -11036,6 +11349,7 @@ sub process_decompression { \%titles,\%children); } if ($env{'form.autoextract_camtasia'}) { + my $version = $env{'form.autoextract_camtasia'}; my %displayed; my $total = 1; $env{'form.archive_directory'} = []; @@ -11054,12 +11368,15 @@ sub process_decompression { $env{'form.archive_'.$i} = 'display'; $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'}; $displayed{'folder'} = $i; - } elsif ($item eq "$contents[0]/index.html") { + } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) || + (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) { $env{'form.archive_'.$i} = 'display'; $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'}; $displayed{'web'} = $i; } else { - if ($item eq "$contents[0]/media") { + if ((($item eq "$contents[0]/media") && ($version == 6)) || + ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") || + ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) { push(@{$env{'form.archive_directory'}},$i); } $env{'form.archive_'.$i} = 'dependency'; @@ -11786,7 +12103,7 @@ sub cleanup_empty_dirs { =pod -=item &get_folder_hierarchy() +=item * &get_folder_hierarchy() Provides hierarchy of names of folders/sub-folders containing the current item, @@ -11896,6 +12213,9 @@ sub get_turnedin_filepath { my $title = $res->compTitle(); $title =~ s/\W+/_/g; if ($title ne '') { + if (($pc > 1) && (length($title) > 12)) { + $title = substr($title,0,12); + } push(@pathitems,$title); } } @@ -11904,6 +12224,9 @@ sub get_turnedin_filepath { my $maptitle = $mapres->compTitle(); $maptitle =~ s/\W+/_/g; if ($maptitle ne '') { + if (length($maptitle) > 12) { + $maptitle = substr($maptitle,0,12); + } push(@pathitems,$maptitle); } unless ($env{'request.state'} eq 'construct') { @@ -11944,6 +12267,9 @@ sub get_turnedin_filepath { $restitle = time; } } + if (length($restitle) > 12) { + $restitle = substr($restitle,0,12); + } push(@pathitems,$restitle); $path .= join('/',@pathitems); } @@ -12881,18 +13207,22 @@ sub restore_settings { =item * &build_recipient_list() -Build recipient lists for five types of e-mail: +Build recipient lists for following types of e-mail: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors -(d) Help requests, (e) Course requests needing approval, generated by -lonerrorhandler.pm, CHECKRPMS, loncron, lonsupportreq.pm and -loncoursequeueadmin.pm respectively. +(d) Help requests, (e) Course requests needing approval, (f) loncapa +module change checking, student/employee ID conflict checks, as +generated by lonerrorhandler.pm, CHECKRPMS, loncron, +lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively. Inputs: -defmail (scalar - email address of default recipient), -mailing type (scalar - errormail, packagesmail, or helpdeskmail), +defmail (scalar - email address of default recipient), +mailing type (scalar: errormail, packagesmail, helpdeskmail, +requestsmail, updatesmail, or idconflictsmail). + defdom (domain for which to retrieve configuration settings), -origmail (scalar - email address of recipient from loncapa.conf, -i.e., predates configuration by DC via domainprefs.pm + +origmail (scalar - email address of recipient from loncapa.conf, +i.e., predates configuration by DC via domainprefs.pm Returns: comma separated list of addresses to which to send e-mail. @@ -13086,7 +13416,7 @@ sub extract_categories { =pod -=item *&recurse_categories() +=item * &recurse_categories() Recursively used to generate breadcrumb trails for course categories. @@ -13157,7 +13487,7 @@ sub recurse_categories { =pod -=item *&assign_categories_table() +=item * &assign_categories_table() Create a datatable for display of hierarchical categories in a domain, with checkboxes to allow a course to be categorized. @@ -13234,7 +13564,7 @@ sub assign_categories_table { =pod -=item *&assign_category_rows() +=item * &assign_category_rows() Create a datatable row for display of nested categories in a domain, with checkboxes to allow a course to be categorized,called recursively. @@ -13268,7 +13598,7 @@ sub assign_category_rows { if (ref($cats->[$depth]{$parent}) eq 'ARRAY') { my $numchildren = @{$cats->[$depth]{$parent}}; my $css_class = $itemcount%2?' class="LC_odd_row"':''; - $text .= ''; + $text .= '
'; for (my $j=0; $j<$numchildren; $j++) { $name = $cats->[$depth]{$parent}[$j]; $item = &escape($name).':'.&escape($parent).':'.$depth; @@ -13552,7 +13882,7 @@ sub check_clone { } sub construct_course { - my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_; + my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_; my $outcome; my $linefeed = '
'."\n"; if ($context eq 'auto') { @@ -13649,7 +13979,8 @@ sub construct_course { 'plc.users.denied', 'hidefromcat', 'checkforpriv', - 'categories'], + 'categories', + 'internal.uniquecode'], $$crsudom,$$crsunum); } @@ -13834,6 +14165,25 @@ sub construct_course { } } +# +# generate and store uniquecode (available to course requester), if course should have one. +# + if ($args->{'uniquecode'}) { + my ($code,$error) = &make_unique_code($$crsudom,$$crsunum); + if ($code) { + $cenv{'internal.uniquecode'} = $code; + my %crsinfo = + &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.'); + if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') { + $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code; + my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime'); + } + if (ref($coderef)) { + $$coderef = $code; + } + } + } + if ($args->{'disresdis'}) { $cenv{'pch.roles.denied'}='st'; } @@ -13902,6 +14252,60 @@ sub construct_course { return (1,$outcome); } +sub make_unique_code { + my ($cdom,$cnum) = @_; + # get lock on uniquecodes db + my $lockhash = { + $cnum."\0".'uniquecodes' => $env{'user.name'}. + ':'.$env{'user.domain'}, + }; + my $tries = 0; + my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom); + my ($code,$error); + + while (($gotlock ne 'ok') && ($tries<3)) { + $tries ++; + sleep 1; + $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom); + } + if ($gotlock eq 'ok') { + my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom); + my $gotcode; + my $attempts = 0; + while ((!$gotcode) && ($attempts < 100)) { + $code = &generate_code(); + if (!exists($currcodes{$code})) { + $gotcode = 1; + unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') { + $error = 'nostore'; + } + } + $attempts ++; + } + my @del_lock = ($cnum."\0".'uniquecodes'); + my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom); + } else { + $error = 'nolock'; + } + return ($code,$error); +} + +sub generate_code { + my $code; + my @letts = qw(B C D G H J K M N P Q R S T V W X Z); + for (my $i=0; $i<6; $i++) { + my $lettnum = int (rand 2); + my $item = ''; + if ($lettnum) { + $item = $letts[int( rand(18) )]; + } else { + $item = 1+int( rand(8) ); + } + $code .= $item; + } + return $code; +} + ############################################################ ############################################################ @@ -13929,11 +14333,12 @@ sub group_term { } sub course_types { - my @types = ('official','unofficial','community'); + my @types = ('official','unofficial','community','textbook'); my %typename = ( official => 'Official course', unofficial => 'Unofficial course', community => 'Community', + textbook => 'Textbook course', ); return (\@types,\%typename); } @@ -14066,7 +14471,7 @@ sub init_user_environment { # ------------------------------------ Check browser type and MathML capability my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml, - $clientunicode,$clientos) = &decode_user_agent($r); + $clientunicode,$clientos,$clientmobile,$clientinfo) = &decode_user_agent($r); # ------------------------------------------------------------- Get environment @@ -14097,6 +14502,8 @@ sub init_user_environment { "browser.mathml" => $clientmathml, "browser.unicode" => $clientunicode, "browser.os" => $clientos, + "browser.mobile" => $clientmobile, + "browser.info" => $clientinfo, "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'}, "request.course.fn" => '', "request.course.uri" => '', @@ -14116,6 +14523,12 @@ sub init_user_environment { $env{'browser.interface'}=$form->{'interface'}; } + if ($form->{'iptoken'}) { + my $lonhost = $r->dir_config('lonHostID'); + $initial_env{"user.noloadbalance"} = $lonhost; + $env{'user.noloadbalance'} = $lonhost; + } + my %is_adv = ( is_adv => $env{'user.adv'} ); my %domdef; unless ($domain eq 'public') { @@ -14128,7 +14541,7 @@ sub init_user_environment { undef,\%userenv,\%domdef,\%is_adv); } - foreach my $crstype ('official','unofficial','community') { + foreach my $crstype ('official','unofficial','community','textbook') { $userenv{'canrequest.'.$crstype} = &Apache::lonnet::usertools_access($username,$domain,$crstype, 'reload','requestcourses', @@ -14349,6 +14762,30 @@ sub parse_supplemental_title { return $title; } +sub recurse_supplemental { + my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_; + if ($suppmap) { + my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap); + if ($fatal) { + $errors ++; + } else { + if ($#LONCAPA::map::resources > 0) { + foreach my $res (@LONCAPA::map::resources) { + my ($title,$src,$ext,$type,$status)=split(/\:/,$res); + if (($src ne '') && ($status eq 'res')) { + if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) { + ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors); + } else { + $numfiles ++; + } + } + } + } + } + } + return ($numfiles,$errors); +} + sub symb_to_docspath { my ($symb) = @_; return unless ($symb); @@ -14378,7 +14815,7 @@ sub symb_to_docspath { my $thistitle = $res->title(); $path .= '&'. &Apache::lonhtmlcommon::entity_encode($thisurl).'&'. - &Apache::lonhtmlcommon::entity_encode($thistitle). + &escape($thistitle). ':'.$res->randompick(). ':'.$res->randomout(). ':'.$res->encrypted(). @@ -14394,7 +14831,7 @@ sub symb_to_docspath { } $path .= (($path ne '')? '&' : ''). &Apache::lonhtmlcommon::entity_encode($mapurl).'&'. - &Apache::lonhtmlcommon::entity_encode($maptitle). + &escape($maptitle). ':'.$mapresobj->randompick(). ':'.$mapresobj->randomout(). ':'.$mapresobj->encrypted(). @@ -14407,11 +14844,11 @@ sub symb_to_docspath { $maptitle = 'Main Content'; } $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'. - &Apache::lonhtmlcommon::entity_encode($maptitle).':::::'.$ispage; + &escape($maptitle).':::::'.$ispage; } unless ($mapurl eq 'default') { $path = 'default&'. - &Apache::lonhtmlcommon::entity_encode('Main Content'). + &escape('Main Content'). ':::::&'.$path; } return $path; @@ -14550,9 +14987,13 @@ sub check_captcha { sub create_recaptcha { my ($pubkey) = @_; + my $use_ssl; + if ($ENV{'SERVER_PORT'} == 443) { + $use_ssl = 1; + } my $captcha = Captcha::reCAPTCHA->new; return $captcha->get_options_setter({theme => 'white'})."\n". - $captcha->get_html($pubkey). + $captcha->get_html($pubkey,undef,$use_ssl). &mt('If either word is hard to read, [_1] will replace them.', 'reCAPTCHA refresh'). '

'; @@ -14575,6 +15016,28 @@ sub check_recaptcha { return $captcha_chk; } +sub cleanup_html { + my ($incoming) = @_; + my $outgoing; + if ($incoming ne '') { + $outgoing = $incoming; + $outgoing =~ s/;/;/g; + $outgoing =~ s/\#/#/g; + $outgoing =~ s/\&/&/g; + $outgoing =~ s//>/g; + $outgoing =~ s/\(/(/g; + $outgoing =~ s/\)/)/g; + $outgoing =~ s/"/"/g; + $outgoing =~ s/'/'/g; + $outgoing =~ s/\$/$/g; + $outgoing =~ s{/}{/}g; + $outgoing =~ s/=/=/g; + $outgoing =~ s/\\/\/g + } + return $outgoing; +} + =pod =back