--- loncom/interface/loncommon.pm 2010/09/01 16:51:47 1.948.2.9
+++ loncom/interface/loncommon.pm 2011/10/03 12:39:41 1.948.2.31
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.948.2.9 2010/09/01 16:51:47 raeburn Exp $
+# $Id: loncommon.pm,v 1.948.2.31 2011/10/03 12:39:41 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -452,7 +452,7 @@ sub selectstudent_link {
&mt('Select User').'';
}
if ($env{'request.role'}=~/^(au|dc|su)/) {
- $callargs .= ",1";
+ $callargs .= ",'',1";
return ''.
''.
&mt('Select User').'';
@@ -596,6 +596,51 @@ ENDJS
}
+sub javascript_array_indexof {
+ return < &"').'" onclick="javascript:setSearch(\'1\','.$caller.');" /> '.&mt('or').' '.&mt('Uploaded [_1]',''.
- $path.$fname.'').' '.$output.' '.&mt('or').' '.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).','','').' '.&mt('Changes need to be made to the reference(s) used for one or more of the dependencies, if your HTML file is to work correctly:').''.&mt('Transaction [_1]',$version).' ';
if (@hidden) {
foreach my $key (sort(keys(%lasthash))) {
+ next if ($key =~ /\.foilorder$/);
my $hide;
foreach my $id (@hidden) {
if ($key =~ /^\Q$id\E/) {
@@ -3492,6 +3545,7 @@ sub get_previous_attempt {
}
} else {
foreach my $key (sort(keys(%lasthash))) {
+ next if ($key =~ /\.foilorder$/);
my $value = &format_previous_attempt_value($key,
$returnhash{$version.':'.$key});
$prevattempts.=''.$value.' ';
@@ -3503,6 +3557,7 @@ sub get_previous_attempt {
my @currhidden = keys(%lasthidden);
$prevattempts.=&start_data_table_row().''.&mt('Current').' ';
foreach my $key (sort(keys(%lasthash))) {
+ next if ($key =~ /\.foilorder$/);
if (%typeparts) {
my $hidden;
foreach my $id (@currhidden) {
@@ -3558,6 +3613,29 @@ sub format_previous_attempt_value {
$value = &Apache::lonlocal::locallocaltime($value);
} elsif (ref($value) eq 'ARRAY') {
$value = '('.join(', ', @{ $value }).')';
+ } elsif ($key =~ /answerstring$/) {
+ my %answers = &Apache::lonnet::str2hash($value);
+ my @anskeys = sort(keys(%answers));
+ if (@anskeys == 1) {
+ my $answer = $answers{$anskeys[0]};
+ if ($answer =~ m{\0}) {
+ $answer =~ s{\0}{,}g;
+ }
+ my $tag_internal_answer_name = 'INTERNAL';
+ if ($anskeys[0] eq $tag_internal_answer_name) {
+ $value = $answer;
+ } else {
+ $value = $anskeys[0].'='.$answer;
+ }
+ } else {
+ foreach my $ans (@anskeys) {
+ my $answer = $answers{$ans};
+ if ($answer =~ m{\0}) {
+ $answer =~ s{\0}{,}g;
+ }
+ $value .= $ans.'='.$answer.'
';;
+ }
+ }
} else {
$value = &unescape($value);
}
@@ -3836,7 +3914,9 @@ sub findallcourses {
$udom = $env{'user.domain'};
}
if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
- my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
+ my $extra = &Apache::lonnet::freeze_escape({'skipcheck' => 1});
+ my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname,'.',undef,
+ $extra);
if (!%roles) {
%roles = (
cc => 1,
@@ -4250,8 +4330,7 @@ sub get_domainconf {
if (ref($domconfig{'login'}{$key}) eq 'HASH') {
if ($key eq 'loginvia') {
if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
- my @ids = &Apache::lonnet::current_machine_ids();
- foreach my $hostname (@ids) {
+ foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {
if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
@@ -4260,7 +4339,7 @@ sub get_domainconf {
$designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
} else {
- $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
+ $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
}
if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
$designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
@@ -4401,7 +4480,10 @@ sub designparm {
return $env{'environment.color.'.$which};
}
$domain=&determinedomain($domain);
- my %domdesign = &get_domainconf($domain);
+ my %domdesign;
+ unless ($domain eq 'public') {
+ %domdesign = &get_domainconf($domain);
+ }
my $output;
if ($domdesign{$domain.'.'.$which} ne '') {
$output = $domdesign{$domain.'.'.$which};
@@ -4464,7 +4546,7 @@ Returns: HTML div with $content
sub head_subbox {
my ($content)=@_;
my $output =
- '
'.&start_data_table();
-
+ my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges);
my $num = 0;
- foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%{$allfiles})) {
+ my $numremref = 0;
+ my $numinvalid = 0;
+ my $numpathchg = 0;
+ my $numexisting = 0;
+ my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath);
+ if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
+ my $current_path='/';
+ if ($env{'form.currentpath'}) {
+ $current_path = $env{'form.currentpath'};
+ }
+ if ($actionurl eq '/adm/coursegrp_portfolio') {
+ $udom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ $uname = $env{'course.'.$env{'request.course.id'}.'.num'};
+ $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
+ } else {
+ $udom = $env{'user.domain'};
+ $uname = $env{'user.name'};
+ $url = '/userfiles/portfolio';
+ }
+ $toplevel = $url.'/';
+ $url .= $current_path;
+ $getpropath = 1;
+ } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
+ ($actionurl eq '/adm/imsimport')) {
+ ($uname,my $rest) = ($args->{'current_path'} =~ m{/priv/($match_username)/?(.*)$});
+ $url = '/home/'.$uname.'/public_html/';
+ $toplevel = $url;
+ if ($rest ne '') {
+ $url .= $rest;
+ }
+ } elsif ($actionurl eq '/adm/coursedocs') {
+ if (ref($args) eq 'HASH') {
+ $url = $args->{'docs_url'};
+ $toplevel = $url;
+ }
+ }
+ my $now = time();
+ foreach my $embed_file (keys(%{$allfiles})) {
+ my $absolutepath;
+ if ($embed_file =~ m{^\w+://}) {
+ $newfiles{$embed_file} = 1;
+ $mapping{$embed_file} = $embed_file;
+ } else {
+ if ($embed_file =~ m{^/}) {
+ $absolutepath = $embed_file;
+ $embed_file =~ s{^(/+)}{};
+ }
+ if ($embed_file =~ m{/}) {
+ my ($path,$fname) = ($embed_file =~ m{^(.+)/([^/]*)$});
+ $path = &check_for_traversal($path,$url,$toplevel);
+ my $item = $fname;
+ if ($path ne '') {
+ $item = $path.'/'.$fname;
+ $subdependencies{$path}{$fname} = 1;
+ } else {
+ $dependencies{$item} = 1;
+ }
+ if ($absolutepath) {
+ $mapping{$item} = $absolutepath;
+ } else {
+ $mapping{$item} = $embed_file;
+ }
+ } else {
+ $dependencies{$embed_file} = 1;
+ if ($absolutepath) {
+ $mapping{$embed_file} = $absolutepath;
+ } else {
+ $mapping{$embed_file} = $embed_file;
+ }
+ }
+ }
+ }
+ foreach my $path (keys(%subdependencies)) {
+ my %currsubfile;
+ if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
+ my @subdir_list = &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
+ foreach my $line (@subdir_list) {
+ my ($file_name,$rest) = split(/\&/,$line,2);
+ $currsubfile{$file_name} = 1;
+ }
+ } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
+ if (opendir(my $dir,$url.'/'.$path)) {
+ my @subdir_list = grep(!/^\./,readdir($dir));
+ map {$currsubfile{$_} = 1;} @subdir_list;
+ }
+ }
+ foreach my $file (keys(%{$subdependencies{$path}})) {
+ if ($currsubfile{$file}) {
+ my $item = $path.'/'.$file;
+ unless ($mapping{$item} eq $item) {
+ $pathchanges{$item} = 1;
+ }
+ $existing{$item} = 1;
+ $numexisting ++;
+ } else {
+ $newfiles{$path.'/'.$file} = 1;
+ }
+ }
+ }
+ my %currfile;
+ if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
+ my @dir_list = &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
+ foreach my $line (@dir_list) {
+ my ($file_name,$rest) = split(/\&/,$line,2);
+ $currfile{$file_name} = 1;
+ }
+ } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
+ if (opendir(my $dir,$url)) {
+ my @dir_list = grep(!/^\./,readdir($dir));
+ map {$currfile{$_} = 1;} @dir_list;
+ }
+ }
+ foreach my $file (keys(%dependencies)) {
+ if ($currfile{$file}) {
+ unless ($mapping{$file} eq $file) {
+ $pathchanges{$file} = 1;
+ }
+ $existing{$file} = 1;
+ $numexisting ++;
+ } else {
+ $newfiles{$file} = 1;
+ }
+ }
+ foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
$upload_output .= &start_data_table_row().
- ''.$embed_file.' ';
+ ' '.$embed_file.'';
+ unless ($mapping{$embed_file} eq $embed_file) {
+ $upload_output .= '
'.&mt('changed from: [_1]',$mapping{$embed_file}).'';
+ }
+ $upload_output .= '';
if ($args->{'ignore_remote_references'}
&& $embed_file =~ m{^\w+://}) {
$upload_output.=''.&mt("URL points to other server.").'';
+ $numremref++;
} elsif ($args->{'error_on_invalid_names'}
&& $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
- $upload_output.=''.&mt("Invalid characters").'';
-
+ $upload_output.=''.&mt('Invalid characters').'';
+ $numinvalid++;
} else {
- $upload_output .='
-
- ';
- my $attrib = join(':',@{$$allfiles{$embed_file}});
- $upload_output .=
- "\n\t\t".
- '';
- if (exists($$codebase{$embed_file})) {
- $upload_output .=
- "\n\t\t".
- '';
- }
- }
- $upload_output .= ' '.&Apache::loncommon::end_data_table_row();
- $num++;
- }
- $upload_output .= &Apache::loncommon::end_data_table().'
-
-
- '.&mt('(only files for which a location has been provided will be uploaded)').'
- ';
- return $upload_output;
+ $upload_output .= &embedded_file_element('upload_embedded',$num,
+ $embed_file,\%mapping,
+ $allfiles,$codebase);
+ $num++;
+ }
+ $upload_output .= ''.&Apache::loncommon::end_data_table_row()."\n";
+ }
+ foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
+ $upload_output .= &start_data_table_row().
+ ''.$embed_file.' '.
+ ''.&mt('Already exists').' '.
+ &Apache::loncommon::end_data_table_row()."\n";
+ }
+ if ($upload_output) {
+ $upload_output = &start_data_table().
+ $upload_output.
+ &end_data_table()."\n";
+ }
+ my $applies = 0;
+ if ($numremref) {
+ $applies ++;
+ }
+ if ($numinvalid) {
+ $applies ++;
+ }
+ if ($numexisting) {
+ $applies ++;
+ }
+ if ($num) {
+ $output = ''."\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 .= '
';
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);
+ $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'
';
next;
} elsif ($fname=~/\.(\d+)\.(\w+)$/) {
- $output .= &mt('File name 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;
if ($context eq 'portfolio') {
- my $result=
- &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
- $dirpath.$path);
+ my $result;
+ if ($state eq 'existingfile') {
+ $result=
+ &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
+ $dirpath.$env{'form.currentpath'}.$path);
+ } else {
+ $result=
+ &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
+ $dirpath.
+ $env{'form.currentpath'}.$path);
+ if ($result !~ m|^/uploaded/|) {
+ $output .= ''
+ .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
+ ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
+ .'
';
+ next;
+ } else {
+ $output .= &mt('Uploaded [_1]',''.
+ $path.$fname.'').'
';
+ }
+ }
+ } elsif ($context eq 'coursedoc') {
+ my $result =
+ &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].'
+ .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
- .'
';
- next;
+ .'
';
+ next;
} else {
- $output .= '
';
}
} else {
# Save the file
@@ -8580,19 +8943,190 @@ sub upload_embedded {
&mt('An error occurred while writing the file [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
'
';
} else {
- if ($context eq 'testbank') {
- $output .= &mt('Embedded file uploaded successfully:').
- ' '.
- $orig_uploaded_filename.'
';
- } else {
- $output .= ''.
- &mt('View embedded file: [_1]',''.
- $orig_uploaded_filename.'').'
';
+ $output .= &mt('Uploaded [_1]',''.
+ $url.'').'
';
+ unless ($context eq 'testbank') {
+ $footer .= &mt('View embedded file: [_1]',
+ ''.$fname.'').'
';
}
}
close($fh);
}
}
+ if ($env{'form.embedded_ref_'.$i}) {
+ $pathchange{$i} = 1;
+ }
+ }
+ if ($output) {
+ $output = ''.
+ ' '.$env{'form.embedded_ref_'.$i}.
+ ''.
+ ''.
+ ' '.
+ ''.$env{'form.embedded_orig_'.$i}.
+ ' '.
+ &end_data_table_row();
+ }
+ }
+ } else {
+ $modifyform = $pathchgtable;
+ if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
+ $hiddenstate .= '';
+ } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
+ $hiddenstate .= '';
+ }
+ }
+ if ($modifyform) {
+ return ''.&mt('Changes in content of HTML file required').'
'."\n".
+ ''."\n".
+ '
'. + &mt('LON-CAPA can make the required changes to your HTML file.').'
'."\n". + ''."\n"; + } + return; +} + +sub modify_html_refs { + my ($context,$dirpath,$uname,$udom,$dir_root) = @_; + my $container; + if ($context eq 'portfolio') { + $container = $env{'form.container'}; + } elsif ($context eq 'coursedoc') { + $container = $env{'form.primaryurl'}; + } else { + $container = $env{'form.filename'}; + $container =~ s{^/priv/(\Q$uname\E)/(.*)}{/home/$1/public_html/$2}; + } + my (%allfiles,%codebase,$output,$content); + my @changes = &get_env_multiple('form.namechange'); + return unless (@changes > 0); + if (($context eq 'portfolio') || ($context eq 'coursedoc')) { + return unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}); + $content = &Apache::lonnet::getfile($container); + return if ($content eq '-1'); + } else { + return unless ($container =~ /^\Q$dir_root\E/); + if (open(my $fh,"<$container")) { + $content = join('', <$fh>); + close($fh); + } else { + return; + } + } + my ($count,$codebasecount) = (0,0); + my $mm = new File::MMagic; + my $mime_type = $mm->checktype_contents($content); + if ($mime_type eq 'text/html') { + my $parse_result = + &Apache::lonnet::extract_embedded_items($container,\%allfiles, + \%codebase,\$content); + if ($parse_result eq 'ok') { + foreach my $i (@changes) { + my $orig = &unescape($env{'form.embedded_orig_'.$i}); + my $ref = &unescape($env{'form.embedded_ref_'.$i}); + if ($allfiles{$ref}) { + my $newname = $orig; + my ($attrib_regexp,$codebase); + $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i}); + if ($attrib_regexp =~ /:/) { + $attrib_regexp =~ s/\:/|/g; + } + 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; + } + if ($env{'form.embedded_codebase_'.$i} ne '') { + $codebase = &unescape($env{'form.embedded_codebase_'.$i}); + my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs + $codebasecount ++; + } + } + } + if ($count || $codebasecount) { + my $saveresult; + if ($context eq 'portfolio' || $context eq 'coursedoc') { + my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult); + if ($url eq $container) { + my ($fname) = ($container =~ m{/([^/]+)$}); + $output = ''.&mt('Updated [quant,_1,reference] in [_2].', + $count,''. + $fname.'').'
'; + } else { + $output = ''. + &mt('Error: update failed for: [_1].', + ''. + $container.'').'
'; + } + } else { + if (open(my $fh,">$container")) { + print $fh $content; + close($fh); + $output = ''.&mt('Updated [quant,_1,reference] in [_2].', + $count,''. + $container.'').'
'; + } else { + $output = ''. + &mt('Error: could not update [_1].', + ''. + $container.'').'
'; + } + } + } + } else { + &logthis('Failed to parse '.$container. + ' to modify references: '.$parse_result); + } } return $output; } @@ -8616,22 +9150,71 @@ sub check_for_existing { sub check_for_upload { my ($path,$fname,$group,$element,$portfolio_root,$port_path, $disk_quota,$current_disk_usage,$uname,$udom) = @_; - my $filesize = (length($env{'form.'.$element})) / 1000; #express in k (1024?) + my $filesize = length($env{'form.'.$element}); + if (!$filesize) { + my $msg = ''. + &mt('Unable to upload [_1]. (size = [_2] bytes)', + ''.$fname.'', + $filesize).'