summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/source/latex/latex-tds/lib/ziptimetree.pl
diff options
context:
space:
mode:
Diffstat (limited to 'Master/texmf-dist/source/latex/latex-tds/lib/ziptimetree.pl')
-rwxr-xr-xMaster/texmf-dist/source/latex/latex-tds/lib/ziptimetree.pl368
1 files changed, 368 insertions, 0 deletions
diff --git a/Master/texmf-dist/source/latex/latex-tds/lib/ziptimetree.pl b/Master/texmf-dist/source/latex/latex-tds/lib/ziptimetree.pl
new file mode 100755
index 00000000000..29633055da6
--- /dev/null
+++ b/Master/texmf-dist/source/latex/latex-tds/lib/ziptimetree.pl
@@ -0,0 +1,368 @@
+eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q'
+ if 0;
+use strict;
+$^W=1; # turn warning on
+#
+# ziptimetree.pl
+#
+# Packs a directory tree into a ZIP file with sorted entries
+# and corrects file permissions and directory dates.
+#
+# Copyright 2006 Heiko Oberdiek.
+#
+# This library is free software; you can redistribute it and/or
+# modify it under the terms of the GNU Lesser General Public
+# License as published by the Free Software Foundation; either
+# version 2.1 of the License, or (at your option) any later version.
+#
+# This library 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
+# Lesser General Public License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public
+# License along with this library; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+# MA 02110-1301 USA
+#
+# Address: oberdiek at uni-freiburg.de
+#
+my $file = 'ziptimetree';
+my $program = 'ZIP-TimeTree';
+my $version = '1.2';
+my $date = '2006/06/15';
+my $author = 'Heiko Oberdiek';
+my $copyright = "Copyright (C) 2006 by $author.";
+#
+# History:
+# 2006/06/04 v1.0: First release.
+# 2006/06/07 v1.1: License LGPL.
+# 2006/06/15 v1.2: Small correction in option code.
+
+### program identification
+my $title = "$program $version, $date - $copyright\n";
+
+### error strings
+my $error = "!!! Error:"; # error prefix
+my $warning = "!!! Warning:";
+
+### file modes (type and permission)
+my $mode_directory = 040755; # drwxr-xr-x
+my $mode_file_regular = 0100644; # -rw-r--r--
+my $mode_file_exec = 0100755; # -rwxr-xr-x
+
+### programs
+my $prg_zip = 'zip';
+my $prg_pwd = 'pwd';
+
+### file extensions
+my $ext_zip = '.zip';
+
+### counters
+my $count_dir = 0;
+my $count_file = 0;
+my $count_exclude = 0;
+my $count_mode = 0;
+my $count_time = 0;
+my $count_warn = 0;
+
+### log levels
+my $log_quiet = 0;
+my $log_normal = 1;
+my $log_verbose = 2;
+my $log_debug = 3;
+
+### option variables
+my $help = 0;
+my $log_level = 1;
+my $compression = 9;
+my $root = 1;
+my $update = 0;
+my @exclude;
+my $tree;
+my $zipfile;
+
+my $usage = <<"END_OF_USAGE";
+${title}
+Syntax: $file [options] <zipfile> <treedir>
+
+ <zipfile> The file where the result is stored as zipped file.
+ The name must end in '.zip'.
+ <treedir> Specifies the root of a directory tree whose
+ directories and files are packed into the <zipfile>.
+
+Functions:
+* The permissions in the directory tree are normalized:
+ drwxr-xr-x directories
+ -rwxr-xr-x executable files
+ -rw-r--r-- regular files
+* The time stamps of the directories are set to the time of the
+ latest file somewhere below that directory.
+* The zip file is created with the same time as the latest file
+ inside the archive.
+* Also the entries are orderd by depth-first and name:
+ * The directory tree is traversed in deep-first order.
+ * If a directory is reached, first its directory entries are
+ processed in alphabetical order. Then its files are added,
+ sorted by names.
+
+Options: defaults:
+ --help print usage
+ --quiet quiet except for warnings and errors
+ --verbose verbose output
+ --debug debug output
+ -0 .. -9 store only .. best compression (-9)
+ --(no)update zip file is not deleted before creating (--noupdate)
+ --(no)root use/strip root directory name (--root)
+ --exclude <pattern> exclude files by regular expression
+
+File exclusion:
+ Option --exclude allows you to specify pattern that are
+ used to exclude files from packing into the zipfile.
+ The option can be invoked several times, the pattern are
+ collected in a list.
+ During the tree traversal the name of files and directories
+ are generated. Depending on the state of option --root these
+ names may or may not include the root directory name.
+ In order to distinguish between files and directories, a slash
+ is appended to a directory name. Then the patterns are used
+ as regular expressions. Files or directories which names matches
+ are excluded, in case of directories the whole tree.
+
+END_OF_USAGE
+
+### process options
+use Getopt::Long;
+GetOptions(
+ '0' => sub { $compression = 0 },
+ '1' => sub { $compression = 1 },
+ '2' => sub { $compression = 2 },
+ '3' => sub { $compression = 3 },
+ '4' => sub { $compression = 4 },
+ '5' => sub { $compression = 5 },
+ '6' => sub { $compression = 6 },
+ '7' => sub { $compression = 7 },
+ '8' => sub { $compression = 8 },
+ '9' => sub { $compression = 9 },
+ 'help!' => sub { die $usage },
+ 'quiet' => sub { $log_level = $log_quiet },
+ 'verbose' => sub { $log_level = $log_verbose },
+ 'debug' => sub { $log_level = $log_debug },
+ 'update!' => \$update,
+ 'root!' => \$root,
+ 'exclude=s' => \@exclude,
+) or die $usage;
+
+@ARGV == 2 or die $usage;
+$zipfile = shift @ARGV;
+$tree = shift @ARGV;
+
+### Report functions
+
+sub debug ($$) {
+ my $type = shift;
+ my $data = shift;
+ print "[$type] $data\n" if $log_level >= $log_debug;
+ 1;
+}
+sub verbose ($$) {
+ my $type = shift;
+ my $data = shift;
+ print "[$type] $data\n" if $log_level >= $log_verbose;
+}
+sub info ($$) {
+ my $type = shift;
+ my $data = shift;
+ print "[$type] $data\n" if $log_level >= $log_normal;
+ 1;
+}
+sub warning ($) {
+ my $msg = shift;
+ $count_warn++;
+ warn "$warning $msg\n";
+ 1;
+}
+
+### File operations
+
+sub excluded ($) {
+ my $file = shift;
+ $count_exclude++;
+ info 'excluded', $file;
+ 1;
+}
+sub changemod ($$) {
+ my $mode = shift;
+ my $file = shift;
+ my $chmod = sprintf('chmod %lo', $mode);
+ $count_mode++;
+ info $chmod, $file;
+ chmod $mode, $file or warning "Mode change failed: $file";
+}
+sub touch ($$) {
+ my $time = shift;
+ my $dir = shift;
+ my $mtime = (stat $dir)[9];
+ if ($mtime != $time) {
+ $count_time++;
+ info 'touch', $dir;
+ utime $time, $time, $dir or warning "Time update failed: $dir";
+ }
+}
+
+### Title
+print $title if $log_level >= $log_normal;
+
+use Cwd qw(getcwd abs_path);
+use File::Spec::Functions;
+
+# check $tree
+-d $tree or die "$error Directory does not exist: $tree\n";
+
+# zip file name
+$zipfile =~ /\.zip$/ or
+ die "$error Wrong file extension of zip file: $zipfile\n";
+
+# Option --noroot requires directory change because of program zip.
+my $cwd;
+if ($root) {
+ verbose 'zipfile', $zipfile;
+}
+else {
+ # adjust path of zipfile
+ $zipfile = abs_path($zipfile);
+ verbose 'zipfile', $zipfile;
+
+ # change directory
+ debug 'curdir', getcwd;
+ chdir $tree or die "$error Cannot change directory: $tree\n";
+}
+debug 'workdir', getcwd;
+
+my @list; # stores names as input for program zip
+
+# directory permissions should be checked before traversal
+if ($root) {
+ my $mode = (stat($tree))[2];
+ changemod $mode_directory, $tree unless $mode == $mode_directory;
+}
+
+sub traverse ($);
+sub traverse ($) {
+ my $dir = shift;
+
+ my $traverse_dir = ($dir) ? $dir : curdir;
+ debug 'traverse', $traverse_dir;
+ unless (opendir DIR, $traverse_dir) {
+ warning "Cannot open directory: $traverse_dir";
+ return 0;
+ }
+ my @sub_list = sort
+ grep { !/^[.]{1,2}$/ }
+ readdir DIR;
+ @sub_list = map { catfile $dir, $_ } @sub_list if $dir;
+ closedir DIR;
+ if ($dir) {
+ push @list, $dir;
+ $count_dir++;
+ }
+
+ my @sub_dirs;
+ my @sub_files;
+
+ for (@sub_list) {
+ if (-d $_) {
+ push @sub_dirs, $_;
+ next;
+ }
+ if (-f $_) {
+ push @sub_files, $_;
+ next;
+ }
+ warning "Unknown file type ignored: $_";
+ }
+
+ for my $exclude (@exclude) {
+ @sub_dirs = grep { not("$_/" =~ /$exclude/ and excluded "$_/") }
+ @sub_dirs;
+ @sub_files = grep { not(/$exclude/ and excluded $_) }
+ @sub_files;
+ }
+
+ @sub_dirs = grep { traverse $_ } @sub_dirs;
+ push @list, @sub_files;
+ $count_file += @sub_files;
+
+ my $time_max = 0;
+ for (@sub_dirs, @sub_files) {
+ my ($mode, $mtime) = (stat $_)[2,9];
+
+ $time_max = $mtime if $mtime > $time_max;
+
+ if (-d $_) {
+ changemod $mode_directory, $_ unless $mode == $mode_directory;
+ }
+ else {
+ my $mode_file = ((-x $_) ? $mode_file_exec : $mode_file_regular);
+ changemod $mode_file, $_ unless $mode == $mode_file;
+ }
+ }
+
+ touch $time_max, $dir if $dir;
+
+ 1;
+}
+
+traverse(($root) ? $tree : '');
+
+if (-f $zipfile) {
+ if ($update) {
+ info 'update', $zipfile;
+ }
+ else {
+ info 'delete/create', $zipfile;
+ unlink $zipfile or warning "Cannot delete: $zipfile";
+ }
+}
+else {
+ info 'create', $zipfile;
+}
+
+my $opts = " -o$compression";
+$opts .= "v" if $log_level >= $log_debug;
+$opts .= "q" if $log_level <= $log_normal;
+my $pipe = "|$prg_zip$opts $zipfile -\@";
+debug 'zip call', $pipe;
+
+open(ZIP, $pipe) or die "$error Cannot start `zip'!\n";
+for (@list) {
+ print ZIP "$_\n";
+}
+close(ZIP) or
+ die $! ? "$error Closing `zip': $!\n"
+ : "$error `zip' reports error code $?\n";
+
+-f $zipfile or die "$error Missing result zip file: $zipfile\n";
+
+info 'stats', "$count_exclude entries excluded" if $count_exclude > 1;
+info 'stats', "$count_exclude entry excluded" if $count_exclude == 1;
+info 'stats', "$count_mode mode changes" if $count_mode > 1;
+info 'stats', "$count_mode mode change" if $count_mode == 1;
+info 'stats', "$count_time time updates" if $count_time > 1;
+info 'stats', "$count_time time update" if $count_time == 1;
+info 'stats', "$count_dir directories added" if $count_dir != 1;
+info 'stats', "$count_dir directory added" if $count_dir == 1;
+info 'stats', "$count_file files added" if $count_file != 1;
+info 'stats', "$count_file file added" if $count_file == 1;
+info 'stats', "$count_warn warnings" if $count_warn > 1;
+info 'stats', "$count_warn warning" if $count_warn == 1;
+
+my $size = (stat $zipfile)[7];
+$size = join '', reverse split '', $size;
+$size =~ s/(\d\d\d)/$1./g;
+$size =~ s/\.$//;
+$size = join '', reverse split '', $size;
+
+print "--> $zipfile ($size bytes)\n" if $log_level >= $log_normal;
+
+__END__