--- loncom/interface/loncommon.pm 2013/08/03 22:32:01 1.1075.2.42 +++ loncom/interface/loncommon.pm 2013/12/13 04:21:21 1.1075.2.56 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1075.2.42 2013/08/03 22:32:01 raeburn Exp $ +# $Id: loncommon.pm,v 1.1075.2.56 2013/12/13 04:21:21 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 { @@ -1358,22 +1362,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 +1724,6 @@ RESIZE =head1 Excel and CSV file utility routines -=over 4 - =cut ############################################################### @@ -1728,6 +1731,8 @@ RESIZE =pod +=over 4 + =item * &csv_translate($text) Translate $text to allow it to be output as a 'comma separated values' @@ -5037,6 +5042,7 @@ sub bodytag { $public = 1; } if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); } + my $httphost = $args->{'use_absolute'}; $function = &get_users_function() if (!$function); my $img = &designparm($function.'.img',$domain); @@ -5108,7 +5114,7 @@ sub bodytag { my $funclist; if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) { - $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions(), 'start')."\n". + $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions($httphost), 'start')."\n". Apache::lonmenu::serverform(); my $forbodytag; &Apache::lonmenu::prepare_functions($env{'request.noversionuri'}, @@ -5125,7 +5131,7 @@ sub bodytag { # } $bodytag .= Apache::lonhtmlcommon::scripttag( - Apache::lonmenu::utilityfunctions(), 'start'); + Apache::lonmenu::utilityfunctions($httphost), 'start'); my ($left,$right) = Apache::lonmenu::primary_menu(); @@ -5151,7 +5157,7 @@ sub bodytag { #don't show menus for public users if (!$public){ - $bodytag .= Apache::lonmenu::secondary_menu(); + $bodytag .= Apache::lonmenu::secondary_menu($httphost); $bodytag .= Apache::lonmenu::serverform(); $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); if ($env{'request.state'} eq 'construct') { @@ -5214,7 +5220,7 @@ sub bodytag { if (!$public){ if ($env{'request.state'} eq 'construct') { $funclist = &Apache::lonhtmlcommon::scripttag( - &Apache::lonmenu::utilityfunctions(), 'start'). + &Apache::lonmenu::utilityfunctions($httphost), 'start'). &Apache::lonhtmlcommon::scripttag('','end'). &Apache::lonmenu::innerregister($forcereg, $args->{'bread_crumbs'}); @@ -5265,7 +5271,7 @@ sub make_attr_string { } my $attr_string; - foreach my $attr (keys(%$attr_ref)) { + foreach my $attr (sort(keys(%$attr_ref))) { $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" '; } return $attr_string; @@ -7245,6 +7251,7 @@ sub headtag { my $function = $args->{'function'} || &get_users_function(); my $domain = $args->{'domain'} || &determinedomain(); my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain); + my $httphost = $args->{'use_absolute'}; my $url = join(':',$env{'user.name'},$env{'user.domain'}, $Apache::lonnet::perlvar{'lonVersion'}, #time(), @@ -7255,7 +7262,7 @@ sub headtag { my $result = ''. - &font_settings(); + &font_settings($args); my $inhibitprint = &print_suppression(); @@ -7268,7 +7275,7 @@ sub headtag { if (!$args->{'no_nav_bar'} && !$args->{'only_body'} && !$args->{'frameset'}) { - $result .= &help_menu_js(); + $result .= &help_menu_js($httphost); $result.=&modal_window(); $result.=&togglebox_script(); $result.=&wishlist_window(); @@ -7320,15 +7327,17 @@ ADDMETA Returns neccessary to set the proper encoding -Inputs: none +Inputs: optional reference to HASH -- $args passed to &headtag() =cut sub font_settings { + my ($args) = @_; my $headerstring=''; - if (!$env{'browser.mathml'} && $env{'browser.unicode'}) { + if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) || + ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) { $headerstring.= - ''; + ''."\n"; } return $headerstring; } @@ -7432,8 +7441,8 @@ sub xml_begin { .''; } else { - $output='' - .''; + $output=''."\n" + .''."\n"; } return $output; } @@ -7925,7 +7934,7 @@ sub validate_page { sub start_scrollbox { - my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready)=@_; + my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_; unless ($outerwidth) { $outerwidth='520px'; } unless ($width) { $width='500px'; } unless ($height) { $height='200px'; } @@ -7945,7 +7954,7 @@ sub start_scrollbox { $nicescroll_js
-
+
END } @@ -8035,10 +8044,16 @@ function expand_div(caller) { } sub simple_error_page { - my ($r,$title,$msg) = @_; + my ($r,$title,$msg,$args) = @_; + if (ref($args) eq 'HASH') { + if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); } + } else { + $msg = &mt($msg); + } + my $page = &Apache::loncommon::start_page($title). - '

'.&mt($msg).'

'. + '

'.$msg.'

'. &Apache::loncommon::end_page(); if (ref($r)) { $r->print($page); @@ -9761,11 +9776,10 @@ sub ask_for_embedded_content { my $numexisting = 0; my $numunused = 0; my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum, - $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path); + $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap); my $heading = &mt('Upload embedded files'); my $buttontext = &mt('Upload'); - my ($navmap,$cdom,$cnum); if ($env{'request.course.id'}) { if ($actionurl eq '/adm/dependencies') { $navmap = Apache::lonnavmaps::navmap->new(); @@ -9849,17 +9863,18 @@ sub ask_for_embedded_content { } else { $embed_file = $file; } - my $absolutepath; + my ($absolutepath,$cleaned_file); if ($embed_file =~ m{^\w+://}) { - $newfiles{$embed_file} = 1; - $mapping{$embed_file} = $embed_file; + $cleaned_file = $embed_file; + $newfiles{$cleaned_file} = 1; + $mapping{$cleaned_file} = $embed_file; } else { + $cleaned_file = &clean_path($embed_file); if ($embed_file =~ m{^/}) { $absolutepath = $embed_file; - $embed_file =~ s{^(/+)}{}; } - if ($embed_file =~ m{/}) { - my ($path,$fname) = ($embed_file =~ m{^(.+)/([^/]*)$}); + if ($cleaned_file =~ m{/}) { + my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$}); $path = &check_for_traversal($path,$url,$toplevel); my $item = $fname; if ($path ne '') { @@ -9876,9 +9891,9 @@ sub ask_for_embedded_content { } else { $dependencies{$embed_file} = 1; if ($absolutepath) { - $mapping{$embed_file} = $absolutepath; + $mapping{$cleaned_file} = $absolutepath; } else { - $mapping{$embed_file} = $embed_file; + $mapping{$cleaned_file} = $embed_file; } } } @@ -10252,6 +10267,46 @@ sub ask_for_embedded_content { return ($output,$counter,$numpathchg); } +=pod + +=item * clean_path($name) + +Performs clean-up of directories, subdirectories and filename in an +embedded object, referenced in an HTML file which is being uploaded +to a course or portfolio, where +"Upload embedded images/multimedia files if HTML file" checkbox was +checked. + +Clean-up is similar to replacements in lonnet::clean_filename() +except each / between sub-directory and next level is preserved. + +=cut + +sub clean_path { + my ($embed_file) = @_; + $embed_file =~s{^/+}{}; + my @contents; + if ($embed_file =~ m{/}) { + @contents = split(/\//,$embed_file); + } else { + @contents = ($embed_file); + } + my $lastidx = scalar(@contents)-1; + for (my $i=0; $i<=$lastidx; $i++) { + $contents[$i]=~s{\\}{/}g; + $contents[$i]=~s/\s+/\_/g; + $contents[$i]=~s{[^/\w\.\-]}{}g; + if ($i == $lastidx) { + $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g; + } + } + if ($lastidx > 0) { + return join('/',@contents); + } else { + return $contents[0]; + } +} + sub embedded_file_element { my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_; return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') && @@ -10376,7 +10431,8 @@ sub upload_embedded { # Check if extension is valid if (($fname =~ /\.(\w+)$/) && (&Apache::loncommon::fileembstyle($1) eq 'hdn')) { - $output .= &mt('Invalid file extension ([_1]) - reserved for LONCAPA use - rename the file with a different extension and re-upload. ',$1).'
'; + $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1) + .' '.&mt('Rename the file with a different extension and re-upload.').'
'; next; } elsif (($fname =~ /\.(\w+)$/) && (!defined(&Apache::loncommon::fileembstyle($1)))) { @@ -10640,6 +10696,7 @@ sub modify_html_refs { my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi); $count += $numchg; $allfiles{$newname} = $allfiles{$ref}; + delete($allfiles{$ref}); } if ($env{'form.embedded_codebase_'.$i} ne '') { $codebase = &unescape($env{'form.embedded_codebase_'.$i}); @@ -12000,7 +12057,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, @@ -12110,6 +12167,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); } } @@ -12118,6 +12178,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') { @@ -12158,6 +12221,9 @@ sub get_turnedin_filepath { $restitle = time; } } + if (length($restitle) > 12) { + $restitle = substr($restitle,0,12); + } push(@pathitems,$restitle); $path .= join('/',@pathitems); } @@ -13095,18 +13161,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. @@ -13300,7 +13370,7 @@ sub extract_categories { =pod -=item *&recurse_categories() +=item * &recurse_categories() Recursively used to generate breadcrumb trails for course categories. @@ -13371,7 +13441,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. @@ -13448,7 +13518,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. @@ -13482,7 +13552,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; @@ -14332,6 +14402,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') { @@ -14565,6 +14641,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); @@ -14594,7 +14694,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(). @@ -14610,7 +14710,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(). @@ -14623,11 +14723,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; @@ -14766,9 +14866,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'). '

'; @@ -14791,6 +14895,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