";
+ if ($bgcolor ne '') {
+ $tdcol = "background-color: $bgcolor;";
+ }
+ return <<"END";
+
+END
}
sub end_scrollbox {
@@ -7370,7 +7888,7 @@ sub simple_error_page {
my ($r,$title,$msg) = @_;
my $page =
&Apache::loncommon::start_page($title).
- &mt($msg).
+ '
'.&mt($msg).'
'.
&Apache::loncommon::end_page();
if (ref($r)) {
$r->print($page);
@@ -7585,8 +8103,7 @@ role status: active, previous or future.
sub check_user_status {
my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
- my $extra = &Apache::lonnet::freeze_escape({'skipcheck' => 1});
- my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname,'.',undef,$extra);
+ my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
my @uroles = keys %userinfo;
my $srchstr;
my $active_chk = 'none';
@@ -8488,7 +9005,10 @@ sub user_rule_formats {
my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
if (@{$ruleorder} > 0) {
- $output = '
'.&mt("$text{$check} with the following format(s) may
only be used for verified users at [_1]:",$domdesc).'
';
+ $output = ' '.
+ &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
+ '',' ',$domdesc).
+ ' ';
foreach my $rule (@{$ruleorder}) {
if (ref($curr_rules) eq 'ARRAY') {
if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
@@ -8817,6 +9337,8 @@ sub get_future_slots {
=pod
+=back
+
=head1 HTTP Helpers
=over 4
@@ -8955,13 +9477,24 @@ sub get_env_multiple {
sub ask_for_embedded_content {
my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
- my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges);
- my $num = 0;
+ my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
+ %currsubfile,%unused,$rem);
+ my $counter = 0;
+ my $numnew = 0;
my $numremref = 0;
my $numinvalid = 0;
my $numpathchg = 0;
my $numexisting = 0;
- my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath);
+ my $numunused = 0;
+ my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
+ $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path);
+ my $heading = &mt('Upload embedded files');
+ my $buttontext = &mt('Upload');
+
+ my $navmap;
+ if ($env{'request.course.id'}) {
+ $navmap = Apache::lonnavmaps::navmap->new();
+ }
if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
my $current_path='/';
if ($env{'form.currentpath'}) {
@@ -8989,8 +9522,32 @@ sub ask_for_embedded_content {
}
} elsif ($actionurl eq '/adm/coursedocs') {
if (ref($args) eq 'HASH') {
- $url = $args->{'docs_url'};
- $toplevel = $url;
+ $url = $args->{'docs_url'};
+ $toplevel = $url;
+ if ($args->{'context'} eq 'paste') {
+ ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
+ ($path) =
+ ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
+ $fileloc = &Apache::lonnet::filelocation('',$toplevel);
+ $fileloc =~ s{^/}{};
+ }
+ }
+ } elsif ($actionurl eq '/adm/dependencies') {
+ if ($env{'request.course.id'} ne '') {
+ $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ if (ref($args) eq 'HASH') {
+ $url = $args->{'docs_url'};
+ $title = $args->{'docs_title'};
+ $toplevel = "/$url";
+ ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
+ ($path) =
+ ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
+ $fileloc = &Apache::lonnet::filelocation('',$toplevel);
+ $fileloc =~ s{^/}{};
+ ($filename) = ($fileloc =~ m{.+/([^/]+)$});
+ $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
+ }
}
}
my $now = time();
@@ -9029,25 +9586,46 @@ sub ask_for_embedded_content {
}
}
}
+ my $dirptr = 16384;
foreach my $path (keys(%subdependencies)) {
- my %currsubfile;
+ $currsubfile{$path} = {};
if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
my ($sublistref,$listerror) =
&Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
if (ref($sublistref) eq 'ARRAY') {
foreach my $line (@{$sublistref}) {
my ($file_name,$rest) = split(/\&/,$line,2);
- $currsubfile{$file_name} = 1;
+ $currsubfile{$path}{$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;
+ map {$currsubfile{$path}{$_} = 1;} @subdir_list;
+ }
+ } elsif (($actionurl eq '/adm/dependencies') ||
+ (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
+ ($args->{'context'} eq 'paste'))) {
+ if ($env{'request.course.id'} ne '') {
+ my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
+ if ($dir ne '') {
+ my ($sublistref,$listerror) =
+ &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
+ if (ref($sublistref) eq 'ARRAY') {
+ foreach my $line (@{$sublistref}) {
+ my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
+ undef,$mtime)=split(/\&/,$line,12);
+ unless (($testdir&$dirptr) ||
+ ($file_name =~ /^\.\.?$/)) {
+ $currsubfile{$path}{$file_name} = [$size,$mtime];
+ }
+ }
+ }
+ }
}
}
foreach my $file (keys(%{$subdependencies{$path}})) {
- if ($currsubfile{$file}) {
+ if (exists($currsubfile{$path}{$file})) {
my $item = $path.'/'.$file;
unless ($mapping{$item} eq $item) {
$pathchanges{$item} = 1;
@@ -9058,6 +9636,23 @@ sub ask_for_embedded_content {
$newfiles{$path.'/'.$file} = 1;
}
}
+ if ($actionurl eq '/adm/dependencies') {
+ foreach my $path (keys(%currsubfile)) {
+ if (ref($currsubfile{$path}) eq 'HASH') {
+ foreach my $file (keys(%{$currsubfile{$path}})) {
+ unless ($subdependencies{$path}{$file}) {
+ next if (($rem ne '') &&
+ (($env{"httpref.$rem"."$path/$file"} ne '') ||
+ (ref($navmap) &&
+ (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
+ (($file =~ /^(.*\.s?html?)\.bak$/i) &&
+ ($navmap->getResourceByUrl($rem."$path/$1")))))));
+ $unused{$path.'/'.$file} = 1;
+ }
+ }
+ }
+ }
+ }
}
my %currfile;
if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
@@ -9074,9 +9669,29 @@ sub ask_for_embedded_content {
my @dir_list = grep(!/^\./,readdir($dir));
map {$currfile{$_} = 1;} @dir_list;
}
+ } elsif (($actionurl eq '/adm/dependencies') ||
+ (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
+ ($args->{'context'} eq 'paste'))) {
+ if ($env{'request.course.id'} ne '') {
+ my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
+ if ($dir ne '') {
+ my ($dirlistref,$listerror) =
+ &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
+ if (ref($dirlistref) eq 'ARRAY') {
+ foreach my $line (@{$dirlistref}) {
+ my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
+ $size,undef,$mtime)=split(/\&/,$line,12);
+ unless (($testdir&$dirptr) ||
+ ($file_name =~ /^\.\.?$/)) {
+ $currfile{$file_name} = [$size,$mtime];
+ }
+ }
+ }
+ }
+ }
}
foreach my $file (keys(%dependencies)) {
- if ($currfile{$file}) {
+ if (exists($currfile{$file})) {
unless ($mapping{$file} eq $file) {
$pathchanges{$file} = 1;
}
@@ -9086,41 +9701,124 @@ sub ask_for_embedded_content {
$newfiles{$file} = 1;
}
}
+ foreach my $file (keys(%currfile)) {
+ unless (($file eq $filename) ||
+ ($file eq $filename.'.bak') ||
+ ($dependencies{$file})) {
+ if ($actionurl eq '/adm/dependencies') {
+ next if (($rem ne '') &&
+ (($env{"httpref.$rem".$file} ne '') ||
+ (ref($navmap) &&
+ (($navmap->getResourceByUrl($rem.$file) ne '') ||
+ (($file =~ /^(.*\.s?html?)\.bak$/i) &&
+ ($navmap->getResourceByUrl($rem.$1)))))));
+ }
+ $unused{$file} = 1;
+ }
+ }
+ if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
+ ($args->{'context'} eq 'paste')) {
+ $counter = scalar(keys(%existing));
+ $numpathchg = scalar(keys(%pathchanges));
+ return ($output,$counter,$numpathchg,\%existing);
+ }
foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
+ if ($actionurl eq '/adm/dependencies') {
+ next if ($embed_file =~ m{^\w+://});
+ }
$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+://}) {
+ 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').' ';
$numinvalid++;
} else {
- $upload_output .= &embedded_file_element('upload_embedded',$num,
+ $upload_output .= &embedded_file_element('upload_embedded',$counter,
$embed_file,\%mapping,
- $allfiles,$codebase);
- $num++;
+ $allfiles,$codebase,'upload');
+ $counter ++;
+ $numnew ++;
}
$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 ($actionurl eq '/adm/dependencies') {
+ my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
+ $modify_output .= &start_data_table_row().
+ ''.
+ ' '.
+ ' '.$embed_file.' '.
+ ''.$size.' '.
+ ''.$mtime.' '.
+ ' '.&mt('Yes').' '.
+ ''.
+ &embedded_file_element('upload_embedded',$counter,
+ $embed_file,\%mapping,
+ $allfiles,$codebase,'modify').
+ '
'.
+ &end_data_table_row()."\n";
+ $counter ++;
+ } else {
+ $upload_output .= &start_data_table_row().
+ ''.$embed_file.' ';
+ ''.&mt('Already exists').' '.
+ &Apache::loncommon::end_data_table_row()."\n";
+ }
+ }
+ my $delidx = $counter;
+ foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
+ my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
+ $delete_output .= &start_data_table_row().
+ ' '.
+ ' '.$oldfile.' '.
+ ''.$size.' '.
+ ''.$mtime.' '.
+ ' '.&mt('Yes').' '.
+ &embedded_file_element('upload_embedded',$delidx,
+ $oldfile,\%mapping,$allfiles,
+ $codebase,'delete').' '.
+ &end_data_table_row()."\n";
+ $numunused ++;
+ $delidx ++;
}
if ($upload_output) {
$upload_output = &start_data_table().
$upload_output.
&end_data_table()."\n";
}
+ if ($modify_output) {
+ $modify_output = &start_data_table().
+ &start_data_table_header_row().
+ ''.&mt('File').' '.
+ ''.&mt('Size (KB)').' '.
+ ''.&mt('Modified').' '.
+ ''.&mt('Upload replacement?').' '.
+ &end_data_table_header_row().
+ $modify_output.
+ &end_data_table()."\n";
+ }
+ if ($delete_output) {
+ $delete_output = &start_data_table().
+ &start_data_table_header_row().
+ ''.&mt('File').' '.
+ ''.&mt('Size (KB)').' '.
+ ''.&mt('Modified').' '.
+ ''.&mt('Delete?').' '.
+ &end_data_table_header_row().
+ $delete_output.
+ &end_data_table()."\n";
+ }
my $applies = 0;
if ($numremref) {
$applies ++;
@@ -9131,15 +9829,37 @@ sub ask_for_embedded_content {
if ($numexisting) {
$applies ++;
}
- if ($num) {
+ if ($counter || $numunused) {
$output = ' '."\n";
+ $output .= '
'."\n".''."\n";
} elsif ($numpathchg) {
my %pathchange = ();
$output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
@@ -9209,15 +9930,15 @@ sub ask_for_embedded_content {
$output .= '
'.&mt('or').'
';
}
}
- return ($output,$num,$numpathchg);
+ return ($output,$counter,$numpathchg);
}
sub embedded_file_element {
- my ($context,$num,$embed_file,$mapping,$allfiles,$codebase) = @_;
+ my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
(ref($codebase) eq 'HASH'));
my $output;
- if ($context eq 'upload_embedded') {
+ if (($context eq 'upload_embedded') && ($type ne 'delete')) {
$output = '
'."\n";
}
$output .= '
0) {
+ $showmtime = &Apache::lonlocal::locallocaltime($mtime);
+ }
+ }
+ return ($showsize,$showmtime);
+}
+
+sub ask_embedded_js {
+ return <<"END";
+
+
+END
+}
+
sub upload_embedded {
my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
$current_disk_usage,$hiddenstate,$actionurl) = @_;
@@ -9302,7 +10067,6 @@ sub upload_embedded {
$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;
@@ -9359,13 +10123,15 @@ sub upload_embedded {
if (!open($fh,'>'.$dest)) {
&Apache::lonnet::logthis('Failed to create '.$dest);
$output .= '
'.
- &mt('An error occurred while trying to upload [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
+ &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
+ $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
' ';
} else {
if (!print $fh $env{'form.embedded_item_'.$i}) {
&Apache::lonnet::logthis('Failed to write to '.$dest);
$output .= '
'.
- &mt('An error occurred while writing the file [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
+ &mt('An error occurred while writing the file [_1] for embedded element [_2].',
+ $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
' ';
} else {
$output .= &mt('Uploaded [_1]','
'.
@@ -9387,15 +10153,17 @@ sub upload_embedded {
}
$output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
$returnflag = 'ok';
- if (keys(%pathchange) > 0) {
+ my $numpathchgs = scalar(keys(%pathchange));
+ if ($numpathchgs > 0) {
if ($context eq 'portfolio') {
$output .= ''.&mt('or').'
';
} elsif ($context eq 'testbank') {
- $output .= ''.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).','',' ').'
';
+ $output .= ''.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
+ '',' ').'
';
$returnflag = 'modify_orightml';
}
}
- return ($output.$footer,$returnflag);
+ return ($output.$footer,$returnflag,$numpathchgs);
}
sub modify_html_form {
@@ -9430,7 +10198,7 @@ sub modify_html_form {
' '.
&end_data_table_row();
- }
+ }
}
} else {
$modifyform = $pathchgtable;
@@ -9441,6 +10209,9 @@ sub modify_html_form {
}
}
if ($modifyform) {
+ if ($actionurl eq '/adm/dependencies') {
+ $hiddenstate .= ' ';
+ }
return ''.&mt('Changes in content of HTML file required').' '."\n".
''.&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:').'
'."\n".
''.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').' '."\n".
@@ -9469,23 +10240,55 @@ sub modify_html_refs {
$container = $env{'form.container'};
} elsif ($context eq 'coursedoc') {
$container = $env{'form.primaryurl'};
+ } elsif ($context eq 'manage_dependencies') {
+ (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
+ $container = "/$container";
} else {
$container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
}
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/});
+ unless (@changes > 0) {
+ if (wantarray) {
+ return ('',0,0);
+ } else {
+ return;
+ }
+ }
+ if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
+ ($context eq 'manage_dependencies')) {
+ unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
+ if (wantarray) {
+ return ('',0,0);
+ } else {
+ return;
+ }
+ }
$content = &Apache::lonnet::getfile($container);
- return if ($content eq '-1');
+ if ($content eq '-1') {
+ if (wantarray) {
+ return ('',0,0);
+ } else {
+ return;
+ }
+ }
} else {
- return unless ($container =~ /^\Q$dir_root\E/);
+ unless ($container =~ /^\Q$dir_root\E/) {
+ if (wantarray) {
+ return ('',0,0);
+ } else {
+ return;
+ }
+ }
if (open(my $fh,"<$container")) {
$content = join('', <$fh>);
close($fh);
} else {
- return;
+ if (wantarray) {
+ return ('',0,0);
+ } else {
+ return;
+ }
}
}
my ($count,$codebasecount) = (0,0);
@@ -9519,13 +10322,14 @@ sub modify_html_refs {
}
if ($count || $codebasecount) {
my $saveresult;
- if ($context eq 'portfolio' || $context eq 'coursedoc') {
+ if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
+ ($context eq 'manage_dependencies')) {
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.' ').'
';
+ $fname.'').'';
} else {
$output = ''.
&mt('Error: update failed for: [_1].',
@@ -9552,7 +10356,11 @@ sub modify_html_refs {
' to modify references: '.$parse_result);
}
}
- return $output;
+ if (wantarray) {
+ return ($output,$count,$codebasecount);
+ } else {
+ return $output;
+ }
}
sub check_for_existing {
@@ -9719,43 +10527,226 @@ sub is_archive_file {
}
sub decompress_form {
- my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements) = @_;
+ my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
my %lt = &Apache::lonlocal::texthash (
this => 'This file is an archive file.',
+ camt => 'This file is a Camtasia archive file.',
+ itsc => 'Its contents are as follows:',
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',
+ auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
+ proa => 'Process automatically?',
yes => 'Yes',
no => 'No',
+ fold => 'Title for folder containing movie',
+ movi => 'Title for page containing embedded movie',
);
- my $output = '
'.$lt{'this'}.' '.$lt{'youm'}.' ';
+ my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
+ my ($is_camtasia,$topdir,%toplevel,@paths);
+ my $info = &list_archive_contents($fileloc,\@paths);
+ if (@paths) {
+ foreach my $path (@paths) {
+ $path =~ s{^/}{};
+ if ($path =~ m{^([^/]+)/$}) {
+ $topdir = $1;
+ }
+ if ($path =~ m{^([^/]+)/}) {
+ $toplevel{$1} = $path;
+ } else {
+ $toplevel{$path} = $path;
+ }
+ }
+ }
if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
- $output .= $lt{'camt'};
+ 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 @diffs = &compare_arrays(\@paths,\@camtasia);
+ if (@diffs == 0) {
+ $is_camtasia = 1;
+ }
}
- $output .= '
';
- $output .= <<"START";
-
END
return $output;
}
+sub decompression_utility {
+ my ($program) = @_;
+ my @utilities = ('tar','gunzip','bunzip2','unzip');
+ my $location;
+ if (grep(/^\Q$program\E$/,@utilities)) {
+ foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
+ '/usr/sbin/') {
+ if (-x $dir.$program) {
+ $location = $dir.$program;
+ last;
+ }
+ }
+ }
+ return $location;
+}
+
+sub list_archive_contents {
+ my ($file,$pathsref) = @_;
+ my (@cmd,$output);
+ my $needsregexp;
+ if ($file =~ /\.zip$/) {
+ @cmd = (&decompression_utility('unzip'),"-l");
+ $needsregexp = 1;
+ } elsif (($file =~ m/\.tar\.gz$/) ||
+ ($file =~ /\.tgz$/)) {
+ @cmd = (&decompression_utility('tar'),"-ztf");
+ } elsif ($file =~ /\.tar\.bz2$/) {
+ @cmd = (&decompression_utility('tar'),"-jtf");
+ } elsif ($file =~ m|\.tar$|) {
+ @cmd = (&decompression_utility('tar'),"-tf");
+ }
+ if (@cmd) {
+ undef($!);
+ undef($@);
+ if (open(my $fh,"-|", @cmd, $file)) {
+ while (my $line = <$fh>) {
+ $output .= $line;
+ chomp($line);
+ my $item;
+ if ($needsregexp) {
+ ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
+ } else {
+ $item = $line;
+ }
+ if ($item ne '') {
+ unless (grep(/^\Q$item\E$/,@{$pathsref})) {
+ push(@{$pathsref},$item);
+ }
+ }
+ }
+ close($fh);
+ }
+ }
+ return $output;
+}
+
sub decompress_uploaded_file {
my ($file,$dir) = @_;
&Apache::lonnet::appenv({'cgi.file' => $file});
@@ -9785,8 +10776,6 @@ sub process_decompression {
} 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";
@@ -9797,47 +10786,61 @@ sub process_decompression {
$error = &mt('Archive file not found.');
}
}
- if ($dir eq '') {
+ my (@to_overwrite,@to_skip);
+ if ($env{'form.archive_overwrite_total'} > 0) {
+ my $total = $env{'form.archive_overwrite_total'};
+ for (my $i=0; $i<$total; $i++) {
+ if ($env{'form.archive_overwrite_'.$i} == 1) {
+ push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
+ } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
+ push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
+ }
+ }
+ }
+ my $numskip = scalar(@to_skip);
+ if (($numskip > 0) &&
+ ($numskip == $env{'form.archive_itemcount'})) {
+ $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
+ } elsif ($dir eq '') {
$error = &mt('Directory containing archive file unavailable.');
} elsif (!$error) {
- my ($decompressed,$display) = &decompress_uploaded_file($file,$dir);
+ my ($decompressed,$display);
+ if ($numskip > 0) {
+ my $tempdir = time.'_'.$$.int(rand(10000));
+ mkdir("$dir/$tempdir",0755);
+ system("mv $dir/$file $dir/$tempdir/$file");
+ ($decompressed,$display) =
+ &decompress_uploaded_file($file,"$dir/$tempdir");
+ foreach my $item (@to_skip) {
+ if (($item ne '') && ($item !~ /\.\./)) {
+ if (-f "$dir/$tempdir/$item") {
+ unlink("$dir/$tempdir/$item");
+ } elsif (-d "$dir/$tempdir/$item") {
+ system("rm -rf $dir/$tempdir/$item");
+ }
+ }
+ }
+ system("mv $dir/$tempdir/* $dir");
+ rmdir("$dir/$tempdir");
+ } else {
+ ($decompressed,$display) =
+ &decompress_uploaded_file($file,$dir);
+ }
if ($decompressed eq 'ok') {
- $output = &mt('Files extracted successfully from archive.').' ';
+ $output = ''.
+ &mt('Files extracted successfully from archive.').
+ '
'."\n";
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') {
+ if (ref($newdirlistref) eq 'ARRAY') {
foreach my $dir_line (@{$newdirlistref}) {
my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
- unless ($item =~ /\.+$/) {
+ unless (($item =~ /^\.+$/) || ($item eq $file) ||
+ ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
push(@newitems,$item);
if ($dirptr&$testdir) {
$is_dir{$item} = 1;
@@ -9854,8 +10857,11 @@ sub process_decompression {
}
}
if (@contents > 0) {
+ my $wantform;
+ unless ($env{'form.autoextract_camtasia'}) {
+ $wantform = 1;
+ }
my (%children,%parent,%dirorder,%titles);
- my $wantform = 1;
my ($count,$datatable) = &get_extracted($docudom,$docuname,
$currdir,\%is_dir,
\%children,\%parent,
@@ -9864,10 +10870,54 @@ sub process_decompression {
if ($datatable ne '') {
$output .= &archive_options_form('decompressed',$datatable,
$count,$hiddenelem);
- my $startcount = 4;
+ my $startcount = 6;
$output .= &archive_javascript($startcount,$count,
\%titles,\%children);
}
+ if ($env{'form.autoextract_camtasia'}) {
+ my %displayed;
+ my $total = 1;
+ $env{'form.archive_directory'} = [];
+ foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
+ my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
+ $path =~ s{/$}{};
+ my $item;
+ if ($path ne '') {
+ $item = "$path/$titles{$i}";
+ } else {
+ $item = $titles{$i};
+ }
+ $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
+ if ($item eq $contents[0]) {
+ push(@{$env{'form.archive_directory'}},$i);
+ $env{'form.archive_'.$i} = 'display';
+ $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
+ $displayed{'folder'} = $i;
+ } 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") {
+ push(@{$env{'form.archive_directory'}},$i);
+ }
+ $env{'form.archive_'.$i} = 'dependency';
+ }
+ $total ++;
+ }
+ for (my $i=1; $i<$total; $i++) {
+ next if ($i == $displayed{'web'});
+ next if ($i == $displayed{'folder'});
+ $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
+ }
+ $env{'form.phase'} = 'decompress_cleanup';
+ $env{'form.archivedelete'} = 1;
+ $env{'form.archive_count'} = $total-1;
+ $output .=
+ &process_extracted_files('coursedocs',$docudom,
+ $docuname,$destination,
+ $dir_root,$hiddenelem);
+ }
} else {
$warning = &mt('No new items extracted from archive file.');
}
@@ -9982,17 +11032,20 @@ sub archive_row {
my ($is_dir,$item,$currdir,$depth,$count) = @_;
my ($name) = ($item =~ m{([^/]+)$});
my %choices = &Apache::lonlocal::texthash (
- 'display' => 'Add as File',
+ 'display' => 'Add as file',
'dependency' => 'Include as dependency',
'discard' => 'Discard',
);
if ($is_dir) {
- $choices{'display'} = &mt('Add as Folder');
+ $choices{'display'} = &mt('Add as folder');
}
my $output = &start_data_table_row().''.$count.' '."\n";
my $offset = 0;
foreach my $action ('display','dependency','discard') {
$offset ++;
+ if ($action ne 'display') {
+ $offset ++;
+ }
$output .= ''.
' '."\n".
''."\n".
'';
+ } elsif ($action eq 'display') {
+ $output .= ''."\n".
+ &mt('Title:').' '."\n".
+ '
';
}
$output .= ' ';
}
@@ -10034,33 +11091,54 @@ sub archive_row {
}
sub archive_options_form {
- my ($form,$output,$count,$hiddenelem) = @_;
- return ' ';
}
sub archive_javascript {
my ($startcount,$numitems,$titles,$children) = @_;
return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
+ my $maintitle = $env{'form.comment'};
my $scripttag = <
// 0) {
- var startelement = $startcount + ((count-1) * 6);
- for (var j=1; j<5; j++) {
- if (j != 3) {
+ var startelement = $startcount + ((count-1) * 7);
+ for (var j=1; j<6; j++) {
+ if ((j != 2) && (j != 4)) {
var item = startelement + j;
if (form.elements[item].type == 'radio') {
if (form.elements[item].checked) {
@@ -10106,6 +11184,7 @@ var parents = new Array(numitems);
for (var i=0; i 0) {
dependencyCheck(form,count,offset);
- var item = (offset+$startcount)+6*(count-1);
+ var item = (offset+$startcount)+7*(count-1);
form.elements[item].checked = true;
if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
if (parents[count].length > 0) {
@@ -10139,17 +11218,20 @@ function containerCheck(form,count,offse
function dependencyCheck(form,count,offset) {
if (count > 0) {
- var chosen = (offset+$startcount)+6*(count-1);
- var depitem = $startcount + ((count-1) * 6) + 3;
+ var chosen = (offset+$startcount)+7*(count-1);
+ var depitem = $startcount + ((count-1) * 7) + 4;
var currtype = form.elements[depitem].type;
if (form.elements[chosen].value == 'dependency') {
document.getElementById('arc_depon_'+count).style.display='block';
form.elements[depitem].options.length = 0;
form.elements[depitem].options[0] = new Option('Select','',true,true);
- for (var i=1; i 0) {
- var item = (1+offset+$startcount)+6*(count-1);
+ var item = (1+offset+$startcount)+7*(count-1);
var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
if (parents[count].length > 0) {
@@ -10186,7 +11269,7 @@ function propagateSelect(form,count,offs
function containerSelect(form,count,offset,picked) {
if (count > 0) {
- var item = (offset+$startcount)+6*(count-1);
+ var item = (offset+$startcount)+7*(count-1);
if (form.elements[item].type == 'radio') {
if (form.elements[item].value == 'dependency') {
if (form.elements[item+1].type == 'select-one') {
@@ -10209,6 +11292,26 @@ function containerSelect(form,count,offs
}
}
+function titleCheck(form,count,offset) {
+ if (count > 0) {
+ var chosen = (offset+$startcount)+7*(count-1);
+ var depitem = $startcount + ((count-1) * 7) + 2;
+ var currtype = form.elements[depitem].type;
+ if (form.elements[chosen].value == 'display') {
+ document.getElementById('arc_title_'+count).style.display='block';
+ if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
+ document.getElementById('archive_title_'+count).value=maintitle;
+ }
+ } else {
+ document.getElementById('arc_title_'+count).style.display='none';
+ if (currtype == 'text') {
+ document.getElementById('archive_title_'+count).value='';
+ }
+ }
+ }
+ return;
+}
+
// ]]>
END
@@ -10221,7 +11324,7 @@ sub process_extracted_files {
return unless ($numitems);
my @ids=&Apache::lonnet::current_machine_ids();
my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
- %folders,%containers,%mapinner);
+ %folders,%containers,%mapinner,%prompttofetch);
my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
if (grep(/^\Q$docuhome\E$/,@ids)) {
$prefix = &LONCAPA::propath($docudom,$docuname);
@@ -10238,11 +11341,11 @@ sub process_extracted_files {
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';
+ if ($env{'form.folderpath'} =~ /\:1$/) {
+ $containers{'0'}='page';
+ } else {
+ $containers{'0'}='sequence';
+ }
}
my @archdirs = &get_env_multiple('form.archive_directory');
if ($numitems) {
@@ -10257,26 +11360,36 @@ sub process_extracted_files {
}
}
}
- my ($output,%children,%parent,%titles,%dirorder);
+ my ($output,%children,%parent,%titles,%dirorder,$result);
if (keys(%toplevelitems) > 0) {
my @contents = sort(keys(%toplevelitems));
(my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
\%parent,\@contents,\%dirorder,\%titles);
}
- my (%referrer,%orphaned,%todelete,%newdest,%newseqid);
+ my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
if ($numitems) {
for (my $i=1; $i<=$numitems; $i++) {
+ next if ($env{'form.archive_'.$i} eq 'dependency');
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;
+ if ((@archdirs > 0) &&
+ (grep(/^\Q$i\E$/,@archdirs))) {
+ $todeletedir{$prefix.$path} = 1;
+ } else {
+ $todelete{$prefix.$path} = 1;
+ }
}
}
} elsif ($env{'form.archive_'.$i} eq 'display') {
- my ($title,$url,$outer);
+ my ($docstitle,$title,$url,$outer);
($title) = ($path =~ m{/([^/]+)$});
+ $docstitle = $env{'form.archive_title_'.$i};
+ if ($docstitle eq '') {
+ $docstitle = $title;
+ }
$outer = 0;
if (ref($dirorder{$i}) eq 'ARRAY') {
if (@{$dirorder{$i}} > 0) {
@@ -10302,13 +11415,16 @@ sub process_extracted_files {
$folders{$i}.'.'.$containers{$i};
my $newidx = &LONCAPA::map::getresidx();
$LONCAPA::map::resources[$newidx]=
- $title.':'.$url.':false:normal:res';
+ $docstitle.':'.$url.':false:normal:res';
push(@LONCAPA::map::order,$newidx);
my ($outtext,$errtext) =
&LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
$docuname.'/'.$folders{$outer}.
- '.'.$containers{$outer},1);
+ '.'.$containers{$outer},1,1);
$newseqid{$i} = $newidx;
+ unless ($errtext) {
+ $result .= ''.&mt('Folder: [_1] added to course',$docstitle).' '."\n";
+ }
}
} else {
if ($context eq 'coursedocs') {
@@ -10325,87 +11441,148 @@ sub process_extracted_files {
if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
$newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
+ unless ($ishome) {
+ my $fetch = "$newdest{$i}/$title";
+ $fetch =~ s/^\Q$prefix$dir\E//;
+ $prompttofetch{$fetch} = 1;
+ }
}
$LONCAPA::map::resources[$newidx]=
- $title.':'.$url.':false:normal:res';
+ $docstitle.':'.$url.':false:normal:res';
push(@LONCAPA::map::order, $newidx);
my ($outtext,$errtext)=
&LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
$docuname.'/'.$folders{$outer}.
- '.'.$containers{$outer},1);
+ '.'.$containers{$outer},1,1);
+ unless ($errtext) {
+ if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
+ $result .= ''.&mt('File: [_1] added to course',$docstitle).' '."\n";
+ }
+ }
}
}
- } elsif ($env{'form.archive_'.$i} eq 'dependency') {
- my ($title) = ($path =~ m{/([^/]+)$});
- $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
- if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
- if (ref($dirorder{$i}) eq 'ARRAY') {
- my ($itemidx,$fullpath);
+ }
+ } else {
+ $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).' ';
+ }
+ }
+ for (my $i=1; $i<=$numitems; $i++) {
+ next unless ($env{'form.archive_'.$i} eq 'dependency');
+ my $path = $env{'form.archive_content_'.$i};
+ if ($path =~ /^\Q$pathtocheck\E/) {
+ my ($title) = ($path =~ m{/([^/]+)$});
+ $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
+ if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
+ if (ref($dirorder{$i}) eq 'ARRAY') {
+ my ($itemidx,$fullpath,$relpath);
+ if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
+ my $container = $dirorder{$referrer{$i}}->[-1];
for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
- if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
- my $container = $dirorder{$referrer{$i}}->[-1];
- for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
- if ($dirorder{$i}->[$j] eq $container) {
- $itemidx = $j;
- }
- }
+ if ($dirorder{$i}->[$j] eq $container) {
+ $itemidx = $j;
}
}
- if ($itemidx ne '') {
- if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
- if ($mapinner{$referrer{$i}}) {
- $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
- for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
- if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
- unless (defined($newseqid{$dirorder{$i}->[$j]})) {
- $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
- if (!-e $fullpath) {
- mkdir($fullpath,0755);
- }
- }
- } else {
- last;
+ }
+ if ($itemidx eq '') {
+ $itemidx = 0;
+ }
+ if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
+ if ($mapinner{$referrer{$i}}) {
+ $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
+ for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
+ if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
+ unless (defined($newseqid{$dirorder{$i}->[$j]})) {
+ $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
+ $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
+ if (!-e $fullpath) {
+ mkdir($fullpath,0755);
}
}
+ } else {
+ last;
}
- } elsif ($newdest{$referrer{$i}}) {
- $fullpath = $newdest{$referrer{$i}};
- for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
- if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
- $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
- last;
- } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
- unless (defined($newseqid{$dirorder{$i}->[$j]})) {
- $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
- if (!-e $fullpath) {
- mkdir($fullpath,0755);
- }
- }
- } else {
- last;
+ }
+ }
+ } elsif ($newdest{$referrer{$i}}) {
+ $fullpath = $newdest{$referrer{$i}};
+ for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
+ if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
+ $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
+ last;
+ } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
+ unless (defined($newseqid{$dirorder{$i}->[$j]})) {
+ $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
+ $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
+ if (!-e $fullpath) {
+ mkdir($fullpath,0755);
}
}
+ } else {
+ last;
}
- if ($fullpath ne '') {
- system("mv $prefix$path $fullpath/$title");
+ }
+ }
+ if ($fullpath ne '') {
+ if (-e "$prefix$path") {
+ system("mv $prefix$path $fullpath/$title");
+ }
+ if (-e "$fullpath/$title") {
+ my $showpath;
+ if ($relpath ne '') {
+ $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//;
+ $prompttofetch{$fetch} = 1;
}
}
- } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
- $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
- $path,$env{'form.archive_content_'.$referrer{$i}}).' ';
}
+ } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
+ $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
+ $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)) {
foreach my $key (keys(%todelete)) {
unlink($key);
- unless ($ishome) {
- #FIXME Need to notify homeserver to delete files.
- }
+ }
+ }
+ if (keys(%todeletedir)) {
+ foreach my $key (keys(%todeletedir)) {
+ rmdir($key);
+ }
+ }
+ foreach my $dir (sort(keys(%is_dir))) {
+ if (($pathtocheck ne '') && ($dir ne '')) {
+ &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
+ }
+ }
+ if ($result ne '') {
+ $output .= ''."\n".
+ $result."\n".
+ ' ';
+ }
+ unless ($ishome) {
+ my $replicationfail;
+ foreach my $item (keys(%prompttofetch)) {
+ my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
+ unless ($fetchresult eq 'ok') {
+ $replicationfail .= ''.$item.' '."\n";
+ }
+ }
+ if ($replicationfail) {
+ $output .= ''.
+ &mt('Course home server failed to retrieve:').'
'.
+ $replicationfail.
+ ' ';
}
}
} else {
@@ -10421,6 +11598,90 @@ sub process_extracted_files {
return $output;
}
+sub cleanup_empty_dirs {
+ my ($path) = @_;
+ if (($path ne '') && (-d $path)) {
+ if (opendir(my $dirh,$path)) {
+ my @dircontents = grep(!/^\./,readdir($dirh));
+ my $numitems = 0;
+ foreach my $item (@dircontents) {
+ if (-d "$path/$item") {
+ &cleanup_empty_dirs("$path/$item");
+ if (-e "$path/$item") {
+ $numitems ++;
+ }
+ } else {
+ $numitems ++;
+ }
+ }
+ if ($numitems == 0) {
+ rmdir($path);
+ }
+ closedir($dirh);
+ }
+ }
+ return;
+}
+
+=pod
+
+=item &get_folder_hierarchy()
+
+Provides hierarchy of names of folders/sub-folders containing the current
+item,
+
+Inputs: 3
+ - $navmap - navmaps object
+
+ - $map - url for map (either the trigger itself, or map containing
+ the resource, which is the trigger).
+
+ - $showitem - 1 => show title for map itself; 0 => do not show.
+
+Outputs: 1 @pathitems - array of folder/subfolder names.
+
+=cut
+
+sub get_folder_hierarchy {
+ my ($navmap,$map,$showitem) = @_;
+ my @pathitems;
+ if (ref($navmap)) {
+ my $mapres = $navmap->getResourceByUrl($map);
+ if (ref($mapres)) {
+ my $pcslist = $mapres->map_hierarchy();
+ if ($pcslist ne '') {
+ my @pcs = split(/,/,$pcslist);
+ foreach my $pc (@pcs) {
+ if ($pc == 1) {
+ push(@pathitems,&mt('Main Course Documents'));
+ } else {
+ my $res = $navmap->getByMapPc($pc);
+ if (ref($res)) {
+ my $title = $res->compTitle();
+ $title =~ s/\W+/_/g;
+ if ($title ne '') {
+ push(@pathitems,$title);
+ }
+ }
+ }
+ }
+ }
+ if ($showitem) {
+ if ($mapres->{ID} eq '0.0') {
+ push(@pathitems,&mt('Main Course Documents'));
+ } else {
+ my $maptitle = $mapres->compTitle();
+ $maptitle =~ s/\W+/_/g;
+ if ($maptitle ne '') {
+ push(@pathitems,$maptitle);
+ }
+ }
+ }
+ }
+ }
+ return @pathitems;
+}
+
=pod
=item * &get_turnedin_filepath()
@@ -12012,7 +13273,7 @@ sub commit_studentrole {
$result = $modify_section_result;
} elsif ($secchange == 1) {
if ($oldsec eq '') {
- $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_3] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
+ $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_2] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
} else {
$$logmsg .= &mt('Error when attempting to expire existing role for [_1] in section [_2] in course [_3] -error: ',$uname,$oldsec,$cid).' '.$expire_role_result.$linefeed;
}
@@ -12038,6 +13299,26 @@ 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').' ');
+ }
+}
+
############################################################
############################################################
@@ -12566,7 +13847,7 @@ sub init_user_environment {
# See if old ID present, if so, remove
- my ($filename,$cookie,$userroles);
+ my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
my $now=time;
if ($public) {
@@ -12604,7 +13885,8 @@ sub init_user_environment {
# Initialize roles
- $userroles=&Apache::lonnet::rolesinit($domain,$username,$authhost);
+ ($userroles,$firstaccenv,$timerintenv) =
+ &Apache::lonnet::rolesinit($domain,$username,$authhost);
}
# ------------------------------------ Check browser type and MathML capability
@@ -12665,7 +13947,7 @@ sub init_user_environment {
%domdef = &Apache::lonnet::get_domain_defaults($domain);
}
- foreach my $tool ('aboutme','blog','portfolio') {
+ foreach my $tool ('aboutme','blog','webdav','portfolio') {
$userenv{'availabletools.'.$tool} =
&Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
undef,\%userenv,\%domdef,\%is_adv);
@@ -12678,13 +13960,33 @@ sub init_user_environment {
\%userenv,\%domdef,\%is_adv);
}
+ $userenv{'canrequest.author'} =
+ &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
+ 'reload','requestauthor',
+ \%userenv,\%domdef,\%is_adv);
+ my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
+ $domain,$username);
+ my $reqstatus = $reqauthor{'author_status'};
+ if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
+ if (ref($reqauthor{'author'}) eq 'HASH') {
+ $userenv{'requestauthorqueued'} = $reqstatus.':'.
+ $reqauthor{'author'}{'timestamp'};
+ }
+ }
+
$env{'user.environment'} = "$lonids/$cookie.id";
-
+
if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
&GDBM_WRCREAT(),0640)) {
&_add_to_env(\%disk_env,\%initial_env);
&_add_to_env(\%disk_env,\%userenv,'environment.');
&_add_to_env(\%disk_env,$userroles);
+ if (ref($firstaccenv) eq 'HASH') {
+ &_add_to_env(\%disk_env,$firstaccenv);
+ }
+ if (ref($timerintenv) eq 'HASH') {
+ &_add_to_env(\%disk_env,$timerintenv);
+ }
if (ref($args->{'extra_env'})) {
&_add_to_env(\%disk_env,$args->{'extra_env'});
}
@@ -12720,7 +14022,9 @@ sub get_symb {
my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
if ($symb eq '') {
if (!$silent) {
- $request->print("Unable to handle ambiguous references:$url:.");
+ if (ref($request)) {
+ $request->print("Unable to handle ambiguous references:$url:.");
+ }
return ();
}
}
@@ -12784,6 +14088,318 @@ sub build_release_hashes {
return;
}
+sub update_content_constraints {
+ my ($cdom,$cnum,$chome,$cid) = @_;
+ my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
+ my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
+ my %checkresponsetypes;
+ foreach my $key (keys(%Apache::lonnet::needsrelease)) {
+ my ($item,$name,$value) = split(/:/,$key);
+ if ($item eq 'resourcetag') {
+ if ($name eq 'responsetype') {
+ $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
+ }
+ }
+ }
+ my $navmap = Apache::lonnavmaps::navmap->new();
+ if (defined($navmap)) {
+ my %allresponses;
+ foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
+ my %responses = $res->responseTypes();
+ foreach my $key (keys(%responses)) {
+ next unless(exists($checkresponsetypes{$key}));
+ $allresponses{$key} += $responses{$key};
+ }
+ }
+ foreach my $key (keys(%allresponses)) {
+ my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
+ if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
+ ($reqdmajor,$reqdminor) = ($major,$minor);
+ }
+ }
+ undef($navmap);
+ }
+ unless (($reqdmajor eq '') && ($reqdminor eq '')) {
+ &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
+ }
+ 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) = @_;
+
+ my ($foldertitle,$renametitle);
+ if ($title =~ /&&&/) {
+ $title = &HTML::Entites::decode($title);
+ }
+ if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
+ $renametitle=$4;
+ my ($time,$uname,$udom) = ($1,$2,$3);
+ $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
+ my $name = &plainname($uname,$udom);
+ $name = &HTML::Entities::encode($name,'"<>&\'');
+ $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
+ $title=''.&Apache::lonlocal::locallocaltime($time).' '.
+ $name.': '.$foldertitle;
+ }
+ if (wantarray) {
+ return ($title,$foldertitle,$renametitle);
+ }
+ return $title;
+}
+
+sub symb_to_docspath {
+ my ($symb) = @_;
+ return unless ($symb);
+ my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
+ if ($resurl=~/\.(sequence|page)$/) {
+ $mapurl=$resurl;
+ } elsif ($resurl eq 'adm/navmaps') {
+ $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
+ }
+ my $mapresobj;
+ my $navmap = Apache::lonnavmaps::navmap->new();
+ if (ref($navmap)) {
+ $mapresobj = $navmap->getResourceByUrl($mapurl);
+ }
+ $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
+ my $type=$2;
+ my $path;
+ if (ref($mapresobj)) {
+ my $pcslist = $mapresobj->map_hierarchy();
+ if ($pcslist ne '') {
+ foreach my $pc (split(/,/,$pcslist)) {
+ next if ($pc <= 1);
+ my $res = $navmap->getByMapPc($pc);
+ if (ref($res)) {
+ my $thisurl = $res->src();
+ $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
+ my $thistitle = $res->title();
+ $path .= '&'.
+ &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
+ &Apache::lonhtmlcommon::entity_encode($thistitle).
+ ':'.$res->randompick().
+ ':'.$res->randomout().
+ ':'.$res->encrypted().
+ ':'.$res->randomorder().
+ ':'.$res->is_page();
+ }
+ }
+ }
+ $path =~ s/^\&//;
+ my $maptitle = $mapresobj->title();
+ if ($mapurl eq 'default') {
+ $maptitle = 'Main Course Documents';
+ }
+ $path .= (($path ne '')? '&' : '').
+ &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
+ &Apache::lonhtmlcommon::entity_encode($maptitle).
+ ':'.$mapresobj->randompick().
+ ':'.$mapresobj->randomout().
+ ':'.$mapresobj->encrypted().
+ ':'.$mapresobj->randomorder().
+ ':'.$mapresobj->is_page();
+ } else {
+ my $maptitle = &Apache::lonnet::gettitle($mapurl);
+ my $ispage = (($type eq 'page')? 1 : '');
+ if ($mapurl eq 'default') {
+ $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 Course Documents').
+ ':::::&'.$path;
+ }
+ return $path;
+}
+
+sub captcha_display {
+ my ($context,$lonhost) = @_;
+ my ($output,$error);
+ my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
+ if ($captcha eq 'original') {
+ $output = &create_captcha();
+ unless ($output) {
+ $error = 'captcha';
+ }
+ } elsif ($captcha eq 'recaptcha') {
+ $output = &create_recaptcha($pubkey);
+ unless ($output) {
+ $error = 'recaptcha';
+ }
+ }
+ return ($output,$error);
+}
+
+sub captcha_response {
+ my ($context,$lonhost) = @_;
+ my ($captcha_chk,$captcha_error);
+ my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
+ if ($captcha eq 'original') {
+ ($captcha_chk,$captcha_error) = &check_captcha();
+ } elsif ($captcha eq 'recaptcha') {
+ $captcha_chk = &check_recaptcha($privkey);
+ } else {
+ $captcha_chk = 1;
+ }
+ return ($captcha_chk,$captcha_error);
+}
+
+sub get_captcha_config {
+ my ($context,$lonhost) = @_;
+ my ($captcha,$pubkey,$privkey,$hashtocheck);
+ my $hostname = &Apache::lonnet::hostname($lonhost);
+ my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
+ my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
+ if ($context eq 'usercreation') {
+ my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
+ if (ref($domconfig{$context}) eq 'HASH') {
+ $hashtocheck = $domconfig{$context}{'cancreate'};
+ if (ref($hashtocheck) eq 'HASH') {
+ if ($hashtocheck->{'captcha'} eq 'recaptcha') {
+ if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
+ $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
+ $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
+ }
+ if ($privkey && $pubkey) {
+ $captcha = 'recaptcha';
+ } else {
+ $captcha = 'original';
+ }
+ } elsif ($hashtocheck->{'captcha'} ne 'notused') {
+ $captcha = 'original';
+ }
+ }
+ } else {
+ $captcha = 'captcha';
+ }
+ } elsif ($context eq 'login') {
+ my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
+ if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
+ $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
+ $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
+ if ($privkey && $pubkey) {
+ $captcha = 'recaptcha';
+ } else {
+ $captcha = 'original';
+ }
+ } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
+ $captcha = 'original';
+ }
+ }
+ return ($captcha,$pubkey,$privkey);
+}
+
+sub create_captcha {
+ my %captcha_params = &captcha_settings();
+ my ($output,$maxtries,$tries) = ('',10,0);
+ while ($tries < $maxtries) {
+ $tries ++;
+ my $captcha = Authen::Captcha->new (
+ output_folder => $captcha_params{'output_dir'},
+ data_folder => $captcha_params{'db_dir'},
+ );
+ my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
+
+ if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
+ $output = ' '."\n".
+ &mt('Type in the letters/numbers shown below').' '.
+ ' '.
+ ' ';
+ last;
+ }
+ }
+ return $output;
+}
+
+sub captcha_settings {
+ my %captcha_params = (
+ output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
+ www_output_dir => "/captchaspool",
+ db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
+ numchars => '5',
+ );
+ return %captcha_params;
+}
+
+sub check_captcha {
+ my ($captcha_chk,$captcha_error);
+ my $code = $env{'form.code'};
+ my $md5sum = $env{'form.crypt'};
+ my %captcha_params = &captcha_settings();
+ my $captcha = Authen::Captcha->new(
+ output_folder => $captcha_params{'output_dir'},
+ data_folder => $captcha_params{'db_dir'},
+ );
+ $captcha_chk = $captcha->check_code($code,$md5sum);
+ my %captcha_hash = (
+ 0 => 'Code not checked (file error)',
+ -1 => 'Failed: code expired',
+ -2 => 'Failed: invalid code (not in database)',
+ -3 => 'Failed: invalid code (code does not match crypt)',
+ );
+ if ($captcha_chk != 1) {
+ $captcha_error = $captcha_hash{$captcha_chk}
+ }
+ return ($captcha_chk,$captcha_error);
+}
+
+sub create_recaptcha {
+ my ($pubkey) = @_;
+ my $captcha = Captcha::reCAPTCHA->new;
+ return $captcha->get_options_setter({theme => 'white'})."\n".
+ $captcha->get_html($pubkey).
+ &mt('If either word is hard to read, [_1] will replace them.',
+ ' ').
+ ' ';
+}
+
+sub check_recaptcha {
+ my ($privkey) = @_;
+ my $captcha_chk;
+ my $captcha = Captcha::reCAPTCHA->new;
+ my $captcha_result =
+ $captcha->check_answer(
+ $privkey,
+ $ENV{'REMOTE_ADDR'},
+ $env{'form.recaptcha_challenge_field'},
+ $env{'form.recaptcha_response_field'},
+ );
+ if ($captcha_result->{is_valid}) {
+ $captcha_chk = 1;
+ }
+ return $captcha_chk;
+}
+
=pod
=back