--- loncom/interface/loncommon.pm 2014/02/15 18:25:13 1.1075.2.64 +++ loncom/interface/loncommon.pm 2012/12/22 15:37:02 1.1106 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1075.2.64 2014/02/15 18:25:13 raeburn Exp $ +# $Id: loncommon.pm,v 1.1106 2012/12/22 15:37:02 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -67,15 +67,12 @@ use Apache::lonhtmlcommon(); use Apache::loncoursedata(); use Apache::lontexconvert(); use Apache::lonclonecourse(); -use Apache::lonuserutils(); -use Apache::lonuserstate(); use LONCAPA qw(:DEFAULT :match); use DateTime::TimeZone; use DateTime::Locale::Catalog; +use Text::Aspell; use Authen::Captcha; use Captcha::reCAPTCHA; -use Crypt::DES; -use DynaLoader; # for Crypt::DES version # ---------------------------------------------- Designs use vars qw(%defaultdesign); @@ -160,6 +157,7 @@ sub ssi_with_retries { # ----------------------------------------------- Filetypes/Languages/Copyright my %language; my %supported_language; +my %supported_codes; my %latex_language; # For choosing hyphenation in my %latex_language_bykey; # for choosing hyphenation from metadata my %cprtag; @@ -194,14 +192,15 @@ BEGIN { while (my $line = <$fh>) { next if ($line=~/^\#/); chomp($line); - my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line)); + my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line)); $language{$key}=$val.' - '.$enc; if ($sup) { $supported_language{$key}=$sup; + $supported_codes{$key} = $code; } if ($latex) { $latex_language_bykey{$key} = $latex; - $latex_language{$two} = $latex; + $latex_language{$code} = $latex; } } close($fh); @@ -530,8 +529,7 @@ ENDAUTHORBRW } sub coursebrowser_javascript { - my ($domainfilter,$sec_element,$formname,$role_element,$crstype, - $credits_element) = @_; + my ($domainfilter,$sec_element,$formname,$role_element,$crstype) = @_; my $wintitle = 'Course_Browser'; if ($crstype eq 'Community') { $wintitle = 'Community_Browser'; @@ -594,9 +592,8 @@ sub coursebrowser_javascript { } $id_functions ENDSTDBRW - if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) { - $output .= &setsec_javascript($sec_element,$formname,$role_element, - $credits_element); + if (($sec_element ne '') || ($role_element ne '')) { + $output .= &setsec_javascript($sec_element,$formname,$role_element); } $output .= ' // ]]> @@ -665,7 +662,7 @@ if (!Array.prototype.indexOf) { var n = 0; if (arguments.length > 0) { n = Number(arguments[1]); - if (n !== n) { // shortcut for verifying if it's NaN + if (n !== n) { // shortcut for verifying if it is NaN n = 0; } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) { n = (n > 0 || -1) * Math.floor(Math.abs(n)); @@ -753,7 +750,7 @@ ENDUSERBRW } sub setsec_javascript { - my ($sec_element,$formname,$role_element,$credits_element) = @_; + my ($sec_element,$formname,$role_element) = @_; my (@courserolenames,@communityrolenames,$rolestr,$courserolestr, $communityrolestr); if ($role_element ne '') { @@ -848,14 +845,6 @@ function setRole(crstype) { } |; } - if ($credits_element) { - $setsections .= qq| -function setCredits(defaultcredits) { - document.$formname.$credits_element.value = defaultcredits; - return; -} -|; - } return $setsections; } @@ -901,12 +890,12 @@ sub check_uncheck_jscript { function checkAll(field) { if (field.length > 0) { for (i = 0; i < field.length; i++) { - if (!field[i].disabled) { + if (!field[i].disabled) { field[i].checked = true; } } } else { - if (!field.disabled) { + if (!field.disabled) { field.checked = true; } } @@ -1010,12 +999,38 @@ sub select_language { $langchoices{$code} = &plainlanguagedescription($id); } } - %langchoices = &Apache::lonlocal::texthash(%langchoices); return &select_form($selected,$name,\%langchoices); } =pod + +=item * &list_languages() + +Returns an array reference that is suitable for use in language prompters. +Each array element is itself a two element array. The first element +is the language code. The second element a descsriptiuon of the +language itself. This is suitable for use in e.g. +&Apache::edit::select_arg (once dereferenced that is). + +=cut + +sub list_languages { + my @lang_choices; + + foreach my $id (&languageids()) { + my $code = &supportedlanguagecode($id); + if ($code) { + my $selector = $supported_codes{$id}; + my $description = &plainlanguagedescription($id); + push (@lang_choices, [$selector, $description]); + } + } + return \@lang_choices; +} + +=pod + =item * &linked_select_forms(...) linked_select_forms returns a string containing a block @@ -1042,12 +1057,6 @@ linked_select_forms takes the following =item * $menuorder, the order of values in the first menu -=item * $onchangefirst, additional javascript call to execute for an onchange - event for the first tag - =back Below is an example of such a hash. Only the 'text', 'default', and @@ -1101,8 +1110,6 @@ sub linked_select_forms { $secondselectname, $hashref, $menuorder, - $onchangefirst, - $onchangesecond ) = @_; my $second = "document.$formname.$secondselectname"; my $first = "document.$formname.$firstselectname"; @@ -1159,7 +1166,7 @@ function select1_changed() { END # output the initial values for the selection lists - $result .= "\n"; my @order = sort(keys(%{$hashref})); if (ref($menuorder) eq 'ARRAY') { @order = @{$menuorder}; @@ -1172,11 +1179,7 @@ END $result .= "\n"; my %select2 = %{$hashref->{$firstdefault}->{'select2'}}; $result .= $middletext; - $result .= " form to allow a user to select the domain to preform an operation in. @@ -2189,31 +2179,25 @@ If the $showdomdesc flag is set, the dom The optional $onchange argument specifies what should occur if the domain selector is changed, e.g., 'this.form.submit()' if the form is to be automatically submitted. -The optional $incdoms is a reference to an array of domains which will be the only available options. - -The optional $excdoms is a reference to an array of domains which will be excluded from the available options. +The optional $incdoms is a reference to an array of domains which will be the only available options. =cut #------------------------------------------- sub select_dom_form { - my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_; + my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms) = @_; if ($onchange) { $onchange = ' onchange="'.$onchange.'"'; } - my (@domains,%exclude); + my @domains; if (ref($incdoms) eq 'ARRAY') { @domains = sort {lc($a) cmp lc($b)} (@{$incdoms}); } else { @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains()); } if ($includeempty) { @domains=('',@domains); } - if (ref($excdoms) eq 'ARRAY') { - map { $exclude{$_} = 1; } @{$excdoms}; - } my $selectdomain = "'."\n"; @@ -10296,57 +9903,17 @@ sub ask_for_embedded_content { } elsif ($actionurl eq '/adm/dependencies') { $output .= ''; } - $output .= ''."\n".''."\n"; + $output .= ''."\n".''."\n"; } elsif ($numpathchg) { my %pathchange = (); $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output); if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) { $output .= '

'.&mt('or').'

'; - } + } } 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') && @@ -10471,31 +10038,28 @@ 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 internal use.',$1) - .' '.&mt('Rename the file with a different extension and re-upload.').'
'; + $output .= &mt('Invalid file extension ([_1]) - reserved for LONCAPA use - rename the file with a different extension and re-upload. ',$1).'
'; next; } elsif (($fname =~ /\.(\w+)$/) && (!defined(&Apache::loncommon::fileembstyle($1)))) { $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'
'; next; } elsif ($fname=~/\.(\d+)\.(\w+)$/) { - $output .= &mt('Filename not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2).'
'; + $output .= &mt('File name not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2).'
'; next; } $env{'form.embedded_item_'.$i.'.filename'}=$fname; - my $subdir = $path; - $subdir =~ s{/+$}{}; if ($context eq 'portfolio') { my $result; if ($state eq 'existingfile') { $result= &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile', - $dirpath.$env{'form.currentpath'}.$subdir); + $dirpath.$env{'form.currentpath'}.$path); } else { $result= &Apache::lonnet::userfileupload('embedded_item_'.$i,'', $dirpath. - $env{'form.currentpath'}.$subdir); + $env{'form.currentpath'}.$path); if ($result !~ m|^/uploaded/|) { $output .= '' .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].' @@ -10507,11 +10071,10 @@ sub upload_embedded { $path.$fname.'').'
'; } } - } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) { - my $extendedsubdir = $dirpath.'/'.$subdir; - $extendedsubdir =~ s{/+$}{}; + } elsif ($context eq 'coursedoc') { my $result = - &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir); + &Apache::lonnet::userfileupload('embedded_item_'.$i,'coursedoc', + $dirpath.'/'.$path); if ($result !~ m|^/uploaded/|) { $output .= '' .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].' @@ -10521,9 +10084,6 @@ sub upload_embedded { } else { $output .= &mt('Uploaded [_1]',''. $path.$fname.'').'
'; - if ($context eq 'syllabus') { - &Apache::lonnet::make_public_indefinitely($result); - } } } else { # Save the file @@ -10655,7 +10215,7 @@ sub modify_html_form { } sub modify_html_refs { - my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_; + my ($context,$dirpath,$uname,$udom,$dir_root) = @_; my $container; if ($context eq 'portfolio') { $container = $env{'form.container'}; @@ -10664,14 +10224,12 @@ sub modify_html_refs { } elsif ($context eq 'manage_dependencies') { (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'}); $container = "/$container"; - } elsif ($context eq 'syllabus') { - $container = $url; } else { $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'}; } my (%allfiles,%codebase,$output,$content); my @changes = &get_env_multiple('form.namechange'); - unless ((@changes > 0) || ($context eq 'syllabus')) { + unless (@changes > 0) { if (wantarray) { return ('',0,0); } else { @@ -10679,7 +10237,7 @@ sub modify_html_refs { } } if (($context eq 'portfolio') || ($context eq 'coursedoc') || - ($context eq 'manage_dependencies') || ($context eq 'syllabus')) { + ($context eq 'manage_dependencies')) { unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) { if (wantarray) { return ('',0,0); @@ -10735,8 +10293,6 @@ sub modify_html_refs { if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) { 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}); @@ -10745,11 +10301,10 @@ sub modify_html_refs { } } } - my $skiprewrites; if ($count || $codebasecount) { my $saveresult; if (($context eq 'portfolio') || ($context eq 'coursedoc') || - ($context eq 'manage_dependencies') || ($context eq 'syllabus')) { + ($context eq 'manage_dependencies')) { my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult); if ($url eq $container) { my ($fname) = ($container =~ m{/([^/]+)$}); @@ -10762,11 +10317,6 @@ sub modify_html_refs { ''. $container.'').'

'; } - if ($context eq 'syllabus') { - unless ($saveresult eq 'ok') { - $skiprewrites = 1; - } - } } else { if (open(my $fh,">$container")) { print $fh $content; @@ -10782,47 +10332,6 @@ sub modify_html_refs { } } } - if (($context eq 'syllabus') && (!$skiprewrites)) { - my ($actionurl,$state); - $actionurl = "/public/$udom/$uname/syllabus"; - my ($ignore,$num,$numpathchanges,$existing,$mapping) = - &ask_for_embedded_content($actionurl,$state,\%allfiles, - \%codebase, - {'context' => 'rewrites', - 'ignore_remote_references' => 1,}); - if (ref($mapping) eq 'HASH') { - my $rewrites = 0; - foreach my $key (keys(%{$mapping})) { - next if ($key =~ m{^https?://}); - my $ref = $mapping->{$key}; - my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key"; - my $attrib; - if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') { - $attrib = join('|',@{$allfiles{$mapping->{$key}}}); - } - if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) { - my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi); - $rewrites += $numchg; - } - } - if ($rewrites) { - my $saveresult; - my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult); - if ($url eq $container) { - my ($fname) = ($container =~ m{/([^/]+)$}); - $output .= '

'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].', - $count,''. - $fname.'').'

'; - } else { - $output .= '

'. - &mt('Error: could not update links in [_1].', - ''. - $container.'').'

'; - - } - } - } - } } else { &logthis('Failed to parse '.$container. ' to modify references: '.$parse_result); @@ -11030,43 +10539,16 @@ sub decompress_form { } } if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) { - my @camtasia6 = ("$topdir/","$topdir/index.html", + my @camtasia = ("$topdir/","$topdir/index.html", "$topdir/media/", "$topdir/media/$topdir.mp4", "$topdir/media/FirstFrame.png", "$topdir/media/player.swf", "$topdir/media/swfobject.js", "$topdir/media/expressInstall.swf"); - my @camtasia8 = ("$topdir/","$topdir/$topdir.html", - "$topdir/$topdir.mp4", - "$topdir/$topdir\_config.xml", - "$topdir/$topdir\_controller.swf", - "$topdir/$topdir\_embed.css", - "$topdir/$topdir\_First_Frame.png", - "$topdir/$topdir\_player.html", - "$topdir/$topdir\_Thumbnails.png", - "$topdir/playerProductInstall.swf", - "$topdir/scripts/", - "$topdir/scripts/config_xml.js", - "$topdir/scripts/handlebars.js", - "$topdir/scripts/jquery-1.7.1.min.js", - "$topdir/scripts/jquery-ui-1.8.15.custom.min.js", - "$topdir/scripts/modernizr.js", - "$topdir/scripts/player-min.js", - "$topdir/scripts/swfobject.js", - "$topdir/skins/", - "$topdir/skins/configuration_express.xml", - "$topdir/skins/express_show/", - "$topdir/skins/express_show/player-min.css", - "$topdir/skins/express_show/spritesheet.png"); - my @diffs = &compare_arrays(\@paths,\@camtasia6); + my @diffs = &compare_arrays(\@paths,\@camtasia); if (@diffs == 0) { - $is_camtasia = 6; - } else { - @diffs = &compare_arrays(\@paths,\@camtasia8); - if (@diffs == 0) { - $is_camtasia = 8; - } + $is_camtasia = 1; } } my $output; @@ -11078,7 +10560,8 @@ sub decompress_form { function camtasiaToggle() { for (var i=0; i'. ''.$lt{'proa'}.' 
'. @@ -11264,8 +10747,8 @@ sub process_decompression { my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_; my ($dir,$error,$warning,$output); if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/) { - $error = &mt('Filename not a supported archive file type.'). - '
'.&mt('Filename should end with one of: [_1].', + $error = &mt('File name not a supported archive file type.'). + '
'.&mt('File name should end with one of: [_1].', '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz'); } else { my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom); @@ -11373,7 +10856,6 @@ 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'} = []; @@ -11392,15 +10874,12 @@ 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") && ($version == 6)) || - (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) { + } elsif ($item eq "$contents[0]/index.html") { $env{'form.archive_'.$i} = 'display'; $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'}; $displayed{'web'} = $i; } else { - 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))) { + if ($item eq "$contents[0]/media") { push(@{$env{'form.archive_directory'}},$i); } $env{'form.archive_'.$i} = 'dependency'; @@ -11845,7 +11324,7 @@ sub process_extracted_files { $folders{'0'} = $items[-2]; if ($env{'form.folderpath'} =~ /\:1$/) { $containers{'0'}='page'; - } else { + } else { $containers{'0'}='sequence'; } } @@ -11965,7 +11444,7 @@ sub process_extracted_files { } } } else { - $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'
'; + $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'
'; } } for (my $i=1; $i<=$numitems; $i++) { @@ -11987,7 +11466,7 @@ sub process_extracted_files { } if ($itemidx eq '') { $itemidx = 0; - } + } if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) { if ($mapinner{$referrer{$i}}) { $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}"; @@ -12034,12 +11513,12 @@ sub process_extracted_files { $showpath = "$relpath/$title"; } else { $showpath = "/$title"; - } + } $result .= '
  • '.&mt('[_1] included as a dependency',$showpath).'
  • '."\n"; - } + } unless ($ishome) { my $fetch = "$fullpath/$title"; - $fetch =~ s/^\Q$prefix$dir\E//; + $fetch =~ s/^\Q$prefix$dir\E//; $prompttofetch{$fetch} = 1; } } @@ -12049,7 +11528,7 @@ sub process_extracted_files { $path,$env{'form.archive_content_'.$referrer{$i}}).'
    '; } } else { - $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'
    '; + $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'
    '; } } if (keys(%todelete)) { @@ -12108,7 +11587,7 @@ sub cleanup_empty_dirs { my $numitems = 0; foreach my $item (@dircontents) { if (-d "$path/$item") { - &cleanup_empty_dirs("$path/$item"); + &recurse_dirs("$path/$item"); if (-e "$path/$item") { $numitems ++; } @@ -12127,7 +11606,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, @@ -12155,7 +11634,7 @@ sub get_folder_hierarchy { my @pcs = split(/,/,$pcslist); foreach my $pc (@pcs) { if ($pc == 1) { - push(@pathitems,&mt('Main Content')); + push(@pathitems,&mt('Main Course Documents')); } else { my $res = $navmap->getByMapPc($pc); if (ref($res)) { @@ -12170,7 +11649,7 @@ sub get_folder_hierarchy { } if ($showitem) { if ($mapres->{ID} eq '0.0') { - push(@pathitems,&mt('Main Content')); + push(@pathitems,&mt('Main Course Documents')); } else { my $maptitle = $mapres->compTitle(); $maptitle =~ s/\W+/_/g; @@ -12237,9 +11716,6 @@ 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); } } @@ -12248,9 +11724,6 @@ 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') { @@ -12291,9 +11764,6 @@ sub get_turnedin_filepath { $restitle = time; } } - if (length($restitle) > 12) { - $restitle = substr($restitle,0,12); - } push(@pathitems,$restitle); $path .= join('/',@pathitems); } @@ -13231,22 +12701,18 @@ sub restore_settings { =item * &build_recipient_list() -Build recipient lists for following types of e-mail: +Build recipient lists for five types of e-mail: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors -(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. +(d) Help requests, (e) Course requests needing approval, generated by +lonerrorhandler.pm, CHECKRPMS, loncron, lonsupportreq.pm and +loncoursequeueadmin.pm respectively. Inputs: -defmail (scalar - email address of default recipient), -mailing type (scalar: errormail, packagesmail, helpdeskmail, -requestsmail, updatesmail, or idconflictsmail). - +defmail (scalar - email address of default recipient), +mailing type (scalar - errormail, packagesmail, or helpdeskmail), 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. @@ -13440,7 +12906,7 @@ sub extract_categories { =pod -=item * &recurse_categories() +=item *&recurse_categories() Recursively used to generate breadcrumb trails for course categories. @@ -13511,7 +12977,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. @@ -13588,7 +13054,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. @@ -13622,7 +13088,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; @@ -13670,7 +13136,7 @@ sub commit_customrole { } sub commit_standardrole { - my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_; + my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_; my ($output,$logmsg,$linefeed); if ($context eq 'auto') { $linefeed = "\n"; @@ -13679,7 +13145,7 @@ sub commit_standardrole { } if ($three eq 'st') { my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end, - $one,$two,$sec,$context,$credits); + $one,$two,$sec,$context); if (($result =~ /^error/) || ($result eq 'not_in_class') || ($result eq 'unknown_course') || ($result eq 'refused')) { $output = $logmsg.' '.&mt('Error: ').$result."\n"; @@ -13710,8 +13176,7 @@ sub commit_standardrole { } sub commit_studentrole { - my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context, - $credits) = @_; + my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_; my ($result,$linefeed,$oldsecurl,$newsecurl); if ($context eq 'auto') { $linefeed = "\n"; @@ -13758,11 +13223,7 @@ sub commit_studentrole { } } if (($expire_role_result eq 'ok') || ($secchange == 0)) { - $modify_section_result = - &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef, - undef,undef,undef,$sec, - $end,$start,'','',$cid, - '',$context,$credits); + $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid,'',$context); if ($modify_section_result =~ /^ok/) { if ($secchange == 1) { if ($sec eq '') { @@ -13819,26 +13280,6 @@ sub commit_studentrole { return $result; } -sub show_role_extent { - my ($scope,$context,$role) = @_; - $scope =~ s{^/}{}; - my @courseroles = &Apache::lonuserutils::roles_by_context('course',1); - push(@courseroles,'co'); - my @authorroles = &Apache::lonuserutils::roles_by_context('author'); - if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) { - $scope =~ s{/}{_}; - return ''.$env{'course.'.$scope.'.description'}.''; - } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) { - my ($audom,$auname) = split(/\//,$scope); - return &mt('[_1] Author Space',''. - &Apache::loncommon::plainname($auname,$audom).''); - } else { - $scope =~ s{/$}{}; - return &mt('Domain: [_1]',''. - &Apache::lonnet::domain($scope,'description').''); - } -} - ############################################################ ############################################################ @@ -13906,7 +13347,7 @@ sub check_clone { } sub construct_course { - my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_; + my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_; my $outcome; my $linefeed = '
    '."\n"; if ($context eq 'auto') { @@ -14002,13 +13443,8 @@ sub construct_course { 'pch.users.denied', 'plc.users.denied', 'hidefromcat', - 'checkforpriv', - 'categories', - 'internal.uniquecode'], + 'categories'], $$crsudom,$$crsunum); - if ($args->{'textbook'}) { - $cenv{'internal.textbook'} = $args->{'textbook'}; - } } # @@ -14036,9 +13472,6 @@ sub construct_course { } else { $cenv{'internal.courseowner'} = $args->{'curruser'}; } - if ($args->{'defaultcredits'}) { - $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'}; - } my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner. if ($args->{'crssections'}) { $cenv{'internal.sectionnums'} = ''; @@ -14063,11 +13496,6 @@ sub construct_course { # do not hide course coordinator from staff listing, # even if privileged $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'}; -# add course coordinator's domain to domains to check for privileged users -# if different to course domain - if ($$crsudom ne $args->{'ccdomain'}) { - $cenv{'checkforpriv'} = $args->{'ccdomain'}; - } # add crosslistings if ($args->{'crsxlist'}) { $cenv{'internal.crosslistings'}=''; @@ -14192,25 +13620,6 @@ 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'; } @@ -14279,60 +13688,6 @@ 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; -} - ############################################################ ############################################################ @@ -14360,12 +13715,11 @@ sub group_term { } sub course_types { - my @types = ('official','unofficial','community','textbook'); + my @types = ('official','unofficial','community'); my %typename = ( official => 'Official course', unofficial => 'Unofficial course', community => 'Community', - textbook => 'Textbook course', ); return (\@types,\%typename); } @@ -14498,7 +13852,7 @@ sub init_user_environment { # ------------------------------------ Check browser type and MathML capability my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml, - $clientunicode,$clientos,$clientmobile,$clientinfo) = &decode_user_agent($r); + $clientunicode,$clientos) = &decode_user_agent($r); # ------------------------------------------------------------- Get environment @@ -14529,8 +13883,6 @@ 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" => '', @@ -14550,12 +13902,6 @@ 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') { @@ -14568,7 +13914,7 @@ sub init_user_environment { undef,\%userenv,\%domdef,\%is_adv); } - foreach my $crstype ('official','unofficial','community','textbook') { + foreach my $crstype ('official','unofficial','community') { $userenv{'canrequest.'.$crstype} = &Apache::lonnet::usertools_access($username,$domain,$crstype, 'reload','requestcourses', @@ -14582,7 +13928,7 @@ sub init_user_environment { my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'], $domain,$username); my $reqstatus = $reqauthor{'author_status'}; - if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { + if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { if (ref($reqauthor{'author'}) eq 'HASH') { $userenv{'requestauthorqueued'} = $reqstatus.':'. $reqauthor{'author'}{'timestamp'}; @@ -14740,32 +14086,6 @@ sub update_content_constraints { return; } -sub allmaps_incourse { - my ($cdom,$cnum,$chome,$cid) = @_; - if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') { - $cid = $env{'request.course.id'}; - $cdom = $env{'course.'.$cid.'.domain'}; - $cnum = $env{'course.'.$cid.'.num'}; - $chome = $env{'course.'.$cid.'.home'}; - } - my %allmaps = (); - my $lastchange = - &Apache::lonnet::get_coursechange($cdom,$cnum); - if ($lastchange > $env{'request.course.tied'}) { - my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum"); - unless ($ferr) { - &update_content_constraints($cdom,$cnum,$chome,$cid); - } - } - my $navmap = Apache::lonnavmaps::navmap->new(); - if (defined($navmap)) { - foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) { - $allmaps{$res->src()} = 1; - } - } - return \%allmaps; -} - sub parse_supplemental_title { my ($title) = @_; @@ -14789,30 +14109,6 @@ 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); @@ -14842,7 +14138,7 @@ sub symb_to_docspath { my $thistitle = $res->title(); $path .= '&'. &Apache::lonhtmlcommon::entity_encode($thisurl).'&'. - &escape($thistitle). + &Apache::lonhtmlcommon::entity_encode($thistitle). ':'.$res->randompick(). ':'.$res->randomout(). ':'.$res->encrypted(). @@ -14854,11 +14150,11 @@ sub symb_to_docspath { $path =~ s/^\&//; my $maptitle = $mapresobj->title(); if ($mapurl eq 'default') { - $maptitle = 'Main Content'; + $maptitle = 'Main Course Documents'; } $path .= (($path ne '')? '&' : ''). &Apache::lonhtmlcommon::entity_encode($mapurl).'&'. - &escape($maptitle). + &Apache::lonhtmlcommon::entity_encode($maptitle). ':'.$mapresobj->randompick(). ':'.$mapresobj->randomout(). ':'.$mapresobj->encrypted(). @@ -14868,14 +14164,14 @@ sub symb_to_docspath { my $maptitle = &Apache::lonnet::gettitle($mapurl); my $ispage = (($type eq 'page')? 1 : ''); if ($mapurl eq 'default') { - $maptitle = 'Main Content'; + $maptitle = 'Main Course Documents'; } $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'. - &escape($maptitle).':::::'.$ispage; + &Apache::lonhtmlcommon::entity_encode($maptitle).':::::'.$ispage; } unless ($mapurl eq 'default') { $path = 'default&'. - &escape('Main Content'). + &Apache::lonhtmlcommon::entity_encode('Main Course Documents'). ':::::&'.$path; } return $path; @@ -14888,12 +14184,12 @@ sub captcha_display { if ($captcha eq 'original') { $output = &create_captcha(); unless ($output) { - $error = 'captcha'; + $error = 'captcha'; } } elsif ($captcha eq 'recaptcha') { $output = &create_recaptcha($pubkey); unless ($output) { - $error = 'recaptcha'; + $error = 'recaptcha'; } } return ($output,$error); @@ -14999,7 +14295,7 @@ sub check_captcha { output_folder => $captcha_params{'output_dir'}, data_folder => $captcha_params{'db_dir'}, ); - $captcha_chk = $captcha->check_code($code,$md5sum); + my $captcha_chk = $captcha->check_code($code,$md5sum); my %captcha_hash = ( 0 => 'Code not checked (file error)', -1 => 'Failed: code expired', @@ -15014,15 +14310,11 @@ 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,undef,$use_ssl). + $captcha->get_html($pubkey). &mt('If either word is hard to read, [_1] will replace them.', - 'reCAPTCHA refresh'). + ''). '

    '; } @@ -15043,83 +14335,6 @@ sub check_recaptcha { return $captcha_chk; } -sub emailusername_info { - my @fields = ('lastname','firstname','institution','web','location','officialemail'); - my %titles = &Apache::lonlocal::texthash ( - lastname => 'Last Name', - firstname => 'First Name', - institution => 'School/college/university', - location => "School's city, state/province, country", - web => "School's web address", - officialemail => 'E-mail address at institution (if different)', - ); - return (\@fields,\%titles); -} - -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; -} - -# Use: -# my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver); -# -################################################## -# password associated functions # -################################################## -sub des_keys { - # Make a new key for DES encryption. - # Each key has two parts which are returned separately. - # Please note: Each key must be passed through the &hex function - # before it is output to the web browser. The hex versions cannot - # be used to decrypt. - my @hexstr=('0','1','2','3','4','5','6','7', - '8','9','a','b','c','d','e','f'); - my $lkey=''; - for (0..7) { - $lkey.=$hexstr[rand(15)]; - } - my $ukey=''; - for (0..7) { - $ukey.=$hexstr[rand(15)]; - } - return ($lkey,$ukey); -} - -sub des_decrypt { - my ($key,$cyphertext) = @_; - my $keybin=pack("H16",$key); - my $cypher; - if ($Crypt::DES::VERSION>=2.03) { - $cypher=new Crypt::DES $keybin; - } else { - $cypher=new DES $keybin; - } - my $plaintext= - $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16)))); - $plaintext.= - $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16)))); - $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) ); - return $plaintext; -} - =pod =back