--- loncom/interface/loncommon.pm 2011/12/25 20:41:53 1.1047 +++ loncom/interface/loncommon.pm 2012/01/31 23:47:15 1.1055 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1047 2011/12/25 20:41:53 raeburn Exp $ +# $Id: loncommon.pm,v 1.1055 2012/01/31 23:47:15 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -154,6 +154,8 @@ sub ssi_with_retries { # ----------------------------------------------- Filetypes/Languages/Copyright my %language; my %supported_language; +my %latex_language; # For choosing hyphenation in +my %latex_language_bykey; # for choosing hyphenation from metadata my %cprtag; my %scprtag; my %fe; my %fd; my %fm; @@ -186,11 +188,15 @@ BEGIN { while (my $line = <$fh>) { next if ($line=~/^\#/); chomp($line); - my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$line)); + my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line)); $language{$key}=$val.' - '.$enc; if ($sup) { $supported_language{$key}=$sup; } + if ($latex) { + $latex_language_bykey{$key} = $latex; + $latex_language{$two} = $latex; + } } close($fh); } @@ -3227,11 +3233,29 @@ sub languagedescription { ($supported_language{$code}?' ('.&mt('interface available').')':''); } +=pod + +=item * &plainlanguagedescription + +Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)') +and the language character encoding (e.g. ISO) separated by a ' - ' string. + +=cut + sub plainlanguagedescription { my $code=shift; return $language{$code}; } +=pod + +=item * &supportedlanguagecode + +Returns the supported language code (e.g. sptutf maps to pt) given a language +code. + +=cut + sub supportedlanguagecode { my $code=shift; return $supported_language{$code}; @@ -3239,6 +3263,35 @@ sub supportedlanguagecode { =pod +=item * &latexlanguage() + +Given a language key code returns the correspondnig language to use +to select the correct hyphenation on LaTeX printouts. This is undef if there +is no supported hyphenation for the language code. + +=cut + +sub latexlanguage { + my $code = shift; + return $latex_language{$code}; +} + +=pod + +=item * &latexhyphenation() + +Same as above but what's supplied is the language as it might be stored +in the metadata. + +=cut + +sub latexhyphenation { + my $key = shift; + return $latex_language_bykey{$key}; +} + +=pod + =item * ©rightids() returns list of all copyrights @@ -4980,7 +5033,6 @@ body { a:focus, a:focus img { color: red; - background: yellow; } form, .inline { @@ -5075,35 +5127,36 @@ div.LC_confirm_box .LC_success img { } .LC_discussion { - background: $tabbg; + background: $data_table_dark; border: 1px solid black; margin: 2px; } -.LC_disc_action_links_bar { - background: $tabbg; - border: none; - margin: 4px; -} - .LC_disc_action_left { + background: $sidebg; text-align: left; + padding: 4px; + margin: 2px; } .LC_disc_action_right { + background: $sidebg; text-align: right; + padding: 4px; + margin: 2px; } .LC_disc_new_item { background: white; border: 2px solid red; - margin: 2px; + margin: 4px; + padding: 4px; } .LC_disc_old_item { background: white; - border: 1px solid black; - margin: 2px; + margin: 4px; + padding: 4px; } table.LC_pastsubmission { @@ -5225,7 +5278,7 @@ td.LC_table_cell_checkbox { vertical-align: middle; } -li.LC_menubuttons_inline_text img,a { +li.LC_menubuttons_inline_text img { cursor:pointer; text-decoration: none; } @@ -6080,7 +6133,6 @@ div.LC_createcourse { display:none; } -a:hover, ol.LC_primary_menu a:hover, ol#LC_MenuBreadcrumbs a:hover, ol#LC_PathBreadcrumbs a:hover, @@ -7045,11 +7097,11 @@ ENDMODAL } sub modal_link { - my ($link,$linktext,$width,$height,$target,$scrolling)=@_; + my ($link,$linktext,$width,$height,$target,$scrolling,$title)=@_; unless ($width) { $width=480; } unless ($height) { $height=400; } unless ($scrolling) { $scrolling='yes'; } - return ''. + return ''. $linktext.''; } @@ -9656,6 +9708,572 @@ sub check_for_traversal { return $cleanpath; } +sub is_archive_file { + my ($mimetype) = @_; + if (($mimetype eq 'application/octet-stream') || + ($mimetype eq 'application/x-stuffit') || + ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) { + return 1; + } + return; +} + +sub decompress_form { + my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements) = @_; + my %lt = &Apache::lonlocal::texthash ( + this => 'This file is an archive file.', + youm => 'You may wish to extract its contents.', + camt => 'Extraction of contents is recommended for Camtasia zip files.', + perm => 'Permanently remove archive file after extraction of contents?', + extr => 'Extract contents', + yes => 'Yes', + no => 'No', + ); + my $output = '

'.$lt{'this'}.' '.$lt{'youm'}.'
'; + if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) { + $output .= $lt{'camt'}; + } + $output .= '

'; + $output .= <<"START"; +

+$lt{'this'} $lt{'youm'} +

+
+
+ +START + if (ref($hiddenelements) eq 'HASH') { + foreach my $hidden (sort(keys(%{$hiddenelements}))) { + $output .= ''."\n"; + } + } + $output .= <<"END"; +$lt{'perm'}  +   +
+ +
+$noextract +
+END + return $output; +} + +sub decompress_uploaded_file { + my ($file,$dir) = @_; + &Apache::lonnet::appenv({'cgi.file' => $file}); + &Apache::lonnet::appenv({'cgi.dir' => $dir}); + my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl'); + my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$}); + my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'}; + &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1); + my $decompressed = $env{'cgi.decompressed'}; + &Apache::lonnet::delenv('cgi.file'); + &Apache::lonnet::delenv('cgi.dir'); + &Apache::lonnet::delenv('cgi.decompressed'); + return ($decompressed,$result); +} + +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('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); + if ($docuhome eq 'no_host') { + $error = &mt('Could not determine home server for course.'); + } else { + my @ids=&Apache::lonnet::current_machine_ids(); + my $currdir = "$dir_root/$destination"; + my ($currdirlistref,$currlisterror) = + &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1); + if (grep(/^\Q$docuhome\E$/,@ids)) { + $dir = &LONCAPA::propath($docudom,$docuname). + "$dir_root/$destination"; + } else { + $dir = $Apache::lonnet::perlvar{'lonDocRoot'}. + "$dir_root/$docudom/$docuname/$destination"; + unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') { + $error = &mt('Archive file not found.'); + } + } + if ($dir eq '') { + $error = &mt('Directory containing archive file unavailable.'); + } elsif (!$error) { + my ($decompressed,$display) = &decompress_uploaded_file($file,$dir); + if ($decompressed eq 'ok') { + $output = &mt('Files extracted successfully from archive.').'
'; + my ($warning,$result,@contents); + my ($newdirlistref,$newlisterror) = + &Apache::lonnet::dirlist($currdir,$docudom, + $docuname,1); + my (%is_dir,%changes,@newitems); + my $dirptr = 16384; + if (ref($currdirlistref) eq 'ARRAY') { + my @curritems; + foreach my $dir_line (@{$currdirlistref}) { + my ($item,$rest)=split(/\&/,$dir_line,2); + unless ($item =~ /\.+$/) { + push(@curritems,$item); + } + } + if (ref($newdirlistref) eq 'ARRAY') { + foreach my $dir_line (@{$newdirlistref}) { + my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,4); + unless ($item =~ /^\.+$/) { + if ($dirptr&$testdir) { + $is_dir{$item} = 1; + } + push(@newitems,$item); + } + } + my @diffs = &compare_arrays(\@curritems,\@newitems); + if (@diffs > 0) { + foreach my $item (@diffs) { + $changes{$item} = 1; + } + } + } + } elsif (ref($newdirlistref) eq 'ARRAY') { + foreach my $dir_line (@{$newdirlistref}) { + my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5); + unless ($item =~ /\.+$/) { + push(@newitems,$item); + if ($dirptr&$testdir) { + $is_dir{$item} = 1; + } + $changes{$item} = 1; + } + } + } + if (keys(%changes) > 0) { + foreach my $item (sort(@newitems)) { + if ($changes{$item}) { + push(@contents,$item); + } + } + } + if (@contents > 0) { + my (%children,%parent); + my $wantform = 1; + my ($count,$datatable) = &get_extracted($docudom,$docuname, + $currdir,\%is_dir, + \%children,\%parent, + \@contents,$wantform); + if ($datatable ne '') { + $output .= &archive_options_form('decompressed',$datatable, + $count,$hiddenelem); + my $startcount = 3; + $output .= &archive_javascript($startcount,$count, + %children); + } + } else { + $warning = &mt('No new items extracted from archive file.'); + } + } else { + $output = $display; + $error = &mt('An error occurred during extraction from the archive file.'); + } + } + } + } + if ($error) { + $output .= '

'.&mt('Not extracted.').'
'. + $error.'

'."\n"; + } + if ($warning) { + $output .= '

'.$warning.'

'."\n"; + } + return $output; +} + +sub get_extracted { + my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$wantform) = @_; + my $count = 0; + my $lastcontainer = 0; + my $depth = 0; + my $datatable; + return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') && + (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY')); + foreach my $item (@{$contents}) { + $count ++; + &archive_hierarchy($depth,$count,$parent,$children); + if ($wantform) { + $datatable .= &archive_row($is_dir->{$item},$item, + $currdir,$depth,$count); + } + if ($is_dir->{$item}) { + $depth ++; + $lastcontainer = $count; + $parent->{$depth} = $lastcontainer; + $datatable .= + &recurse_extracted_archive("$currdir/$item",$docudom,$docuname, + \$depth,\$count,\$lastcontainer, + $children,$parent,$wantform); + $depth --; + $lastcontainer = $parent->{$depth}; + } + } + return ($count,$datatable); +} + +sub recurse_extracted_archive { + my ($currdir,$docudom,$docuname,$depth,$count,$lastcontainer, + $children,$parent,$wantform) = @_; + my $result=''; + unless ((ref($depth)) && (ref($count)) && (ref($lastcontainer)) && + (ref($children) eq 'HASH') && (ref($parent) eq 'HASH')) { + return $result; + } + my $dirptr = 16384; + my ($newdirlistref,$newlisterror) = + &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1); + if (ref($newdirlistref) eq 'ARRAY') { + foreach my $dir_line (@{$newdirlistref}) { + my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5); + unless ($item =~ /^\.+$/) { + $$count ++; + &archive_hierarchy($$depth,$$count,$parent,$children); + my $is_dir; + if ($dirptr&$testdir) { + $is_dir = 1; + } + if ($wantform) { + $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count); + } + if ($is_dir) { + $$depth ++; + $$lastcontainer = $$count; + $parent->{$$depth} = $$lastcontainer; + $result .= + &recurse_extracted_archive("$currdir/$item",$docudom, + $docuname,$depth,$count, + $lastcontainer,$children, + $parent,$wantform); + $$depth --; + $$lastcontainer = $parent->{$$depth}; + } + } + } + } + return $result; +} + +sub archive_hierarchy { + my ($depth,$count,$parent,$children) =@_; + if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) { + if (exists($parent->{$depth})) { + $children->{$parent->{$depth}} .= $count.':'; + } + } + return; +} + +sub archive_row { + my ($is_dir,$item,$currdir,$depth,$count) = @_; + my ($name) = ($item =~ m{([^/]+)$}); + my %choices = &Apache::lonlocal::texthash ( + 'display' => 'Add as File', + 'dependency' => 'Include as dependency', + 'discard' => 'Discard', + ); + if ($is_dir) { + $choices{'display'} = &mt('Add as Folder'); + } + my $output = &start_data_table_row()."\n"; + foreach my $action ('display','dependency','discard') { + $output .= ''. + ''; + } + $output .= '&').'" />'.(' ' x 2); + for (my $i=0; $i<$depth; $i++) { + $output .= ('' x2)."\n"; + } + if ($is_dir) { + $output .= ' '."\n". + ''."\n"; + } else { + $output .= ''."\n"; + } + $output .= ' '.$name.''."\n". + &end_data_table_row(); + return $output; +} + +sub archive_options_form { + my ($form,$output,$count,$hiddenelem) = @_; + return '
'."\n". + ''."\n". + '

'. + &mt('How should each item be incorporated in the course?'). + '

'. + '
'. + ''.&mt('Content actions for all').''. + ''. + '  '. + '  '. + '
'. + &start_data_table()."\n". + $output."\n". + &end_data_table()."\n". + ''. + $hiddenelem. + '
'. + '
'; +} + +sub archive_javascript { + my ($startcount,$numitems,%children) = @_; + my $scripttag = < +// 0) { + var startelement = $startcount + (count-1) * 5; + for (var j=1; j<4; j++) { + var item = startelement + j; + if (form.elements[item].type == 'radio') { + if (form.elements[item].checked) { + containerCheck(form,count,j); + break; + } + } + } + } +} + +numitems = $numitems +var parents = new Array(numitems) +for (var i=0; i $b } (keys(%children))) { + my @contents = split(/:/,$children{$container}); + for (my $i=0; $i<@contents; $i ++) { + $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n"; + } + } + + $scripttag .= < 0) { + var item = $startcount + ((count-1) * 5) + offset; + form.elements[item].checked = true; + if(Object.prototype.toString.call(parents[count]) === '[object Array]') { + if (parents[count].length > 0) { + for (var j=0; j + +END + return $scripttag; +} + +sub process_extracted_files { + my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_; + my $numitems = $env{'form.archive_count'}; + return unless ($numitems); + my @ids=&Apache::lonnet::current_machine_ids(); + my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir, + %folders,%containers,%mapinner); + my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom); + if (grep(/^\Q$docuhome\E$/,@ids)) { + $prefix = &LONCAPA::propath($docudom,$docuname); + $pathtocheck = "$dir_root/$destination"; + $dir = $dir_root; + $ishome = 1; + } else { + $prefix = $Apache::lonnet::perlvar{'lonDocRoot'}; + $pathtocheck = "$dir_root/$docudom/$docuname/$destination"; + $dir = "$dir_root/$docudom/$docuname"; + } + my $currdir = "$dir_root/$destination"; + (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/}); + if ($env{'form.folderpath'}) { + my @items = split('&',$env{'form.folderpath'}); + $folders{'0'} = $items[-2]; + $containers{'0'}='sequence'; + } elsif ($env{'form.pagepath'}) { + my @items = split('&',$env{'form.pagepath'}); + $folders{'0'} = $items[-2]; + $containers{'0'}='page'; + } + my @archdirs = &get_env_multiple('form.archive_directory'); + if ($numitems) { + for (my $i=1; $i<=$numitems; $i++) { + my $path = $env{'form.archive_content_'.$i}; + if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) { + my $item = $1; + $toplevelitems{$item} = $i; + if (grep(/^\Q$i\E$/,@archdirs)) { + $is_dir{$item} = 1; + } + } + } + } + my ($output,%children,%parent); + if (keys(%toplevelitems) > 0) { + my @contents = sort(keys(%toplevelitems)); + my ($count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir, + \%children,\%parent,\@contents); + } + my (@above,%hierarchy,%referrer,%orphaned,%todelete); + foreach my $depth (sort { $a <=> $b } keys(%parent)) { + push(@above,$parent{$depth}); + foreach my $item (split(/:/,$children{$parent{$depth}})) { + $hierarchy{$item} = \@above; + } + } + if ($numitems) { + for (my $i=1; $i<=$numitems; $i++) { + my $path = $env{'form.archive_content_'.$i}; + if ($path =~ /^\Q$pathtocheck\E/) { + if ($env{'form.archive_'.$i} eq 'discard') { + if ($prefix ne '' && $path ne '') { + if (-e $prefix.$path) { + $todelete{$prefix.$path} = 1; + } + } + } elsif ($env{'form.archive_'.$i} eq 'display') { + my ($title,$url,$outer); + ($title) = ($path =~ m{/([^/]+)$}); + $outer = 0; + if (ref($hierarchy{$i}) eq 'ARRAY') { + if (@{$hierarchy{$i}} > 0) { + foreach my $item (reverse(@{$hierarchy{$i}})) { + if ($env{'form.archive_'.$item} eq 'display') { + $outer = $item; + last; + } + } + } + } + my ($errtext,$fatal) = + &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname. + '/'.$folders{$outer}.'.'. + $containers{$outer}); + next if ($fatal); + if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) { + if ($context eq 'coursedocs') { + $mapinner{$i} = time; + $folders{$i} = 'default_'.$mapinner{$i}; + $containers{$i} = 'sequence'; + my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'. + $folders{$i}.'.'.$containers{$i}; + my $newidx = &LONCAPA::map::getresidx(); + $LONCAPA::map::resources[$newidx]= + $title.':'.$url.':false:normal:res'; + push(@LONCAPA::map::order,$newidx); + my ($outtext,$errtext) = + &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'. + $docuname.'/'.$folders{$outer}. + '.'.$containers{$outer},1); + } + } else { + if ($context eq 'coursedocs') { + my $newidx=&LONCAPA::map::getresidx(); + my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'. + $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'. + $title; + if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") { + mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755); + } + if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") { + mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx"); + } + if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") { + system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title"); + } + $LONCAPA::map::resources[$newidx]= + $title.':'.$url.':false:normal:res'; + push(@LONCAPA::map::order, $newidx); + my ($outtext,$errtext)= + &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'. + $docuname.'/'.$folders{$outer}. + '.'.$containers{$outer},1); + } + } + } elsif ($env{'form.archive_'.$i} eq 'dependency') { + if (ref($hierarchy{$i}) eq 'ARRAY') { + foreach my $item (reverse(@{$hierarchy{$i}})) { + if ($env{'form.archive_'.$item} eq 'display') { + $referrer{$i} = $item; + last; + #FIXME identify as dependency in db file + #FIXME need to move item to referrer location + #FIXME need to setup httprefs so access allowed + } elsif ($env{'form.archive_'.$item} eq 'discard') { + $orphaned{$i} = $item; + last; + } + } + } + } + } else { + $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'
'; + } + } + if (keys(%todelete)) { + foreach my $key (keys(%todelete)) { + unlink($key); + unless ($ishome) { + #FIXME Need to notify homeserver to delete files. + } + } + } + } else { + $warning = &mt('No items found in archive.'); + } + if ($error) { + $output .= '

'.&mt('Not extracted.').'
'. + $error.'

'."\n"; + } + if ($warning) { + $output .= '

'.$warning.'

'."\n"; + } + return $output; +} + =pod =item * &get_turnedin_filepath()