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

[raeburn]

raeburn		Mon Jan 16 18:00:24 2012 EDT

  Modified files:              
    /loncom/interface	loncommon.pm 
  Log:
   - Routines to support decompression of archive
     files (zip, tar, gz, tgz etc.) when uploading
     directly into a course.
  
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.1052 loncom/interface/loncommon.pm:1.1053
--- loncom/interface/loncommon.pm:1.1052	Mon Jan  9 19:56:28 2012
+++ loncom/interface/loncommon.pm	Mon Jan 16 18:00:24 2012
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.1052 2012/01/09 19:56:28 www Exp $
+# $Id: loncommon.pm,v 1.1053 2012/01/16 18:00:24 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -9708,6 +9708,75 @@
     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 = '<p>'.$lt{'this'}.' '.$lt{'youm'}.'<br />';
+    if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
+        $output .= $lt{'camt'};
+    }
+    $output .= '</p>';
+    $output .= <<"START";
+<div id="uploadfileresult">
+  <form name="uploaded_decompress" action="$action" method="post">
+  <input type="hidden" name="archiveurl" value="$archiveurl" />
+START
+    if (ref($hiddenelements) eq 'HASH') {
+        foreach my $hidden (sort(keys(%{$hiddenelements}))) {
+            $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
+        }
+    }
+    $output .= <<"END";
+<input type="hidden" name="folderpath" value="$env{'form.folderpath'}" />
+<input type="hidden" name="pagepath" value="$env{'form.pagepath'}" />
+<input type="hidden" name="cmd" value="$nextphase" />
+<input type="hidden" name="newidx" value="$newidx" />
+<input type="hidden" name="position" value="$position" />
+<input type="hidden" name="phase" value="$nextphase" />
+<span class="LC_nobreak">$lt{'perm'} 
+<label><input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}</label>  
+<label><input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label></span><br />
+<input type="submit" name="decompress" value="$lt{'extr'}" />
+</form>
+$noextract
+</div>
+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);
+}
+
 =pod
 
 =item * &get_turnedin_filepath()