[LON-CAPA-cvs] cvs: doc /loncapafiles loncapafiles.lpml loncom/cgi archive.pl loncom/html/adm/help/png archive.png loncom/html/adm/help/tex Authoring_Archiving_Directory.tex loncom/html/res/adm/pages archive.png loncom/interface lonmenu.pm loncom/publisher loncfile.pm

raeburn raeburn at source.lon-capa.org
Mon May 13 09:55:53 EDT 2024


raeburn		Mon May 13 13:55:53 2024 EDT

  Added files:                 
    /loncom/cgi	archive.pl 
    /loncom/html/adm/help/tex	Authoring_Archiving_Directory.tex 
    /loncom/html/res/adm/pages	archive.png 
    /loncom/html/adm/help/png	archive.png 

  Modified files:              
    /loncom/publisher	loncfile.pm 
    /loncom/interface	lonmenu.pm 
    /doc/loncapafiles	loncapafiles.lpml 
  Log:
  - Bug 6990. Author can export specified files (with/without recursion into
    subdirectories from current directory in Authoring Space to archive file.
  
  
-------------- next part --------------
Index: loncom/publisher/loncfile.pm
diff -u loncom/publisher/loncfile.pm:1.127 loncom/publisher/loncfile.pm:1.128
--- loncom/publisher/loncfile.pm:1.127	Fri Jul 14 23:20:15 2023
+++ loncom/publisher/loncfile.pm	Mon May 13 13:55:50 2024
@@ -9,7 +9,7 @@
 #  and displays a page showing the results of the action.
 #
 #
-# $Id: loncfile.pm,v 1.127 2023/07/14 23:20:15 raeburn Exp $
+# $Id: loncfile.pm,v 1.128 2024/05/13 13:55:50 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -70,10 +70,10 @@
 use Apache::Constants qw(:common :http :methods);
 use Apache::lonnet;
 use Apache::loncommon();
+use Apache::lonhtmlcommon;
 use Apache::lonlocal;
 use LONCAPA qw(:DEFAULT :match);
 
-
 my $DEBUG=0;
 my $r;				# Needs to be global for some stuff RF.
 
@@ -819,6 +819,130 @@
     }
 }
 
+sub Archive1 {
+    my ($request,$fn) = @_;
+    my @posstypes = qw(problem library sty sequence page task rights meta xml html xhtml htm xhtm css js tex txt gif jpg jpeg png svg other);
+    my (%location_of,%default,$compstyle);
+    foreach my $program ('tar','gzip','bzip2','xz','zip') {
+        foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
+                         '/usr/sbin/') {
+            if (-x $dir.$program) {
+                $location_of{$program} = $dir.$program;
+                last;
+            }
+        }
+    }
+    my (%defaults,$cancompress,$canarchive);
+    if (exists($location_of{'tar'})) {
+        $default{'tar'} = ' checked="checked"';
+        $canarchive = 1;
+        $compstyle = 'block';
+    } elsif (exists($location_of{'zip'})) {
+        $default{'zip'} = ' checked="checked"';
+        $canarchive = 1;
+        $compstyle = 'none';
+    }
+    foreach my $compress ('gzip','bzip2','xz') {
+        if (exists($location_of{$compress})) {
+            $default{$compress} = ' checked="checked"';
+            $cancompress = 1;
+            last;
+        }
+    }
+    if (!$canarchive) {
+        $request->print('<p class="LC_error">'.
+                        &mt('This LON-CAPA instance does not seem to have either tar or zip installed.').'</p>'.
+                        '<span class="LC_warning">'.
+                        &mt('At least one of the two is needed in order to be able to create an archive file for: [_1].',
+                            &display($fn)).
+                        '</span></form>');
+    } elsif (-e $fn) {
+        $request->print(&Apache::lonhtmlcommon::start_pick_box().
+                        &Apache::lonhtmlcommon::row_title(&mt('Directory')).
+                        &display($fn).
+                        &Apache::lonhtmlcommon::row_closure().
+                        &Apache::lonhtmlcommon::row_title(&mt('Options').
+                        &Apache::loncommon::help_open_topic('Archiving_Directory_Options')).
+                        '<fieldset><legend>'.&mt('Recurse').'</legend>'.
+                        '<span class="LC_nobreak"><label><input type="checkbox" name="recurse" /> '.
+                        &mt('include subdirectories').'</label></span>'.
+                        '</fieldset>'.
+                        '<fieldset><legend>'.&mt('File types (extensions) to include').(' 'x2).
+                        '<span style="text-decoration:line-through">'.(' 'x5).'</span>'.(' 'x2).
+                        '<input type="button" name="checkall" value="'.&mt('check all').
+                        '" style="height:20px;" onclick="checkAll(document.phaseone.filetype);" />'.
+                        (' 'x2).
+                        '<input type="button" name="uncheckall" value="'.&mt('uncheck all').
+                        '" style="height:20px;" onclick="uncheckAll(document.phaseone.filetype);" /></legend>'.
+                        '<table>');
+        my $rem;
+        my $numinrow = 6;
+        for (my $i=0; $i<@posstypes; $i++) {
+            my $rem = $i%($numinrow);
+            if ($rem == 0) {
+               if ($i > 0) {
+                    $request->print('</tr>'."\n");
+               }
+               $request->print('<tr>'."\n");
+            }
+            $request->print('<td class="LC_left_item">'.
+                            '<span class="LC_nobreak"><label>'.
+                            '<input type="checkbox" name="filetype" '.
+                            'value="'.$posstypes[$i].'" /> '.
+                            $posstypes[$i].'</label></span></td>'."\n");
+        }
+        $rem = scalar(@posstypes)%($numinrow);
+        my $colsleft;
+        if ($rem) {
+            $colsleft = $numinrow - $rem;
+        }
+        if ($colsleft > 1 ) {
+            $request->print('<td colspan="'.$colsleft.'" class="LC_left_item">'.
+                            ' </td>'."\n");
+        } elsif ($colsleft == 1) {
+            $request->print('<td class="LC_left_item"> </td>'."\n");
+        }
+        $request->print('</tr></table>'."\n".
+                        '</fieldset>'.
+                        '<fieldset><legend>'.&mt('Archive file format').'</legend>');
+        foreach my $possfmt ('tar','zip') {
+            if (exists($location_of{$possfmt})) {
+                $request->print('<span class="LC_nobreak">'.
+                                '<label><input type="radio" name="format" value="'.$possfmt.'"'.
+                                $default{$possfmt}.' onclick="toggleCompression(this.form);" /> '.
+                                $possfmt.'</label></span>   ');
+            }
+        }
+        $request->print('</fieldset>'."\n".
+                        '<fieldset style="display:'.$compstyle.'" id="tar_compression">'.
+                        '<legend>'.&mt('Compression to apply to tar file').'</legend>'.
+                        '<span class="LC_nobreak">');
+        if ($cancompress) { 
+            foreach my $compress ('gzip','bzip2','xz') {
+                if (exists($location_of{$compress})) {
+                    $request->print('<label><input type="radio" name="compress" value="'.$compress.'"'.
+                                    $default{$compress}.'  />'.$compress.'</label>  ');
+                }
+            }
+        } else {
+            $request->print('<span class="LC_warning">'.
+                            &mt('This LON-CAPA instance does not seem to have gzip, bzip2 or xz installed.').
+                            '<br />'.&mt('No compression will be used.').'</span>');
+        }
+        $request->print('</fieldset>'. 
+                        &Apache::lonhtmlcommon::row_closure(1).
+                        &Apache::lonhtmlcommon::end_pick_box()
+        );
+        &CloseForm1($request, $fn);
+    } else {
+        $request->print('<p class="LC_error">'
+                       .&mt('No such directory: [_1]',
+                            &display($fn))
+                       .'</p></form>'
+        );
+    }
+}
+
 =pod
 
 =item NewFile1
@@ -994,7 +1118,7 @@
                   '</a></p>');
         return;
     }
-    $r->print('<form action="/adm/cfile" method="post">'.
+    $r->print('<form action="/adm/cfile" method="post" name="phaseone">'.
 	      '<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'.
 	      '<input type="hidden" name="phase" value="two" />'.
 	      '<input type="hidden" name="action" value="'.$env{'form.action'}.'" />');
@@ -1033,6 +1157,8 @@
 	    &Delete1($r, $uname, $udom, $fn);
         } elsif ($env{'form.action'} eq 'decompress') {
 	    &Decompress1($r, $uname, $udom, $fn);
+        } elsif ($env{'form.action'} eq 'archive') {
+            &Archive1($r,$fn);
         } elsif ($env{'form.action'} eq 'copy') {
 	    if ($newfilename) {
 	        &Copy1($r, $uname, $udom, $fn, $newfilename);
@@ -1310,9 +1436,50 @@
     return 1;
 }
 
+sub Archive2 {
+    my ($r,$name,$udom,$fn,$identifier) = @_;
+    my %options = (
+                    dir => $fn,
+                  );
+    my @filetypes = qw(problem library sty sequence page task rights meta xml html xhtml htm xhtm css js tex txt gif jpg jpeg png svg other);
+    my (@include,%oktypes);
+    map { $oktypes{$_} = 1; } @filetypes;
+    my @posstypes = &Apache::loncommon::get_env_multiple('form.filetype');
+    foreach my $type (@posstypes) {
+        if ($oktypes{$type}) {
+            push(@include,$type);
+        }
+    }
+    if (scalar(@include) == scalar(@filetypes)) {
+        $options{'types'} = 'all';
+    } else {
+        $options{'types'} = join(',', at include);
+    }
+    if (exists($env{'form.recurse'})) {
+        $options{'recurse'} = 1;
+    }
+    if (exists($env{'form.encrypt'})) {
+        if ($env{'form.enckey'} ne '') {
+            $options{'encrypt'} = $env{'form.enckey'};
+        }
+    }
+    $options{'format'} = 'tar';
+    $options{'compress'} = 'gzip';
+    if ((exists($env{'form.format'})) && $env{'form.format'} =~ /^zip$/i) {
+        $options{'format'} = 'zip';
+        delete($options{'compress'});
+    } elsif ((exists($env{'form.compress'})) && ($env{'form.compress'} =~ /^(xz|bzip2)$/i)) {
+        $options{'compress'} = lc($env{'form.compress'});  
+    }
+    my $key = 'cgi.'.$identifier.'.archive';
+    my $storestring = &Apache::lonnet::freeze_escape(\%options);
+    &Apache::lonnet::appenv({$key => $storestring});
+    return 1;
+}
+
 =pod
 
-=item phasetwo($r, $fn, $uname, $udom)
+=item phasetwo($r, $fn, $uname, $udom,$identifier)
 
    Controls the phase 2 processing of file management
    requests for construction space.  In phase one, the user
@@ -1343,7 +1510,7 @@
 =cut
 
 sub phasetwo {
-    my ($r,$fn,$uname,$udom)=@_;
+    my ($r,$fn,$uname,$udom,$identifier)=@_;
 
     &Debug($r, "loncfile - Entering phase 2 for $fn");
 
@@ -1380,6 +1547,9 @@
 	    return ;
 	}
 	$dest = $dir."/.";
+    } elsif ($env{'form.action'} eq 'archive') {
+        &Archive2($r,$uname,$udom,$fn,$identifier);
+        return;
     } elsif ($env{'form.action'} eq 'rename' ||
 	     $env{'form.action'} eq 'move') {
 	if($env{'form.newfilename'}) {
@@ -1462,7 +1632,7 @@
 	&Debug($r, "test: $env{'form.filename'}");
 	$fn=&unescape($env{'form.filename'});
 	$fn=&URLToPath($fn);
-    }  elsif($ENV{'QUERY_STRING'} && $env{'form.phase'} ne 'two') {
+    } elsif($ENV{'QUERY_STRING'} && $env{'form.phase'} ne 'two') {
 	#Just hijack the script only the first time around to inject the
 	#correct information for further processing
 	$fn=&unescape($env{'form.decompress'});
@@ -1501,22 +1671,92 @@
     &Apache::loncommon::content_type($r,'text/html');
     $r->send_http_header;
 
-    my (%loaditem,$js);
+    my ($js,$identifier);
+    my $args = {};
 
-    if ( ($env{'form.action'} eq 'newdir') && ($env{'form.phase'} eq 'two') && ( ($env{'form.callingmode'} eq 'testbank') || ($env{'form.callingmode'} eq 'imsimport') ) ) {
+    if (($env{'form.action'} eq 'newdir') && ($env{'form.phase'} eq 'two') && 
+        (($env{'form.callingmode'} eq 'testbank') || ($env{'form.callingmode'} eq 'imsimport'))) {
 	my $newdirname = $env{'form.newfilename'};
-	$js = qq|
+        &js_escape(\$newdirname);
+	$js = <<"ENDJS";
 <script type="text/javascript">
+// <![CDATA[
 function writeDone() {
     window.focus();
     opener.document.info.newdir.value = "$newdirname";
     setTimeout("self.close()",10000);
 }
-  </script>
-|;
-	$loaditem{'onload'} = "writeDone()";
+// ]]>
+</script>
+ENDJS
+        $args->{'add_entries'} = { onload => "writeDone()" };
+    } elsif (($env{'form.action'} eq 'archive') &&
+             ($env{'environment.authorarchive'})) { 
+        if ($env{'form.phase'} eq 'two') {
+            $identifier = &Apache::loncommon::get_cgi_id();
+            $args->{'redirect'} = [0,"/cgi-bin/archive.pl?$identifier"];
+        } else {
+            my $check_uncheck_js = &Apache::loncommon::check_uncheck_jscript();
+            $js = <<"ENDJS";
+<script type="text/javascript">
+// <![CDATA[
+function toggleCompression(form) {
+    if (document.getElementById('tar_compression')) {
+        if (form.format.length > 1) {
+            for (var i=0; i<form.format.length; i++) {
+                if (form.format[i].checked) {
+                    if (form.format[i].value == 'zip') {
+                        document.getElementById('tar_compression').style.display = 'none';
+                    } else if (form.format[i].value == 'tar') {
+                        document.getElementById('tar_compression').style.display = 'block';
+                    }
+                    break;
+                }
+            }
+        }
+    }
+    return;
+}
+
+function resetForm() {
+    if (document.phaseone.filetype.length) {
+        for (var i=0; i<document.phaseone.filetype.length; i++) {
+            document.phaseone.filetype[i].checked = false;
+        }
     }
+    if (document.getElementById('tar_compression')) { 
+        if (document.phaseone.format.length) {
+            document.getElementById('tar_compression').style.display = 'block';
+            for (var i=0; i<document.phaseone.format.length; i++) {
+                if (document.phaseone.format[i].value == 'tar') {
+                    document.phaseone.format[i].checked = true;  
+                } else {
+                    document.phaseone.format[i].checked = false;
+                }
+            }
+        }
+        if (document.phaseone.compress.length) {
+            for (var i=0; i<document.phaseone.compress.length; i++) {
+                if (document.phaseone.compress[i].value == 'gzip') {
+                    document.phaseone.compress[i].checked = true;
+                } else {
+                    document.phaseone.compress[i].checked = false;
+                }
+            }
+        }
+    }
+    document.phaseone.recurse.checked = false;
+}
 
+$check_uncheck_js
+
+// ]]>
+</script>
+
+ENDJS
+            $args->{'add_entries'} = { onload => "resetForm()" }; 
+        }
+    }
     my $londocroot = $r->dir_config('lonDocRoot');
     my $trailfile = $fn;
     $trailfile =~ s{^/(priv/)}{$londocroot/$1};
@@ -1546,15 +1786,15 @@
         'href'  => '',
     });
 
-    $r->print(&Apache::loncommon::start_page($title,
-					     $js,
-					     {'add_entries' => \%loaditem,})
+    $r->print(&Apache::loncommon::start_page($title,$js,$args)
              .&Apache::lonhtmlcommon::breadcrumbs()
              .&Apache::loncommon::head_subbox(
                   &Apache::loncommon::CSTR_pageheader($trailfile))
     );
 
-    $r->print('<p>'.&mt('Location').': '.&display($fn).'</p>');
+    unless ($env{'form.action'} eq 'archive') {
+        $r->print('<p>'.&mt('Location').': '.&display($fn).'</p>');
+    }
 
     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
         unless ($crsauthor) {
@@ -1573,6 +1813,7 @@
         'move'            => 'Move',
         'newdir'          => 'New Directory',
         'decompress'      => 'Decompress',
+        'archive'         => 'Export directory to archive file',
         'copy'            => 'Copy',
         'newfile'         => 'New Resource',
 	'newhtmlfile'     => 'New Resource',
@@ -1604,6 +1845,23 @@
                 );
                 return OK;
             }
+            if ($env{'form.action'} eq 'archive') {
+                $r->print('<p>'.&mt('Location').': '.&display($fn).'</p>'."\n".
+                          '<p class="LC_error">'.
+                          &mt('Export to an archive file is not permitted in Course Authoring Space').
+                          '</p>'."\n".
+                          &Apache::loncommon::end_page());
+                return OK; 
+            }
+        } elsif ($env{'form.action'} eq 'archive') {
+            unless ($env{'environment.authorarchive'}) {
+                $r->print('<p>'.&mt('Location').': '.&display($fn).'</p>'."\n".
+                          '<p class="LC_error">'.
+                          &mt('You do not have permission to export to an archive file in this Authoring Space').
+                          '</p>'."\n".
+                          &Apache::loncommon::end_page());
+                return OK;
+            }
         }
         $r->print('<h2>'.$action{$env{'form.action'}}.'</h2>');
     } else {
@@ -1617,7 +1875,7 @@
 
     if ($env{'form.phase'} eq 'two') {
 	&Debug($r, "loncfile::handler  entering phase2");
-	&phasetwo($r,$fn,$uname,$udom);
+	&phasetwo($r,$fn,$uname,$udom,$identifier);
     } else {
 	&Debug($r, "loncfile::handler  entering phase1");
 	&phaseone($r,$fn,$uname,$udom);
Index: loncom/interface/lonmenu.pm
diff -u loncom/interface/lonmenu.pm:1.551 loncom/interface/lonmenu.pm:1.552
--- loncom/interface/lonmenu.pm:1.551	Wed May  1 22:08:11 2024
+++ loncom/interface/lonmenu.pm	Mon May 13 13:55:51 2024
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Routines to control the menu
 #
-# $Id: lonmenu.pm,v 1.551 2024/05/01 22:08:11 raeburn Exp $
+# $Id: lonmenu.pm,v 1.552 2024/05/13 13:55:51 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1261,6 +1261,13 @@
 s&7&2&prt.png&Print&printout[_1]&gocstr('/adm/printout','$esc_currdir')&Print contents of directory
 s&7&1&del.png&Delete&dir[_3]&gocstr('/adm/cfile?action=delete','$esc_currdir')&Delete this Directory
 ENDMENUITEMS
+                unless ($crsauthor_cstr) {
+                    if ($env{'environment.authorarchive'}) {
+                        $menuitems .= (<<ENDMENUITEMS);
+s&7&7&archive.png&Export&dir[_1]&gocstr('/adm/authorexport','$esc_currdir')&Export Authoring Space Archive
+ENDMENUITEMS
+                    }
+                }
             } else {
                 $currdir =~ s|[^/]+$||;
 		my $cleandisfn = &Apache::loncommon::escape_single($thisdisfn);
@@ -1896,7 +1903,7 @@
     } elsif ($env{'request.noversionuri'} !~ m{^/adm/(navmaps|viewclasslist)(\?|$)}) {
         if ($env{'request.state'} eq 'construct') {
             &Apache::lonhtmlcommon::add_breadcrumb_tool(
-                'advtools', @funcs[61,73,74,71,72]);
+                'advtools', @funcs[61,73,74,71,72,77]);
         } else {
             &Apache::lonhtmlcommon::add_breadcrumb_tool(
                 'advtools', @funcs[61,71,72,73,74,75,92]);
Index: doc/loncapafiles/loncapafiles.lpml
diff -u doc/loncapafiles/loncapafiles.lpml:1.1059 doc/loncapafiles/loncapafiles.lpml:1.1060
--- doc/loncapafiles/loncapafiles.lpml:1.1059	Sat Apr 27 03:28:12 2024
+++ doc/loncapafiles/loncapafiles.lpml	Mon May 13 13:55:52 2024
@@ -2,7 +2,7 @@
  "http://lpml.sourceforge.net/DTD/lpml.dtd">
 <!-- loncapafiles.lpml -->
 
-<!-- $Id: loncapafiles.lpml,v 1.1059 2024/04/27 03:28:12 raeburn Exp $ -->
+<!-- $Id: loncapafiles.lpml,v 1.1060 2024/05/13 13:55:52 raeburn Exp $ -->
 
 <!--
 
@@ -1243,6 +1243,16 @@
 </description>
 </file>
 <file>
+<source>loncom/cgi/archive.pl</source>
+<target dist='default'>home/httpd/cgi-bin/archive.pl</target>
+<categoryname>script</categoryname>
+<description>
+Create an archive file of specified files in an Authoring Space,
+for download by the author. Archive file is either a tar file 
+(with gzip, bzip2 or xz compression), or a zip file.
+</description>
+</file>
+<file>
 <source>loncom/cgi/decompress.pl</source>
 <target dist='default'>home/httpd/cgi-bin/decompress.pl</target>
 <categoryname>script</categoryname>
@@ -3110,6 +3120,7 @@
 anno.gif;
 anot.gif;
 anot2.gif;
+archive.gif;
 authorRemote.gif;
 author_example_directory.gif;
 author_new_content.gif;
@@ -3331,6 +3342,7 @@
 anno.eps;
 anot.eps;
 anot2.eps;
+archive.eps;
 authorRemote.eps;
 author_example_directory.eps;
 author_new_content.eps;
@@ -3544,6 +3556,7 @@
 Authentication.tex;
 Auth_Options.tex;
 Authoring_Adding_Pictures.tex;
+Authoring_Archiving_Directory.tex;
 Authoring_CustomResponse.tex;
 Authoring_DataResponse.tex;
 Authoring_Daxe_CSS.tex;
@@ -8532,6 +8545,7 @@
 <categoryname>graphic file</categoryname>
 <description>graphical icons used in submenus</description>
 <filenames>
+archive.png;
 aboutme.png;
 addClickerInfoFile.png;
 anonsurveythreshold.png;

Index: loncom/cgi/archive.pl
+++ loncom/cgi/archive.pl
#!/usr/bin/perl
#
# $Id: archive.pl,v 1.1 2024/05/13 13:55:51 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/cgi-bin/archive.pl
#
# http://www.lon-capa.org/
#
# The LearningOnline Network with CAPA
#
# A CGI script which creates a compressed archive file of the current
# directory in Authoring Space, with optional (a) recursion into
# sub-directories, (b) filtering by filetype and (c) encryption.
# Supported formats are: tar.gz, tar.bz2, tar.xz and zip.
####
use strict;
use lib '/home/httpd/lib/perl';
use File::Find;
use Apache::lonnet;
use Apache::loncommon;
use Apache::lonlocal;
use LONCAPA::loncgi;
use Cwd;
use HTML::Entities;

$|++;

my $lock;

our %excluded = (
                   bak => 1,
                   save => 1,
                   log => 1,
                );

our $maxdepth = 0;
our %included = ();
our $alltypes = '';
our $recurse = '';
our $includeother = '';
our $prefix = '';
our $totalfiles = 0;
our $totalsize = 0;
our $totalsubdirs = 0;
our %subdirs = ();
our $fh;

if (!&LONCAPA::loncgi::check_cookie_and_load_env()) {
    &Apache::lonlocal::get_language_handle();
    print(&LONCAPA::loncgi::missing_cookie_msg());
} else {
    &Apache::lonlocal::get_language_handle();
    my %lt = &Apache::lonlocal::texthash (
                                            indi => 'Invalid directory name',
                                            outo => 'Output of command:',
                                            comp => 'Archive creation complete.',
                                            erro => 'An error occurred.',
                                            cctf  => 'Cannot create tar file',
                                            dtf  => 'Download tar file',
                                         );
# Get the identifier and set a lock
    my %perlvar=%{&LONCAPA::Configuration::read_conf('loncapa.conf')};
    my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
    &Apache::lonlocal::get_language_handle();
    &Apache::loncommon::content_type(undef,'text/html');
    my $identifier = $ENV{'QUERY_STRING'};
    my ($hashref,$dir,$dirurl,$jsdirurl,$auname,$audom,$allowed,$error,$encrypt,$enckey,$format,$compress);
    my @posstypes = qw(problem library sty sequence page task rights meta xml html xhtml htm xhtm css js tex txt gif jpg jpeg png svg other);
    if (($identifier) && (exists($env{'cgi.'.$identifier.'.archive'}))) {
        $hashref = &Apache::lonnet::thaw_unescape($env{'cgi.'.$identifier.'.archive'});
        if (ref($hashref) eq 'HASH') {
            $dir = $hashref->{'dir'};
            # check for traversal
            if (-d $dir) {
                $dirurl = $dir;
                ($auname,$audom) = &Apache::lonnet::constructaccess($dir);
                if (($auname ne '') && ($audom ne '')) {
                    $dirurl =~ s/^\Q$londocroot\E//;
                    $prefix = $londocroot.$dirurl;
                    $maxdepth = $prefix =~ tr{/}{};
                    $jsdirurl = &js_escape($dirurl);
                    if (($auname eq $env{'user.name'}) && ($audom eq $env{'user.domain'}) &&
                        ($env{'environment.authorarchive'})) {
                        $allowed = 1;
                        if ($hashref->{'recurse'}) {
                            $recurse = 1;
                        } else {
                            $recurse = 0;
                        }
                        if ($hashref->{'types'} eq 'all') {
                            $alltypes = 1;
                        } else {
                            $alltypes = 0;
                            my %possincluded;
                            map { $possincluded{$_} = 1; } split(/,/,$hashref->{'types'});
                            $includeother = 0;
                            foreach my $type (@posstypes) {
                                if ($type eq 'other') {
                                    if ($possincluded{$type}) {
                                        $includeother = 1;
                                    } else {
                                        $includeother = 0;
                                    }
                                } else {
                                    if ($possincluded{$type}) {
                                        $included{$type} = 1;
                                    } else {
                                        $excluded{$type} = 1;
                                    }
                                }
                            }
                        }
                        if ((exists($hashref->{'encrypt'}) && $hashref->{'encrypt'} ne '')) { 
                            $encrypt = 1;
                            $enckey = $hashref->{'encrypt'};
                        }
                        if ((exists($hashref->{'format'}) && $hashref->{'format'} =~ /^zip$/i)) {
                            $format = lc($hashref->{'format'});
                        } else {
                            $format = 'tar';
                        }
                        unless ($format eq 'zip') { 
                            if ((exists($hashref->{'compress'})) && ($hashref->{'compress'} =~ /^(xz|bzip2)$/i)) {
                                $compress = lc($hashref->{'compress'});
                            } else {
                                $compress = 'gzip';
                            }
                        }
                    }
                }
            } else {
                $error = 'indi';
            }
        } else {
            $error = 'nohash';
        }
# delete cgi.$identifier.archive from %env
        &Apache::lonnet::delenv('cgi.'.$identifier.'.archive');
    } else {
        $error = 'noid';
    }
    $env{'request.noversionuri'} = '/cgi-bin/archive.pl';
    my ($brcrum,$title); 
    if ($error) {
        $brcrum = [{'href' => '',
                    'text' => 'Missing information'}];
    } elsif (!$allowed) {
        $brcrum = [{'href' => '',
                    'text' => 'Access denied'}];
    } else {
# Breadcrumbs
        $title = 'Creating archive file';
        $brcrum = [{'href' => $dirurl,
                    'text' => 'Authoring Space'},
                   {'href' => "javascript:gocstr('/adm/cfile?action=archive','$jsdirurl');",
                    'text' => 'File Operation'},
                   {'href' => '',
                    'text' => $title}];
    }
    my $js;
    print &Apache::loncommon::start_page($title,
                                         $js,
                                         {'bread_crumbs' => $brcrum,})."\n".
          '<form name="constspace" method="post" action="">'."\n".
          '<input type="hidden" name="filename" value="" />'."\n";
    if ($error) {
        print "&mt('Cannot create archive file -- \n";
    } elsif ($allowed) {
        my (%location_of, at tocheck);
        if ($format ne '') {
            push(@tocheck,$format);
        }
        if ($compress ne '') {
            push(@tocheck,$compress);
        } 
        foreach my $program (@tocheck) {
            foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                             '/usr/sbin/') {
                if (-x $dir.$program) {
                    $location_of{$program} = $dir.$program;
                    last;
                }
            }
        }
        if (exists($location_of{$format})) {
            my $suffix;
            if ($format eq 'zip') {
                $suffix = 'zip';
            } else {
                $suffix = 'tar';
                if (exists($location_of{$compress})) {
                    if ($compress eq 'bzip2') {
                        $suffix .= '.bz2'; 
                    } elsif ($compress eq 'gzip') {
                        $suffix .= '.gz';
                    } elsif ($compress eq 'xz') {
                        $suffix .= '.xz';
                    }
                }
            }
            my $namesdest = $perlvar{'lonPrtDir'}.'/'.$env{'user.name'}.'_'.$env{'user.domain'}.'_archive_'.$identifier.'.txt';
            my $filesdest = $perlvar{'lonPrtDir'}.'/'.$env{'user.name'}.'_'.$env{'user.domain'}.'_archive_'.$identifier.'.'.$suffix;
            my $filesurl = '/prtspool/'.$env{'user.name'}.'_'.$env{'user.domain'}.'_archive_'.$identifier.'.'.$suffix;
            unless ($lock) { $lock=&Apache::lonnet::set_lock(&mt('Archiving [_1]',$dirurl)); }
            if (open($fh,'>',$namesdest)) {
                find(
                     {preprocess => \&filter_files,
                      wanted     => \&store_names,
                      no_chdir   => 1,
                     },$dir);
                close($fh);
                if (($totalfiles) || ($totalsubdirs)) {
                    print '<p>'.
                          &mt('Archiving: [quant,_1,file,files] with total size: [_2] bytes in [quant,_3,subdirectory,subdirectories] ...',
                              $totalfiles,$totalsize,$totalsubdirs).
                          '</p>';
                    my ($cwd, at args);
                    if ($format eq 'zip') {
                        $cwd = &Cwd::getcwd(); 
                        @args = ('zip',$filesdest,'-v','-r','.','-i@'.$namesdest);
                        chdir $prefix;
                    } else {
                        @args = ('tar',"--create","--verbose");
                        if (($compress ne '') && (exists($location_of{$compress}))) {
                            push(@args,"--$compress");
                        }
                        push(@args,("--file=$filesdest","--directory=$prefix","--files-from=$namesdest"));
                    }
                    if (open(my $pipe,'-|', at args)) {
                        my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin('',$totalfiles); 
                        while (<$pipe>) {
                            &Apache::lonhtmlcommon::Increment_PrgWin('',\%prog_state,'last file');
                        }
                        &Apache::lonhtmlcommon::Close_PrgWin('',\%prog_state);
                        close($pipe);
                        if (!-e $filesdest) {
                            print '<p>'.&mt('No archive file available for download').'</p>'."\n"; 
                        }
                    } else {
                        print '<p>'.&mt('Could not call [_1] command',$format).'</p>'."\n";
                    }
                    if (($format eq 'zip') && ($cwd ne '')) {
                        chdir $cwd;
                    }
                } else {
                    print '<p>'.&mt('No files match the requested types so no archive file was created.').'</p>'."\n";
                }
                unlink($namesdest);
            } else {
                print '<p>'.&mt('Could not store list of files to archive').'</p>'."\n";
            }
            if ($lock) { &Apache::lonnet::remove_lock($lock); }
        } else {
            print '<p>'.&mt('Could not find location of [_1] command',$format).'</p>'."\n";
        }
    }
    if ($dirurl) {
        print '<br /><br />'.
              &Apache::lonhtmlcommon::actionbox(['<a href="'.&HTML::Entities::encode($dirurl,'\'"&<>').'">'.
                                                 &mt('Return to Directory').'</a>']);
    }
    print '</form>'.&Apache::loncommon::end_page();

# Code to delete archive file after successful download
    %included = ();
    $alltypes = '';
    $recurse = '';
    $includeother = '';
    $prefix = '';
    $totalfiles = 0;
    $totalsize = 0;
    $totalsubdirs = 0;
    %excluded = (
                   bak => 1,
                   save => 1,
                   log => 1,
                );
}

sub filter_files {
    my @PossibleFiles = @_;
    my @ChosenFiles;
    foreach my $file (@PossibleFiles) {
        if (-d $File::Find::dir."/".$file) {
            if (!$recurse) {
                my $depth = $File::Find::dir =~ tr[/][];
                next unless ($depth < $maxdepth-1);
            }
            push(@ChosenFiles,$file);
        } else {
            my ($extension) = ($file =~ /\.([^.]+)$/);
            if ((!$excluded{$extension}) && ($alltypes || $includeother || $included{$extension})) {
                push(@ChosenFiles,$file);
            }
        }
    }
    return @ChosenFiles;  
}

sub store_names {
    my $filename = $File::Find::name;
    if (-d $filename) {
        unless ("$filename/" eq $prefix) {
            if ($recurse) {
                $subdirs{$filename} = 1;
                $totalsubdirs ++;
            }
        }
        next;
    }
    $totalfiles ++;
    $totalsize += -s $filename;
    $filename =~ s{^$prefix}{}; 
    print $fh "$filename\n";
}

sub js {
    my $output = <<'END';
const xhrButtonSuccess = document.querySelector(".xhr.success");
const xhrButtonError = document.querySelector(".xhr.error");
const xhrButtonAbort = document.querySelector(".xhr.abort");
const log = document.querySelector(".event-log");

function handleEvent(e) {
  log.textContent = `${log.textContent}${e.type}: ${e.loaded} bytes transferred\n`;
}

function addListeners(xhr) {
  xhr.addEventListener("loadstart", handleEvent);
  xhr.addEventListener("load", handleEvent);
  xhr.addEventListener("loadend", handleEvent);
  xhr.addEventListener("progress", handleEvent);
  xhr.addEventListener("error", handleEvent);
  xhr.addEventListener("abort", handleEvent);
}

function runXHR(url) {
  log.textContent = "";

  const xhr = new XMLHttpRequest();
  addListeners(xhr);
  xhr.open("GET", url);
  xhr.send();
  return xhr;
}

xhrButtonSuccess.addEventListener("click", () => {
  runXHR(
    "https://somewhere",
  );
});

xhrButtonError.addEventListener("click", () => {
  runXHR("http://i-dont-exist");
});

xhrButtonAbort.addEventListener("click", () => {
  runXHR(
    "https://somewhere",
  ).abort();
});

END

}



Index: loncom/html/adm/help/tex/Authoring_Archiving_Directory.tex
+++ loncom/html/adm/help/tex/Authoring_Archiving_Directory.tex
\label{Authoring_Archiving_Directory}

When your Author role is selected and you access a directory in your Authoring Space,
including the top-level directory: /priv/yourdomain/yourusername/,
the \textbf{Function} bar of the Inline Menu. will contain an Export icon/link 
\includegraphics[width=0.03\paperwidth]{archive}
unless disabled -- either for your domain, or for your specific Authoring Space.

This utility can be used to export files in the current directory, and optionally also
within sub-directories, by creating a compressed archive file which you can download
to your computer.

Options include:

\begin{itemize}

\item Recurse

If the current directory contains sub-directories, and you wish to include those
in the exported archive file, check ``include subdirectories''.

Note: if the current directory, contains only sub-directories, i.e., there are
no files, then no archive file will be created if ``include subdirectories'' is
unchecked.

\item File types (extensions) to include

Checkboxes are provided for 22 common file extensions, including several
exclusive to LON-CAPA, such as problem, sty, meta etc., and others for
common web page or image formats. There is also an "other" checkbox which
if checked will cause any files with extensions that are not one of the 22
listed to be included in the archive file.

If you want to exported archive to contain all files, push the ``check all'' button.

Note: there are some internal files which LON-CAPA creates in your Authoring Space,
but are not shown on LON-CAPA's directory listing screen (e.g., .log files) which
will automatically be omitted from the exported archive, regardless of the choices
made for file types to include.

\item Archive file format

The format used to archive files (with or without) sub-directories can be tar or zip.
If tar is selected, then you will also choose which compression program to use.  The
default format is: tar.gz.

\end{itemize}


More information about the LON-CAPA-cvs mailing list