--- loncom/interface/loncommon.pm 2013/05/26 22:44:02 1.1075.2.38 +++ loncom/interface/loncommon.pm 2013/01/01 19:53:26 1.1108 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1075.2.38 2013/05/26 22:44:02 raeburn Exp $ +# $Id: loncommon.pm,v 1.1108 2013/01/01 19:53:26 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -68,10 +68,10 @@ 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; @@ -158,6 +158,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; @@ -192,14 +193,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); @@ -528,8 +530,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'; @@ -592,9 +593,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 .= ' // ]]> @@ -663,7 +663,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)); @@ -751,7 +751,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 '') { @@ -846,14 +846,6 @@ function setRole(crstype) { } |; } - if ($credits_element) { - $setsections .= qq| -function setCredits(defaultcredits) { - document.$formname.$credits_element.value = defaultcredits; - return; -} -|; - } return $setsections; } @@ -899,12 +891,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; } } @@ -1008,12 +1000,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 @@ -1040,12 +1058,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 @@ -1099,8 +1111,6 @@ sub linked_select_forms { $secondselectname, $hashref, $menuorder, - $onchangefirst, - $onchangesecond ) = @_; my $second = "document.$formname.$secondselectname"; my $first = "document.$formname.$firstselectname"; @@ -1157,7 +1167,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}; @@ -1170,11 +1180,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. @@ -2174,31 +2180,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"; @@ -10027,13 +9941,13 @@ 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); } @@ -10169,23 +10083,21 @@ sub upload_embedded { $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].' @@ -10197,11 +10109,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].' @@ -10211,9 +10122,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 @@ -10345,7 +10253,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'}; @@ -10354,14 +10262,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 { @@ -10369,7 +10275,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); @@ -10425,7 +10331,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}; } if ($env{'form.embedded_codebase_'.$i} ne '') { $codebase = &unescape($env{'form.embedded_codebase_'.$i}); @@ -10434,11 +10339,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{/([^/]+)$}); @@ -10451,11 +10355,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; @@ -10471,47 +10370,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); @@ -10927,8 +10785,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); @@ -11504,7 +11362,7 @@ sub process_extracted_files { $folders{'0'} = $items[-2]; if ($env{'form.folderpath'} =~ /\:1$/) { $containers{'0'}='page'; - } else { + } else { $containers{'0'}='sequence'; } } @@ -11624,7 +11482,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++) { @@ -11646,7 +11504,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}}"; @@ -11693,12 +11551,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; } } @@ -11708,7 +11566,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)) { @@ -11767,7 +11625,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 ++; } @@ -11814,7 +11672,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)) { @@ -11829,7 +11687,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; @@ -13316,7 +13174,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"; @@ -13325,7 +13183,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"; @@ -13356,8 +13214,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"; @@ -13404,11 +13261,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 '') { @@ -13648,7 +13501,6 @@ sub construct_course { 'pch.users.denied', 'plc.users.denied', 'hidefromcat', - 'checkforpriv', 'categories'], $$crsudom,$$crsunum); } @@ -13678,9 +13530,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'} = ''; @@ -13705,11 +13554,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'}=''; @@ -14142,7 +13986,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'}; @@ -14300,32 +14144,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) = @_; @@ -14390,7 +14208,7 @@ 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).'&'. @@ -14404,14 +14222,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).'&'. &Apache::lonhtmlcommon::entity_encode($maptitle).':::::'.$ispage; } unless ($mapurl eq 'default') { $path = 'default&'. - &Apache::lonhtmlcommon::entity_encode('Main Content'). + &Apache::lonhtmlcommon::entity_encode('Main Course Documents'). ':::::&'.$path; } return $path; @@ -14424,12 +14242,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); @@ -14535,7 +14353,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',