'.$lt{'this'};
+ my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
+ my (%toplevel,@paths);
+ my $info = &list_archive_contents($fileloc,\@paths);
+ if (@paths) {
+ foreach my $path (@paths) {
+ $path =~ s{^/}{};
+ if ($path =~ m{^([^/]+)/}) {
+ $toplevel{$1} = $path;
+ } else {
+ $toplevel{$path} = $path;
+ }
+ }
+ }
+ if ($info eq '') {
+ $output .= ' '.$lt{'youm'}.'
'."\n";
+ } else {
+ $output .= ' '.$lt{'itsc'}.''."\n".
+ '
$noextract
@@ -9886,6 +10033,62 @@ 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});
@@ -9915,8 +10118,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";
@@ -9927,47 +10128,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;
@@ -9994,7 +10209,7 @@ 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);
}
@@ -10123,6 +10338,9 @@ sub archive_row {
my $offset = 0;
foreach my $action ('display','dependency','discard') {
$offset ++;
+ if ($action ne 'display') {
+ $offset ++;
+ }
$output .= '
'.
''.
- &mt('How should each item be incorporated in the course?').
- '
'.
- '
'.
- ''.&mt('Content actions for all').' '.
- ' '.
+ my ($form,$display,$count,$hiddenelem) = @_;
+ my %lt = &Apache::lonlocal::texthash(
+ perm => 'Permanently remove archive file?',
+ hows => 'How should each extracted item be incorporated in the course?',
+ cont => 'Content actions for all',
+ addf => 'Add as folder/file',
+ incd => 'Include as dependency for a displayed file',
+ disc => 'Discard',
+ no => 'No',
+ yes => 'Yes',
+ save => 'Save',
+ );
+ my $output = <<"END";
+';
}
@@ -10309,7 +10547,7 @@ function dependencyCheck(form,count,offs
function propagateSelect(form,count,offset) {
if (count > 0) {
- var item = (2+offset+$startcount)+7*(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) {
@@ -10323,7 +10561,7 @@ function propagateSelect(form,count,offs
function containerSelect(form,count,offset,picked) {
if (count > 0) {
- var item = (1+offset+$startcount)+7*(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') {
@@ -10373,7 +10611,7 @@ END
}
sub process_extracted_files {
- my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
+ my ($context,$docudom,$docuname,$url,$destination,$dir_root,$hiddenelem) = @_;
my $numitems = $env{'form.archive_count'};
return unless ($numitems);
my @ids=&Apache::lonnet::current_machine_ids();
@@ -10420,7 +10658,7 @@ sub process_extracted_files {
(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++) {
my $path = $env{'form.archive_content_'.$i};
@@ -10428,7 +10666,12 @@ sub process_extracted_files {
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') {
@@ -10564,9 +10807,16 @@ sub process_extracted_files {
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");
}
}
} else {
@@ -10582,6 +10832,31 @@ 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") {
+ &recurse_dirs("$path/$item");
+ if (-e "$path/$item") {
+ $numitems ++;
+ }
+ } else {
+ $numitems ++;
+ }
+ }
+ if ($numitems == 0) {
+ rmdir($path);
+ }
+ closedir($dirh);
+ }
+ }
+ return;
+}
+
=pod
=item * &get_turnedin_filepath()