[LON-CAPA-cvs] cvs: loncom /interface loncommon.pm

raeburn raeburn at source.lon-capa.org
Thu Apr 5 21:23:12 EDT 2012


raeburn		Fri Apr  6 01:23:12 2012 EDT

  Modified files:              
    /loncom/interface	loncommon.pm 
  Log:
  - Extraction of contents of archive files (zip, tar etc.) from a file
    uploaded directly to a course.
    - Add new routine: &cleanup_empty_dirs()  
      to remove empty directories remaining after processing user's selections 
      for display, treating as a dependency or discard, for each item extracted
      from the archive file.
  
  
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.1065 loncom/interface/loncommon.pm:1.1066
--- loncom/interface/loncommon.pm:1.1065	Thu Apr  5 13:32:15 2012
+++ loncom/interface/loncommon.pm	Fri Apr  6 01:23:11 2012
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.1065 2012/04/05 13:32:15 raeburn Exp $
+# $Id: loncommon.pm,v 1.1066 2012/04/06 01:23:11 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -10658,7 +10658,7 @@
         (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};
@@ -10666,7 +10666,12 @@
                 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$/, at archdirs))) {
+                                $todeletedir{$prefix.$path} = 1;
+                            } else {
+                                $todelete{$prefix.$path} = 1;
+                            }
                         }
                     }
                 } elsif ($env{'form.archive_'.$i} eq 'display') {
@@ -10802,9 +10807,16 @@
         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 {
@@ -10820,6 +10832,31 @@
     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()




More information about the LON-CAPA-cvs mailing list