[Debian-tex-commits] SVN tex-common commit + diffs: r5201 - in tex-common/branches/v3: . debian scripts
Norbert Preining
preining at alioth.debian.org
Sat Mar 10 03:19:22 UTC 2012
Author: preining
Date: 2012-03-10 03:19:21 +0000 (Sat, 10 Mar 2012)
New Revision: 5201
Removed:
tex-common/branches/v3/scripts/FileUtils.pm
tex-common/branches/v3/scripts/Tpm.pm
tex-common/branches/v3/scripts/tpm2licenses
tex-common/branches/v3/scripts/tpm2licenses.README
tex-common/branches/v3/split-texmf
Modified:
tex-common/branches/v3/TODO
tex-common/branches/v3/debian/changelog
tex-common/branches/v3/debian/rules
Log:
remove tpm2licenses, Tpm.pm, FileUtils.pm, this script is hopelessly
useless now that we don't have tpm files.
Modified: tex-common/branches/v3/TODO
===================================================================
--- tex-common/branches/v3/TODO 2012-03-10 03:16:23 UTC (rev 5200)
+++ tex-common/branches/v3/TODO 2012-03-10 03:19:21 UTC (rev 5201)
@@ -1,5 +1,6 @@
-dpkg: warning: while removing tex-common, directory '/etc/texmf' not empty so not removed.
+* rewrite policy and user documentation!!!
+ - updmap.d handling has disappeared
+ - texmf.d handling has changed, changes to /etc/texmf/web2c/texmf.cnf
+ are NOT USER EDITABLE ANYMORE
+ exclusive use of /etc/texmf/texmf.d
-* ucf move /etc/texmf/updmap.d/00updmap.cfg to /etc/texmf/web2c/updmap.cfg
-* ucf remove or disable if changed /etc/texmf/texmf.d/*
-
Modified: tex-common/branches/v3/debian/changelog
===================================================================
--- tex-common/branches/v3/debian/changelog 2012-03-10 03:16:23 UTC (rev 5200)
+++ tex-common/branches/v3/debian/changelog 2012-03-10 03:19:21 UTC (rev 5201)
@@ -1,3 +1,13 @@
+tex-common (3.3) experimental; urgency=low
+
+ * UNRELEASED
+ * remove tpm2licenses, Tpm.pm, FileUtils.pm, this script is hopelessly
+ useless now that we don't have tpm files.
+ WARNING: BEFORE UPLOADING WE HAVE TO UPLOAD TELXIVE PACKAGES WITH
+ FIXED generate-licenses script!!!!
+
+ -- Norbert Preining <preining at debian.org> Sat, 10 Mar 2012 12:17:59 +0900
+
tex-common (3.2) experimental; urgency=low
* clean up 3.1 changelog entry
Modified: tex-common/branches/v3/debian/rules
===================================================================
--- tex-common/branches/v3/debian/rules 2012-03-10 03:16:23 UTC (rev 5200)
+++ tex-common/branches/v3/debian/rules 2012-03-10 03:19:21 UTC (rev 5201)
@@ -7,7 +7,7 @@
bin_scripts=dh_installtex
sbin_scripts=update-fmtlang update-texmf-config update-updmap update-texmf
-nonbin_scripts=tpm2licenses tpm2licenses.README Tpm.pm FileUtils.pm debianize-updmap
+nonbin_scripts=debianize-updmap
sbin_installfiles=$(foreach script,$(sbin_scripts), scripts/$(script))
sbin_manpages=$(foreach script,$(sbin_scripts), scripts/$(script).8)
Deleted: tex-common/branches/v3/scripts/FileUtils.pm
===================================================================
--- tex-common/branches/v3/scripts/FileUtils.pm 2012-03-10 03:16:23 UTC (rev 5200)
+++ tex-common/branches/v3/scripts/FileUtils.pm 2012-03-10 03:19:21 UTC (rev 5201)
@@ -1,991 +0,0 @@
-# $Id: FileUtils.pm 2402 2006-11-08 01:45:28Z karl $
-# Written 2004, Fabrice Popineau.
-# Public domain.
-#
-package FileUtils;
-
-BEGIN {
- use Exporter ();
- use Cwd;
- use File::Path;
- # use File::Copy qw(copy);
- use vars qw( @ISA @EXPORT_OK);
- if ($^O eq 'MSWin32')
- { $Separator = "\\" ;}
- else
- { $Separator = "/" ;}
-
- @ISA = qw(Exporter);
-
- @EXPORT_OK = qw(
- &basename
- &build_path
- &build_tree
- &calc_file_size
- &canon_dir
- &check_path
- &cleandir
- &set_file_time
- ©
- &diff_list
- &dirname
- &globexpand
- &is_absolute
- &is_dirsep
- &look_for
- &make_link
- &member
- &min max
- &move
- &newer
- &newpath
- &normalize
- &print_tree
- &push_uniq
- &rec_copy
- &rec_mkdir
- &rec_rmdir
- ®expify
- &remove_list
- &sort_uniq
- &start_redirection
- &stop_redirection
- &substitute_var_val
- &sync_dir
- &walk_dir
- &walk_tree
- );
-}
-
-# Is the character a directory separator ?
-sub is_dirsep {
- my ($c) = @_;
- if ($c =~ /[\/\\]/) {
- return 1;
- } else {
- return 0;
- }
-}
-
-# Is the path absolute ?
-sub is_absolute {
- my ($d) = @_;
- if ($d =~ m@^([A-Za-z]:)?[/\\]@) {
- return 1;
- } else {
- return 0;
- }
-}
-
-# Rewrite '\\' into '/' and deletes multiple ones/
-sub canon_dir {
- my ($p, $rep) = @_;
- if ($p =~ m@^(.*)[/\\]$@) {
- $p = $1;
- }
- if (($rep eq '') || ($rep eq '\\')) {
- $p =~ s@/@\\@g;
- $p =~ s@\\[\\]+@\\@g;
- $p =~ s@\\\.\\@\\@g;
- while ($p =~ m/\\\.\./) {
- $p =~ s@\\([^\\]+)\\\.\.@\\@g;
- $p =~ s@\\[\\]+@\\@g;
- }
- } elsif ($rep eq '/') {
- $p =~ s@\\@/@g;
- $p =~ s@/[/]+@/@g;
- $p =~ s@/\./@/@g;
- while ($p =~ m/\/\.\./) {
- $p =~ s@/([^/]+)/\.\.@/@g;
- $p =~ s@/[/]+@/@g;
- }
- } else {
- die ("canon_dir($p) : invalid separator $rep.\n");
- }
- return $p;
-}
-
-# Merges all elements in the list into a single path, adding
-# directory separators as needed.
-sub build_path {
- my($p, $s);
- # Concatenates the arguments, adding path separators as needed
- $p = $_[0];
- for ($i = 1; $i <= $#_; $i++) {
- $p = $p . $Separator . $_[$i];
- }
- return &canon_dir($p);
-}
-
-sub sort_uniq {
- my (@l) = @_;
- my ($e, $f, @r);
- @l = sort(@l);
- foreach $e (@l) {
- if ($e ne $f) {
- $f = $e;
- push @r, $e;
- }
- }
- return @r;
-}
-
-sub remove_list {
- local (*l, $e) = @_;
- my (@r, $f);
- foreach $f (@l) {
- if ($f !~ m/$e/) {
- push @r, $f;
- }
- }
- @l = @r;
-}
-
-sub member {
- my ($e, @l) = @_;
- my ($f);
- foreach $f (@l) {
- if ($e eq $f) {
- return 1;
- }
- }
- return 0;
-}
-
-sub push_uniq {
- local (*l, @le) = @_;
- my ($e);
- foreach $e (@le) {
- if (! &member($e, @l)) {
- push @l, $e;
- }
- }
-}
-
-sub dirname {
- my ($f) = @_;
- $f =~ m@(^.*)[\\/][^\\/]*$@;
- return $1;
-}
-
-sub basename {
- my ($f) = @_;
- $f =~ m@([^\\/]*)$@;
- return $1;
-}
-
-sub normalize {
- my ($p, $sep) = @_;
- if ($sep eq '/') {
- $p =~ s@\\@/@g;
- $p =~ s@/(/|\./)*@/@g;
- return $p;
- } elsif ((! $sep) || ($sep eq '\\')) {
- $p =~ s@/@\\@g;
- $p =~ s@\\(\\|\.\\)*@\\@g;
- return $p;
- } else {
- print STDERR "normalize : invalid separator, $sep\n";
- return $p;
- }
-}
-
-sub walk_dir {
- # Walks the directory, executing $proc for each file,
- # until done is returned.
- my ($dir, $proc, $prune) = @_;
- my (@l, $f, $done, $src, $DIR);
-
- #print " walking $dir with $proc, $prune\n" if $::opt_debug;
-
- if ((! $prune) || ($prune && ! &{$prune}($dir))) {
- $done = 0;
- # Walk the directory tree
- opendir (DIR, $dir) || die "opendir($dir) failed: $!";
- while (my $d = readdir (DIR)) {
- # do not forget to remove "." and ".."
- next if $d =~ /^\.(\.?|svn)$/;
- push (@l, $d);
- }
- closedir (DIR) || warn "closedir($dir) failed: $!";
-
- # top-down
- &{$proc}($dir, @l);
-
- foreach $f (@l) {
- my $try = $dir . $Separator . $f;
- # Don't descend symlinks, since they are only used for generic
- # architecture names in bin. The tpm files use the real arch
- # directory names (with system version numbers).
- if (-d $try && ! -l $try) {
- &walk_dir($try, $proc, $prune);
- }
- }
- }
-}
-
-# Builds up a tree from pathes
-# $node is a reference to a hash
-sub build_tree {
- my (@elts) = @_;
- my $node = { };
- foreach my $p (@elts) {
- &add_path_to_tree($node, split("[/\\\\]", $p));
- }
- return $node;
-}
-
-sub add_path_to_tree {
- my ($node, @path) = @_;
- my ($current);
-
- while (@path) {
- $current = shift @path;
- if ($$node{$current}) {
- $node = $$node{$current};
- } else {
- $$node{$current} = { };
- $node = $$node{$current};
- }
- }
- return $node;
-}
-
-# walks the tree, calling the function at each node
-sub walk_tree {
- local (@stack_dir);
- walk_tree1(@_);
-}
-
-sub walk_tree1 {
- my ($node, $pre_proc, $post_proc) = @_;
- for $k (keys(%{$node})) {
- push @stack_dir, $k;
- $v = $node->{$k};
- if ($pre_proc) { &{$pre_proc}($v, @stack_dir) }
- walk_tree1 (\%{$v}, $pre_proc, $post_proc);
- $v = $node->{$k};
- if ($post_proc) { &{$post_proc}($v, @stack_dir) }
- pop @stack_dir;
- }
-}
-
-sub print_node {
- my ($node, @stackdir) = @_;
- if (! keys(%{$node})) {
- print join("/", @stackdir) . "\n";
- }
-}
-
-sub print_tree {
- my ($node) = @_;
- &walk_tree($node, \&print_node);
-}
-
-sub node2list {
- my ($node, @stackdir) = @_;
- if (! keys(%{$node})) {
- push @list, join("/", @stackdir);
- }
-}
-
-sub tree2list {
- my ($node) = @_;
- local @list;
- &walk_tree($node, \&node2list);
- return @list;
-}
-
-# Check that a path exists in a tree
-# exactly or as a subpath
-sub check_path {
- my ($node, @path, $exact) = @_;
- my ($current);
- # print "Checking for " . join('/', @path) . " exact = $exact\n";
- while (@path) {
- $current = shift @path;
- if ($$node{$current} == undef) {
- return 0;
- } else {
- $node = $$node{$current};
- }
- }
- # print "left " . join('/', @path) . " leaf " . $#{keys %{$node}} . "\n";
- if ($exact) {
- # We are at a leaf !
- return ($#{keys %{$node}} == -1);
- } else {
- return 1;
- }
-}
-
-
-
-# Removes everything in the directory
-# Can't use walk_dir because it could not remove directories.
-sub cleandir {
- my ($dir)= @_;
- my ($DIR, $f, @l, $name);
-
- if (-d $dir) {
- opendir DIR, "$dir";
- # do not forget to remove "." and ".."
- @l = readdir (DIR); shift @l; shift @l;
- closedir DIR;
- foreach $f (@l) {
- $name = $dir . $Separator . $f;
- if (-d $name) {
- &rmtree($name);
- print "rmdir $name\n" if $opt_verbose;
- rmdir "$name";
- } elsif (-f "$name") {
- print "Removing $name\n" if $opt_verbose;
- unlink "$name";
- } else {
- print "Can't remove $name!\n";
- }
- }
- }
-}
-
-sub rec_rmdir {
- my (@files) = @_;
- map { &cleandir($_); rmdir($_) } @files;
-}
-
-# Builds up a new directory together with any of its parents
-sub rec_mkdir {
- my ($path) = @_;
- my $tmp;
- my $old_dir = &getcwd;
- my @l = split ("[/\\\\]", $path);
- if ($path =~ m@[/\\]@) {
- chdir "/"; shift @l;
- }
- elsif ($l[0] =~ m/[A-Za-z]:/) {
- chdir "$l[0]/";
- shift @l;
- }
- while (@l) {
- $tmp = shift(@l);
- mkdir($tmp, 755) if (! -d $tmp);
- print "mkdir $tmp\n";
- chdir $tmp;
- }
- chdir $old_dir;
-}
-
-sub copy {
- my (@src, $dest, $l, $t);
- @l = @_;
- $dest = pop @l;
-
- @src = ();
- if ($#l == 0 && -f $l[0]) {
- @src = @l;
- }
- else {
- map {
- my @expand = ($_ =~ m/ / ? <"$_"> : <$_>);
-# print "expanding $_ => @expand\n";
- push @src, @expand;
- } @l;
- }
- my $target;
- map {
- if (! -d $_) {
- open IN, "<$_";
- $target = $dest;
- if (-d $target) {
- $target = &newpath($dest, &basename($_));
- }
- open OUT, ">$target";
-
-# print "Copying $_ to " . &newpath($dest, &basename($_)) . "\n";
- binmode(IN);
- binmode(OUT);
- print OUT <IN>;
- close(OUT);
- close(IN);
- &set_file_time($_, $target);
- }
- } @src;
-}
-
-sub set_file_time {
- my ($from, $to) = @_;
- @st = stat($from);
- utime($st[8], $st[9], $to);
-}
-
-sub rec_copy {
- my (@src, $dest, $l, $dir);
- @l = @_;
- $dest = pop @l;
-
- @src = ();
- map {
- my @expand = ($_ =~ m/ / ? <"${_}"> : <${_}>);
-# print "expanding $_ => @expand\n";
- push @src, @expand;
- } @l;
-
- if (! -d $dest) {
- mkdir ($dest, 777);
- }
-
- $dir = &getcwd;
- if (! is_absolute($dest) ) {
- $dest = &canon_dir("$dir/$dest");
- print "new dest = $dest\n";
- }
-
- map {
- $l = $_;
- if (-d $l) {
- chdir($l);
- &rec_copy("*", "$dest/" . &basename($l));
- chdir($dir);
- } else {
- ©($l, "$dest/" . &basename($l));
- &set_file_time($l, "$dest/" . &basename($l));
- }
- } @src;
-}
-
-sub move {
- my ($dest) = pop @_;
- my ($src, $f, $l);
-
- @l = @_;
- foreach $f (@l) {
- # Handle globbing
- if ($f =~ m/[*?]/) {
- my @expand = ($f =~ m/ / ? <"${f}"> : <${f}>);
-# print "expanding $f => @expand\n";
- push @src, @expand;
- } else {
- push @src, $f;
- }
- }
- if (($#src > 2) && (! -d $dest)) {
- print STDERR "*** Move : can't move to $dest, not a directory.\n";
- return;
- }
-
- foreach $f (@src) {
- if (-d $dest) {
- rename($f, &newpath($dest, &basename($f)));
- } else {
- ©($f, $dest);
- &set_file_time($f, $dest);
- unlink($f);
- }
- }
-}
-
-# Simulate links by copying
-sub make_link {
- my ($to, $from) = @_;
- $to = canon_dir($to);
- $from = &newpath(dirname($to), $from);
- print "linking $from -> $to ...";
- if (-e $to) {
- unlink($to);
- }
- if (-d $from) {
- system("xcopy $from $to /f/r/i/e/d/k");
- } else {
- ©($from, $to);
- &set_file_time($from, $to);
- }
- print " done\n";
-}
-
-# Merges all elements in the list into a single path, adding
-# directory separators as needed.
-sub newpath {
- return &canon_dir(join ($Separator, @_));
-}
-
-#
-# Search for $key = $val in $file
-#
-sub look_for {
- my($key, $file) = @_;
- my($ret);
- open FIN, "<$file";
- while (<FIN>) {
- if ($_ =~ m/^$key\s*=\s*(\S*)/) {
- $ret = $1;
- last;
- } elsif (/^\#define\s+$key\s+(\S*)/) {
- $ret = $1;
- last;
- }
- }
- close FIN;
- return $ret;
-}
-
-
-sub max {
- $m = shift;
- while ($_ = shift) {
- $m = $_ if ($_ > $m);
- }
- return $m;
-}
-
-sub min {
- $m = shift;
- while ($_ = shift) {
- $m = $_ if ($_ < $m);
- }
- return $m;
-}
-
-# Changes lines of the form:
-# $var=... to
-# $var='$val' in $file
-#
-sub substitute_var_val {
- my($file, $var, $val) = @_;
- my($success);
-
- @success = ( );
-
- if (! -f $file) {
- print STDERR "$0: $file is not a file\n";
- return $success;
- }
- open IN, "<$file";
- open OUT, ">$file.bak";
-
- while (<IN>) {
- s/^$var\s*=\s*(.*)$/do {
- push @success, $1;
- # "\$" . $var . "=" . eval('$val') . ";" .
- "$var = $val"
- }/e;
- print OUT;
- }
- close IN;
- close OUT;
-
- ©("$file.bak", "$file");
- unlink("$file.bak");
-
- return @success;
-}
-
-#
-# Used by globexpand($recurse, $dir)
-#
-sub globexpand_push {
- my ($dir, @l) = @_;
- #print "globexpand_push($dir, @l)\n" if $::opt_debug;
- my ($file);
- $dir =~ s@\\@/@g;
- foreach $file (@l) {
- next if $file =~ /^\.(\.?|svn)$/;
- my $path = "$dir/$file";
- next if $path =~ m/^${Tpm::IgnoredFiles}$/;
- if (-f $path) {
- #print " push $dir/$file\n" if $::opt_debug;
- push @listglob, $path;
- }
- }
-}
-
-#
-# Returns the list of files that match $pattern
-# Recursively walking directories if $recurse
-#
-sub globexpand {
- my ($recurse, $pattern) = @_;
- local @listglob = ( );
-# $opt_verbose = ($pattern =~ m/GsTools/i ? 1 : 0);
- if (-f $pattern) {
- push @listglob, $pattern;
- }
- else {
- my @expand = ($pattern =~ m/ / ? <"${pattern}"> : <${pattern}>);
- #print " globexpanding $pattern => @expand\n" if $::opt_debug;
- while ( @expand ) {
- $_ = shift @expand;
- #print "elt $_\n" if $::opt_debug;
- if (-f $_) {
- #print " pushing $_\n" if $::opt_debug;
- push @listglob, $_;
- } elsif (($_ ne "") && (-d $_) && ($recurse)) {
- &walk_dir($_, \&globexpand_push);
- }
- }
- }
- #print " globexpanded $pattern => @listglob\n" if $::opt_debug;
- return @listglob;
-}
-
-sub diff_list {
- local ($l1, $l2, *l1_l2, *l2_l1) = @_;
-
- # print "Before sorting:\n";
- # map { print "$_\n"; } @$l1;
- # print "\n";
- # map { print "$_\n"; } @$l2;
- # $opt_verbose = 1;
- # $opt_debug = 1;
-
- @l1 = sort(@$l1);
- @l2 = sort(@$l2);
-
- # print "After sorting:\n";
- # map { print "$_\n"; } @l1;
- # print "\n";
- # map { print "$_\n"; } @l2;
-
- while ($#l1 >= 0 || $#l2 >= 0) {
- if ($#l1 == -1) {
- print "No more elements in l1, over.\n" if $opt_debug;
- push (@l2_l1, @l2);
- @l2 = ();
- } elsif ($#l2 == -1) {
- print "No more elements in l2, over.\n" if $opt_debug;
- push (@l1_l2, @l1);
- @l1 = ();
- } else {
- my $comp = $l1[0] cmp $l2[0];
-
- if ($comp == 0) {
- print "Same element $l1[0], shifting both.\n" if $opt_debug;
- shift @l1;
- shift @l2;
- } elsif ($comp > 0) {
- print "Greater element $l1[0] than $l2[0], shifting l2.\n" if $opt_debug;
- push (@l2_l1, shift @l2);
- } else {
- print "Smaller element $l1[0] than $l2[0], shifting l1.\n" if $opt_debug;
- push (@l1_l2, shift @l1);
- }
- }
- }
-
- if ($opt_verbose) {
- print "$#l1_l2, $#l2_l1\n";
-
- print "Elts in l1 and not in l2 : \n";
- map { print "$_\n"; } @l1_l2; print "\n";
-
- print "Elts in l2 and not in l1 : \n";
- map { print "$_\n"; } @l2_l1; print "\n";
- }
- return ($#l1_l2 == -1 && $#l2_l1 == -1);
-}
-
-sub sync_dir {
- my ($src, $dst, $opt_proc, $opt_prune, $opt_dry, $opt_mirror, $opt_nomkdir) = @_;
- local ($cwd, $dry, $mirror, $proc, $prune, $nomkdir);
-
- $cwd = &getcwd;
- $dry = $opt_dry;
- $mirror = $opt_mirror;
- $proc = $opt_proc;
- $prune = $opt_prune;
- $nomkdir = $opt_nomkdir;
-
- print "src = $src\ndst = $dst\n";
- if (! chdir($src)) {
- print "Error: can't chdir to $src\n";
- return;
- }
- sync_dir_1(".", $dst);
- chdir($cwd);
-}
-
-sub newer {
- my ($f1, $f2) = @_;
- my (@t1, @t2, $t11, $t12);
- @t1 = stat($f1);
- @t2 = stat($f2);
- $t11 = $t1[9];
- $t12 = $t2[9];
- return -1 if ($t11 < $t12);
- return 1 if ($t11 > $t12);
- return 0;
-}
-
-sub sync_dir_1 {
- # Walks the directory, executing $proc for each file,
- # until done is returned.
- my ($dir, $dst) = @_;
- my (@l, $f, $done, $src, $DIR);
-
- print "Walking $dir\n" if $opt_verbose;
-
- if (! -d $dst) {
- if (-f $dst) {
- # Clash
- print "!!!Clash: $dir is a directory and $dst is a file.\n";
- return;
- } elsif (! $nomkdir) {
- print "Creating missing directory $dst\n";
- mkdir $dst if (! $dry);
- }
- }
-
- if ((! $prune) || ($prune && ! &{$prune}($dir))) {
- $done = 0;
- # Walk the directory tree
- opendir DIR, "$dir";
- # do not forget to remove "." and ".."
- @l = readdir (DIR); shift @l; shift @l;
- closedir DIR;
- # Apply the filter
- @l = &{$proc}($dir, $dst, @l) if ($proc);
-
- foreach $f (@l) {
- if (-d $dir . $Separator . $f) {
- # source is directory
- &sync_dir_1($dir . $Separator . $f, $dst . $Separator . $f);
- } elsif (-d $dst . $Separator . $f) {
- # source is file and destination is directory
- print "!!!Clash: $dir is a file and $dst is a directory.\n";
- next;
- } elsif (! -f $dst . $Separator . $f) {
- # source is file and destination is missing
- print "Copying missing file " . $dst . $Separator . $f . "\n";
- if (! $dry) {
- © ($dir . $Separator . $f, $dst . $Separator . $f);
- &set_file_time($dir . $Separator . $f, $dst . $Separator . $f);
- }
- } else {
- my $compare = &newer($dir . $Separator . $f, $dst . $Separator . $f);
- if ($compare > 0 || ($mirror && $compare < 0)) {
- # source is file and destination is older than source
- print "Copying newer file " . $dir . $Separator . $f . " than " . $dst . $Separator . $f . "\n";
- if (! $dry) {
- © ($dir . $Separator . $f, $dst . $Separator . $f);
- &set_file_time($dir . $Separator . $f, $dst . $Separator . $f);
- }
- }
- }
- }
- # Look at the other side
- opendir DIR, "$dst";
- # do not forget to remove "." and ".."
- @l = readdir (DIR); shift @l; shift @l;
- closedir DIR;
- # Apply the same filter procedure
- @l = &{$proc}($dir, $dst, @l) if ($proc);
- foreach $f (@l) {
- # We should look only for things to remove on the destination side
- next if (-e "$dir$Separator$f");
- # If it does not exist on the source side, then remove it.
- if (-d "$dst$Separator$f") {
- print "Removing directory $dst$Separator$f\n";
- &rmtree("$dst$Separator$f") if (! $dry);
- } elsif (-f "$dst$Separator$f") {
- print "Removing file $dst$Separator$f\n";
- unlink("$dst$Separator$f") if (! $dry);
- } else {
- print "Unknown file type $f\n";
- }
- }
- }
-}
-
-sub start_redirection {
- local ($log) = @_;
-
- # start redirection if asked
- if ($log) {
- print "Logging onto $log\n";
- open(SO, ">&STDOUT");
- open(SE, ">&STDERR");
-
- close(STDOUT);
- close(STDERR);
-
- open(STDOUT, ">$log");
- open(STDERR,">&STDOUT");
-
- select(STDERR); $| = 1;
- select(STDOUT); $| = 1;
- }
-}
-
-sub stop_redirection {
-
- local($log) = @_;
-
- if ($log) {
- close(STDOUT);
- close(STDERR);
- open(STDOUT, ">&SO");
- open(STDERR, ">&SE");
- }
-}
-
-sub calc_file_size {
- my ($dir, @files) = @_;
- my ($size, @st);
-
- # print "calc_file_size : $dir, files = $#files\n"; # if $opt_debug;
- if (! -d $dir) {
- print STDERR "$0: $dir is not a directory!\n";
- return 0;
- }
- $size = 0;
- @files = map { &globexpand(1, "$dir/$_"); } @files;
- map {
- @st = stat($_);
- $size += $st[7];
- } @files;
- # print "size = $size\n" if ($opt_debug);
- return $size;
-}
-
-# sub globtest {
-# my ($s1, $s2) = @_;
-# my @l1 = reverse(split("\\/", $s1));
-# my @l2 = reverse(split("\\/", $s2));
-# my $match = 1;
-# # pop @l1; pop @l2;
-# my $debug = 0;
-# print "l1 = (@l1), l2 = (@l2)\n" if ($debug);
-
-# while ($match) {
-# my $e1 = pop @l1;
-# my $e2 = pop @l2;
-# print "e1 = $e1, e2 = $e2\n" if ($debug);
-# last if ($e1 eq "" && $e2 eq "");
-
-# next if ($e1 eq $e2);
-# if ($e1 eq "*") {
-# return 1 if ($#l1 < 0);
-# $e1 = pop @l1;
-# print "e1 = $e1 $#l1 " if ($debug);
-# do {
-# $e2 = pop @l2;
-# print "e2 = $e2 " if ($debug);
-# } while ($e1 ne $e2 && $#l2 >= 0);
-# print "\n" if ($debug);
-# return ($e1 eq $e2 ? 1 : 0) if ($#l2 < 0);
-# }
-# if ($e2 eq "*") {
-# return 1 if ($#l2 < 0);
-# $e2 = pop @l2;
-# do {
-# $e1 = pop @l1;
-# } while ($e2 ne $e1 && $#l1 >= 0);
-# return ($e1 eq $e2 ? 1 : 0) if ($#l1 < 0);
-# }
-# $match = ($e1 eq $e2 ? 1 : 0);
-# }
-# print "returning $match\n" if ($debug);
-# return $match;
-# }
-
-sub regexpify_node {
- my ($node, @stackdir) = @_;
- my $relative = join "/", @stackdir;
-
- @l2 = keys(%{$node});
- # remove directories
- @l2 = grep { ! (keys %{$node->{$_}}) } @l2;
- if (@l2) {
- opendir DIR, "$dir/$relative";
- # do not forget to remove "." and ".."
- my @l = readdir (DIR); shift @l; shift @l;
- closedir DIR;
- @l = grep { ! -d "$dir/$relative/$_" } @l;
- # compare @l and keys(%{$node})
- my (@l3, @l4);
- @l3 = ();
- @l4 = ();
- my $diff = &diff_list(\@l, \@l2, \@l3, \@l4);
- if ($diff) {
- foreach $k (keys(%{$node})) {
- delete $$node{$k} if (! (keys %{$node->{$k}}));;
- }
- $$node{'*'} = { };
- }
- }
- else {
-
- }
-}
-
-sub regexpify_recursive_node {
- my ($node, @stackdir) = @_;
- my $relative = join "/", @stackdir;
-
- @l2 = keys(%{$node});
- if (@l2) {
- opendir DIR, "$dir/$relative";
- # do not forget to remove "." and ".."
- my @l = readdir (DIR); shift @l; shift @l;
- closedir DIR;
- # compare @l and keys(%{$node})
- my (@l3, @l4);
- @l3 = ();
- @l4 = ();
- my $diff = &diff_list(\@l, \@l2, \@l3, \@l4);
- if ($diff) {
- my $test = 1;
- foreach $k (keys(%{$node})) {
- $test = $test && ! $node->{$k}->{'__noregexpify'};
- }
- if ($test) {
- foreach $k (keys(%{$node})) {
- delete $$node{$k};
- }
- $$node{'*'} = { };
- }
- } else {
- $node->{'__noregexpify'} = 1;
- }
- }
- else {
-
- }
-}
-
-sub regexpify_cleanup {
- my ($node, @stackdir) = @_;
- if ($node->{'__noregexpify'}) {
- delete $node->{'__noregexpify'};
- }
-}
-
-sub regexpify {
- my ($recursive, $texdir, @files) = @_;
- my ($node);
- local $dir = $texdir;
-
- $node = &FileUtils::build_tree(@files);
-
- if ($recursive) {
- &FileUtils::walk_tree($node, '', \®expify_recursive_node);
- &FileUtils::walk_tree($node, '', \®expify_cleanup);
- }
- else {
- &FileUtils::walk_tree($node, '', \®expify_node);
- }
- return &FileUtils::tree2list($node);
-}
-
-# Print Perl backtrace, for debugging.
-sub backtrace {
- my $subr;
- my $stackframe = 0;
- while (($pkg,$filename,$line,$subr) = caller ($stackframe)) {
- print "$filename:$line: $pkg::$subr called\n";
- $stackframe++;
- }
-}
-
-END { }
-
-1;
Deleted: tex-common/branches/v3/scripts/Tpm.pm
===================================================================
--- tex-common/branches/v3/scripts/Tpm.pm 2012-03-10 03:16:23 UTC (rev 5200)
+++ tex-common/branches/v3/scripts/Tpm.pm 2012-03-10 03:19:21 UTC (rev 5201)
@@ -1,1875 +0,0 @@
-# $Id: Tpm.pm 3719 2007-01-23 01:44:19Z karl $
-# Written 2004, Fabrice Popineau.
-# Public domain.
-#
-package Tpm;
-
-BEGIN {
-
- # $Exporter::Verbose = 1;
- use Exporter ();
- use Carp;
- use XML::DOM;
- use File::Path;
- use FileUtils;
- use Cwd;
- @ISA = qw( Exporter );
- @EXPORT_OK = qw (
- new
- $MasterDir
- %TexmfTreeOfType %TypeOfTexmfTree
- $FtpDir $CurrentArch
- @TpmCategories
- @TexmfTrees
- @ArchList
- @StandAlonePackages
- $IgnoredFiles
- &toRDF &toString
- &setAttribute &getAttribute
- &setList &getList
- &setHash &getHash
- &patternsExpand
- &patternsUpdate
- &buildPatternsPackage
- &buildPatternsDocumentation
- &getPatterns
- &fixDate
- &fixRequires
- &patternsAuto
- &completeUsingCatalogue
- &getAllFileList
- &getRequiredFileList
- &getRequiredTpm
- &getFilesFromPatterns
- &writeFile
- &testSync
- &Tpm2Zip
- &Clean
- &Remove
- $Verbose
- );
-
- use vars (@ISA);
-
-}
-
-$MasterDir = "c:/Source/TeXLive/Master";
-$ZipDir = "c:/InetPub/ftp/fptex/0.7";
-$CurrentArch = "all";
-$Editor = ($^O =~ m/win32/i ? "notepad": "vi");
-
-#print "$MasterDir $CurrentArch\n";
-
-%TexmfTreeOfType = ( "TLCore" => "texmf",
- "Documentation" => "texmf-doc",
- "Package" => "texmf-dist");
-%TypeOfTexmfTree = &reverse_hash(%TexmfTreeOfType);
-
- at TpmCategories = keys %TexmfTreeOfType;
- at TexmfTrees = values %TexmfTreeOfType;
-
-# must match subdir names in Master/bin/ directory.
- at ArchList = (
- "alpha-linux",
- "alpha-osf",
- "hppa-hpux",
- "i386-darwin",
- "i386-freebsd",
- "i386-linux",
- "i386-openbsd",
- "i386-solaris",
- "mips-irix",
- "powerpc-aix",
- "powerpc-darwin",
- "powerpc-linux",
- "sparc-solaris",
- "sparc-linux",
- "win32",
- "win32-static",
- "x86_64-linux"
- );
-
- at StandAlonePackages = (
- "TLCore/bin-afm2pl",
- "TLCore/bin-aleph",
- "TLCore/bin-dvipdfm",
- "TLCore/bin-dvipdfmx",
- "TLCore/bin-dvipsk",
- "TLCore/bin-gsftopk",
- "TLCore/bin-lcdftypetools",
- "TLCore/bin-omega",
- "TLCore/bin-pdftex",
- "TLCore/bin-metapost",
- "TLCore/bin-t1utils",
- "TLCore/bin-tex4htk",
- "TLCore/bin-windvi"
- );
-
-# this list is not up to date, therefore I think it is not needed.
-# . "bin/i386-freebsd|bin/i386-openbsd|bin/i386-solaris|bin/mips-irix"
-# . "|bin/powerpc-aix|bin/powerpc-darwin|bin/sparc-solaris"
-
-# used both to ignore whole tpm's (?) and individual files?
-# must match whole path
-$IgnoredFiles = "("
- . 'source/.*'
- . '|texmf/tpm/(collection-binaries|texlive|xemtex|scheme-.*|.*-static)\.tpm'
- . '|texmf(-doc|-dist)?/(ls-R|aliases|lists/.*|README|tpm/tpm.dtd)'
- . '|.*/\.svn.*'
- . ")";
-
-# The so-called engines
-my @engines = (
- "aleph", "enctex", "eomega", "metafont", "metapost",
- "omega", "pdftex", "pdfetex", "tex", "vtex",
- "bibtex", "context", "dvipdfm", "dvips", "ispell",
- "makeindex","mft", "psutils", "tex4ht", "texdoctk",
- "ttf2pk");
-# The so called formats
-my @formats = (
- "alatex", "amstex", "context", "cslatex", "csplain", "enctex",
- "eplain", "fontinst", "generic", "jadetex", "lambda",
- "latex", "latex3",
- "mex", "physe", "phyzzx", "plain", "psizzl",
- "startex", "texinfo", "texsis", "xetex", "xelatex",
- "xmltex", "ytex", );
-# Kind of font files
-my @fonttypes = (
- "afm", "misc", "ofm", "opentype", "ovf", "ovp", "pfb",
- "pfm", "pk", "sfd", "source", "tfm", "truetype", "type1", "vf"
- );
-# Font vendors
-my @vendors = (
- "adobe", "amsfonts", "arabi", "archaic", "arphic",
- "bakoma", "bh", "bitstrea", "bluesky",
- "cg", "cns", "cspsfonts-adobe", "groff",
- "hoekwater", "ibm", "itc", "jknappen", "jmn", "korean", "lh",
- "mathdesign", "misc", "monotype", "paragrap",
- "public", "uhc", "urw", "urw35vf", "vntex", "wadalab",
- "xetex", "yandy");
-my @fontmodes = (
- "ljfour", "ljfive", "cx"
- );
-my @languages = ("bulgarian", "chinese", "czechslovak", "dutch", "english",
- "finnish", "french", "general",
- "german", "greek", "italian", "japanese", "korean",
- "mongolian",
- "polish", "portuguese", "russian", "slovak", "spanish",
- "thai", "turkish", "ukrainian", "vietnamese");
-
-my %dotfiles = (
- "texmf-dist/tex/latex/tools/*" => ( "texmf-dist/tex/latex/tools/.tex" ),
- "texmf/chktex/*" => ( "texmf/chktex/.chktexrc" )
- );
-
-my $CatalogueDir = "${MasterDir}/texmf-doc/doc/english/catalogue";
-my $Catalogue;
-
-#
-# %Tpm2Catalogue gives a mapping from tpm names to Catalogue entries
-#
-# missing entries
-# ? bengali:pandey
-# ? grotesq:urwvf
-# ? helvetic:urwvf
-# ? knuthotherfonts:halftone
-# makedtx:makedtx not working!
-# ? oberdiek:twoopt, tabularht, tabularkv, settobox, refcount, alphalph, chemar
-# r, classlist, dvipscol, engord, hypbmsec, hypcap, ifdraft, ifpdf, ifvtexm pagese
-# l, pdfcolmk pdfcrypt, pdflscape (somehing missing???)
-my %Tpm2Catalogue = (
- "ctib" => "ctib4tex",
- "CJK" => "cjk",
- "bayer" => "universa",
- "bigfoot" => "suffix",
- "cb" => "cbgreek",
- "cd-cover" => "cdcover",
- "cmex" => "cmextra",
- "cs" => "csfonts",
- "cyrplain" => "t2",
- "devanagr" => "devanagari",
- "eCards" => "ecards",
- "ESIEEcv" => "esieecv",
- "euclide" => "pst-eucl",
- "GuIT" => "guit",
- "HA-prosper" => "prosper",
- "ibycus" => "ibycus4",
- "ibygrk" => "ibycus4",
- "IEEEconf" => "ieeeconf",
- "IEEEtran" => "ieeetran",
- "iso" => "isostds",
- "iso10303" => "isostds",
- "jknapltx" => "jknappen",
- "kastrup" => "binhex",
- "le" => "frenchle",
- "mathtime" => "mathtime-ltx",
- "omega-devanagari" => "devanagari-omega",
- "pdftexdef" => "pdftex-def",
- "procIAGssymp" => "prociagssymp",
- "resume" => "res",
- "SIstyle" => "sistyle",
- "SIunits" => "siunits",
- "syntax" => "syntax2",
- "Tabbing" => "tabbing" );
-
-my $Verbose = 0;
-
-sub reverse_hash {
-{
- my (%direct) = @_;
- my %reversed;
- my ($key, $value);
- foreach $key (keys %direct) {
- $reversed{$direct{$key}} = $key;
- }
- return %reversed;
-}
-
-
-
-}
-#----------------------------------------------------------------------
-# Helper functions
-sub getTextField {
- my ($doc, $f) = @_;
- my $nodelist = $doc->getElementsByTagName("TPM:$f");
-
- my %s = ( );
- return %s if ($nodelist->getLength <= 0);
- my $node = $nodelist->item(0);
- return %s if (! $node);
- foreach my $k (@{$node->getAttributes->getValues}) {
- $k = $k->getName;
- $s{$k} = $node->getAttribute($k);
- }
- $node = $node->getFirstChild();
- return %s if (! $node);
- my $str = $node->toString;
- $str = $node->expandEntityRefs($str);
- $s{"text"} = $str;
- return %s;
-}
-
-sub getListField {
- my ($doc, $f) = @_;
-
- my %s = getTextField($doc, $f);
- my $str = $s{"text"};
- $str = "" if (!defined($str));
- $str =~ s/^\n*//;
- $str =~ s/\n*$//;
- $str =~ s/\n/ /gomsx;
- @{$s{"text"}} = split(" ", $str);
- return %s;
-}
-
-sub getMultipleTextField {
- my ($doc, $f) = @_;
- my $nodelist = $doc->getElementsByTagName("TPM:$f");
- my @stringlist = ( );
-
- for (my $i = 0; $i < $nodelist->getLength; $i++) {
- my $node = $nodelist->item($i);
- my %s = ( );
- foreach my $k (@{$node->getAttributes->getValues}) {
- $k = $k->getName;
- $s{$k} = $node->getAttribute($k);
- }
- $node = $node->getFirstChild();
- if ($node) {
- my $text = $node->toString;
- $text =~ s/\n/ /gomsx;
- push @{$s{"text"}}, split(" ", $text);
- }
- push @stringlist, \%s;
- }
-
- return @stringlist;
-}
-
-sub getAttributes {
- my ($doc, $f) = @_;
- my $nodelist = $doc->getElementsByTagName("TPM:$f");
- my %attr = ( );
- return %attr if ($nodelist->getLength <= 0);
- my $node = $nodelist->item(0);
-
- foreach my $k (@{$node->getAttributes->getValues}) {
- $k = $k->getName;
- $attr{$k} = $node->getAttribute($k);
- }
- return %attr;
-}
-#----------------------------------------------------------------------
-
-sub new {
- my $type = shift;
- my ($filename) = @_;
- my $self = { };
- bless $self, $type;
- if ($filename) {
- $filename =~ s@\\@/@g;
- $filename .= ".tpm" if ($filename !~ m@\.tpm$@);
- if (! &FileUtils::is_absolute($filename)) {
- $filename = "${Tpm::MasterDir}/${filename}";
- }
- if (! -f $filename) {
- $filename =~ m@^.*/(.*)/(.*)$@;
- if (&FileUtils::member($1, @TpmCategories)) {
- $filename = "${Tpm::MasterDir}/" . $TexmfTreeOfType{$1} . "/tpm/$2";
- }
- }
- die (`pwd` . "$filename not found!\n") if (! -f $filename);
- my $parser = new XML::DOM::Parser;
- $doc = $parser->parsefile($filename);
- my ($type, $name);
- $filename =~ m@^(.*/|)([^/]+)[/\\]tpm[/\\]([^/\.]+)\.tpm$@;
- $type = $TypeOfTexmfTree{$2}; $name = $3;
- $self->initialize($type,$name,$doc);
- }
- return $self;
-}
-
-sub initialize {
- my ($self, $type, $name, $doc) = @_;
- my $parser = new XML::DOM::Parser;
-
- my $text;
- my @list;
- my %field;
-
- %field = &getTextField($doc, "Name");
- $text = $field{"text"};
- if ($text ne $name) {
- print "Warning: $filename has wrong Name attribute ($text should be $name) ... fixing it.\n";
- }
- $self->setAttribute("Name", $name);
-
- %field = &getTextField($doc, "Type");
- $text = $field{"text"};
- if ($text ne $type) {
- print "Warning: $filename has wrong Type attribute ($text should be $type) ... fixing it.\n";
- }
- $self->setAttribute("Type", $type);
-
- for my $tag ("Date", "Version", "Creator", "Size", "Author", "Title", "Description", "Provides") {
- %field = &getTextField($doc, "$tag");
- $text = $field{"text"};
- $self->setAttribute("$tag", $text);
- }
-
- $text = $self->getAttribute("Provides");
- if ("$type/$name" ne $text) {
- print "Warning: $filename has wrong Provides attribute ($text should be $type/$name) ... fixing it.\n";
- }
- $self->setAttribute("Provides", "$type/$name");
-
- %field = &getAttributes($doc, "Flags");
- $self->setHash("Flags", %field);
- # map { print "$_ = $field{$_}\n"; } (keys %field);
-
- for my $tag ("BinPatterns", "RunPatterns", "DocPatterns", "SourcePatterns", "RemotePatterns") {
- %field = &getListField($doc, "$tag");
- @list = @{$field{"text"}};
- $self->setList("$tag", @list);
- }
-
- # FIXME ! several architectures !
- @list = &getMultipleTextField($doc, "BinFiles");
- $self->setList("BinFiles", @list);
-
- for my $tag ("RunFiles", "DocFiles", "SourceFiles", "RemoteFiles") {
- %field = &getListField($doc, "$tag");
- $self->setHash("$tag", %field);
- }
-
- my %requires = ();
- for my $tag (@TpmCategories) {
- my $nodelist = $doc->getElementsByTagName("TPM:$tag");
- for (my $i = 0; $i < $nodelist->getLength; $i = $i+1) {
- my $package = $nodelist->item($i)->getAttribute("name");
- push @{$requires{$tag}}, $package;
- }
- }
- $self->setHash("Requires",%requires);
-
- # Installation instructions
- my @instructions = ();
- $nodelist = $doc->getElementsByTagName("TPM:Installation");
- if ($nodelist->getLength > 0) {
- my $executelist = $doc->getElementsByTagName("TPM:Execute");
- for (my $i = 0; $i < $executelist->getLength; $i++) {
- my $inst = $executelist->item($i);
- my %execute = ();
- foreach my $attr (@{$inst->getAttributes->getValues}) {
- $attr = $attr->getName;
- $execute{$attr} = $inst->getAttribute($attr);
- }
- push @instructions, \%execute;
- }
- }
-
- $self->setList("Installation", @instructions);
-
-}
-
-#
-# Create a fresh package of $name and $type
-#
-sub fresh {
- my $type = shift;
- my $self = { };
- bless $self, $type;
- my ($provides) = @_;
- my $name;
- $provides =~ m@^([^/]+)[/\\]([^/\.]+)$@;
- $type = $1; $name = $2;
- my $texmf = $TexmfTreeOfType{$type};
- print "Creating new $type $name tpm file\n";
- my $parser = new XML::DOM::Parser;
- chomp (my $user = `whoami`); # for Creator field.
- my $doc = $parser->parse("\
-<!DOCTYPE rdf:RDF SYSTEM \"../../support/tpm.dtd\">\
-<rdf:RDF xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\" xmlns:TPM=\"http://texlive.dante.de/\">\
- <rdf:Description about=\"http://texlive.dante.de/texlive/tlcore/${name}.zip\">\
- <TPM:Name>${name}</TPM:Name>\
- <TPM:Type>${type}</TPM:Type>\
- <TPM:Date>1970/01/01 01:00:00</TPM:Date>\
- <TPM:Version></TPM:Version>\
- <TPM:Creator>$user</TPM:Creator>\
- <TPM:Author></TPM:Author>\
- <TPM:Title>The ${name} package.</TPM:Title>\
- <TPM:Size>314</TPM:Size>\
- <TPM:Description></TPM:Description>\
- <TPM:Build>\
- <TPM:RunPatterns>${texmf}/tpm/${name}.tpm</TPM:RunPatterns>\
- </TPM:Build>\
- <TPM:RunFiles size=\"270\">${texmf}/tpm/${name}.tpm</TPM:RunFiles>\
- <TPM:Provides>${type}/${name}</TPM:Provides>\
- </rdf:Description>\
-</rdf:RDF>\
-");
- $self->initialize($type, $name, $doc);
- return $self;
-}
-
-sub toRDF {
- my ($self) = @_;
- my $parser = new XML::DOM::Parser;
-
- $doc = $parser->parse("<!DOCTYPE rdf:RDF\n\
- SYSTEM \"../../support/tpm.dtd\">\n\
-<rdf:RDF xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns\#\"\n\
- xmlns:TPM=\"http://texlive.dante.de/\">\n</rdf:RDF>\n");
-
- my ($node, $child, $father, $nodelist, %attr);
- # Add an 'about' field
- my $tpmdesc = $doc->createElement("rdf:Description");
-
- my $name = $self->getAttribute("Name");
- my $type = $self->getAttribute("Type");
- if ($name) {
- # Add an about node
- $node = $doc->createAttribute("about", "http://texlive.dante.de/texlive/" . $type . "/" . $name . ".zip");
- # my $tpmhref = $doc->createAttribute("href", $href);
- $tpmdesc->setAttributeNode($node);
- # $tpmdesc->setAttributeNode($tpmhref);
- }
- else {
- warn " toRDF(), no Name found!\n" if (! $name);
- }
-
- for my $tag ("Name", "Type", "Date", "Version", "Creator", "Title",
- "Description", "Author", "Size", "License") {
- my $attribute = $self->getAttribute("$tag");
- # None of these are optional
- $node = $doc->createElement("TPM:$tag");
- $child = $doc->createTextNode($attribute);
- $node->appendChild($child);
- $tpmdesc->appendChild($node);
- warn " toRDF($name), no $tag found\n" if ! $attribute && $::opt_warnings;
- }
-
- # Flags are optional
- $node = $doc->createElement("TPM:Flags");
- %attr = $self->getHash("Flags");
- if (%attr) {
- foreach $key (keys %attr) {
- $child = $doc->createAttribute($key, ${attr}{$key});
- $node->setAttributeNode($child);
- }
- # Only if there are attributes
- $tpmdesc->appendChild($node);
- }
-
- # Globbed expressions
- $father = $doc->createElement("TPM:Build");
-
- for my $tag ("BinPatterns", "RunPatterns", "DocPatterns", "SourcePatterns", "RemotePatterns") {
- $node = $doc->createElement("TPM:$tag");
- $text = $self->getList("$tag");
- if ($text ne "" && $text !~ m/^[\s\n]+$/sx) {
- $child = $doc->createTextNode($text);
- $node->appendChild($child);
- $father->appendChild($node);
- }
- }
-
- $tpmdesc->appendChild($father);
- # End of globbed expressions
-
- my @binfiles = $self->getList("BinFiles");
- if (@binfiles) {
- for (my $i = 0; $i <= $#binfiles; $i++) {
- $node = $doc->createElement("TPM:BinFiles");
- my %archbin = %{$binfiles[$i]};
- my $tpmattr = $doc->createAttribute("arch", $archbin{"arch"});
- $node->setAttributeNode($tpmattr);
- $tpmattr = $doc->createAttribute("size", $archbin{"size"});
- $node->setAttributeNode($tpmattr);
- my @files = @{$archbin{"text"}};
- if (@files) {
- my $strfiles = (join "\n", @files) . "\n";
- $child = $doc->createTextNode($strfiles);
- $node->appendChild($child);
- $tpmdesc->appendChild($node);
- }
- }
- }
-
- for my $tag ("RunFiles", "DocFiles", "SourceFiles", "RemoteFiles") {
- $node = $doc->createElement("TPM:$tag");
- %field = $self->getHash("$tag");
- if (%field) {
- my $tpmattr = $doc->createAttribute("size", $field{"size"});
- $node->setAttributeNode($tpmattr);
- my @files = @{$field{"text"}};
- if (@files) {
- my $strfiles = (join "\n", @files) . "\n";
- $child = $doc->createTextNode($strfiles);
- $node->appendChild($child);
- $tpmdesc->appendChild($node);
- }
- }
- }
-
- $node = $doc->createElement("TPM:Requires");
- my %requires = $self->getHash("Requires");
- if (%requires) {
- foreach my $k (sort @TpmCategories) {
- my @taglist = @{$requires{$k}};
- for my $tag (sort @taglist) {
- my $tpmbin = $doc->createElement("TPM:$k");
- my $a = $doc->createAttribute("name", $tag);
- $tpmbin->setAttributeNode($a);
- $node->appendChild($tpmbin);
- }
- }
- $tpmdesc->appendChild($node);
- }
-
- $node = $doc->createElement("TPM:Installation");
- my @installation = $self->getList("Installation");
- if (@installation) {
- for(my $i = 0 ; $i <= $#installation; $i++) {
- my $tpmexec = $doc->createElement("TPM:Execute");
- my %execute = %{$installation[$i]};
- my $attr = $doc->createAttribute("function", $execute{"function"});
- $tpmexec->setAttributeNode($attr);
- print " kfunc = $execute{function}\n" if ($::opt_debug);
-
- foreach my $kparam (sort keys %execute) {
- print " kparam = $kparam\n" if $::opt_debug;
- if ($kparam ne "function") {
- $attr = $doc->createAttribute($kparam, $execute{$kparam});
- $tpmexec->setAttributeNode($attr);
- }
- }
- $node->appendChild($tpmexec);
- }
- $tpmdesc->appendChild($node);
- }
-
- $node = $doc->createElement("TPM:Provides");
- $text = $self->getAttribute("Provides");
- $text = $name if (! $text);
- if ($text) {
- $child = $doc->createTextNode($text);
- $node->appendChild($child);
- $tpmdesc->appendChild($node);
- }
-
- # Set the fragment
- $doc->getElementsByTagName("rdf:RDF")->item(0)->appendChild($tpmdesc);
-
- return $doc;
-}
-
-sub toString {
- my ($self) = @_;
- return $self->toRDF()->toString();
-}
-
-sub writeFile {
- my ($self, $name) = @_;
- if (! $name) {
- $name = "${MasterDir}/" . $TexmfTreeOfType{$self->getAttribute("Type")} . "/tpm/" . $self->getAttribute("Name") . ".tpm";
- }
- open (OUT, ">$name") || die "open(>$name) failed: $!";
- # rewrite them without ^M
- binmode(OUT) if ($^O =~ /MSWin32/);
- print OUT $self->toString();
- close (OUT) || warn "close(>$name) failed: $!";
-}
-
-sub setAttribute {
- my ($self, $n, $v) = @_;
- $self->{$n} = $v;
-}
-
-sub getAttribute {
- my ($self, $n) = @_;
- return ($self->{$n});
-}
-
-sub setList {
- my ($self, $n, @v) = @_;
- @{$self->{$n}} = @v;
-}
-
-sub getFileList {
- my ($self, $n) = @_;
- my @l = ();
- if ($n eq "BinFiles") {
- foreach $v (@{$self->{$n}}) {
- if (($CurrentArch eq "all" && FileUtils::member(${$v}{"arch"}, @Tpm::ArchList))
- || ${$v}{"arch"} eq ${CurrentArch}) {
- my @val = @{${$v}{"text"}};
- #print "getfilelist pushing for $v: @val\n";
- push @l, @val;
- }
- }
- }
- elsif ($n =~ /^(Run|Doc|Source|Remote)Files$/) {
- my %v = %{$self->{$n}};
- @l = @{$v{"text"}};
- }
- else {
- @l = @{$self->{$n}};
- }
-
- if (wantarray) {
- #print "getfilelist($n) returning list: @l\n";
- #&debug_hash ($n, $self->{$n});
- #print "$n {text} = " . @{$n{text}} . "\n";
- return @l;
- }
- else {
- #print "getfilelist($n) returning scalar: @l\n";
- if (@l) {
- return (join "\n", @l);
- }
- else {
- return "";
- }
- }
-}
-
-# Need to test forcycles !
-sub getRequiredFileList {
- my ($self, $n) = @_;
- my @l = ();
-# print "name = " . $self->getAttribute('Name') . "\n";
- if ($n eq 'all') {
- push @l, $self->getAllFileList();
- }
- else {
- push @l, $self->getFileList($n);
- }
-
- my %requires = $self->getHash("Requires");
- my @reqlist = ();
- foreach my $k (keys %requires) {
- foreach my $e (@{$requires{$k}}) {
- push @reqlist, ${Tpm::TexmfTreeOfType}{$k} . "/tpm/$e.tpm";
- }
- }
- map {
- my $tpm = Tpm->new($_);
- push @l, $tpm->getRequiredFileList($n);
- } @reqlist;
- return @l;
-}
-
-sub getRequiredTpm {
- my ($self, $recursive) = @_;
-
- my %requires = $self->getHash("Requires");
- my @reqlist = ();
- foreach my $k (keys %requires) {
- foreach my $e (@{$requires{$k}}) {
- push @reqlist, "$k/$e";
- }
- }
-
- my @l = ();
-
- if ($recursive) {
- while (@reqlist) {
- my $tpmname = pop @reqlist;
- &FileUtils::push_uniq(\@l, $tpmname);
- my $tpm = Tpm->new($tpmname);
- print "tpmname = $tpmname\n";
- %requires = $tpm->getHash("Requires");
- foreach my $k (keys %requires) {
- foreach my $e (@{$requires{$k}}) {
- &FileUtils::push_uniq(\@reqlist, "$k/$e");
- }
- }
- }
- }
- else {
- @l = @reqlist;
- }
- print $self->getAttribute("Name") . " requires @l\n";
- return @l;
-
-}
-
-sub getList {
- my ($self, $n) = @_;
- my @l = @{$self->{$n}};
- if ($n eq "BinFiles") {
- # the elements of BinFiles are hash references; we want to sort by
- # the arch name, so the output will be stable.
- @l = sort { $a->{"arch"} cmp $b->{"arch"} } @l;
-
- } elsif ($n eq "Installation") {
- # Need these alphabetically, too, e.g.,
- @l = sort tpm_inst_sort @l;
-
- } else {
- @l = sort @l;
- }
-
- if (wantarray) {
- return @l;
- } elsif (@l) {
- return (join "\n", @l);
- } else {
- return "";
- }
-}
-
-# This function is used to sort the TPM:Installation elements for
-# getList. Include both key names and values, e.g.,
-# <TPM:Execute function="addMap" mode="mixed" parameter="cm-super-t1.map"/>
-# <TPM:Execute function="addMap" mode="mixed" parameter="cm-super-x2.map"/>
-# should be sorted in that order.
-#
-sub tpm_inst_sort
-{
- $astr = join (" ", map { $_ . "=" . $a->{$_} } keys %$a);
- $bstr = join (" ", map { $_ . "=" . $b->{$_} } keys %$b);
- return $astr cmp $bstr;
-}
-
-sub setHash {
- my ($self, $n, %v) = @_;
- %{$self->{$n}} = %v;
-}
-
-sub getHash {
- my ($self, $n) = @_;
- return %{$self->{$n}};
-}
-
-sub getPatterns {
- my ($self, $recurse) = @_;
- my @patterns = ();
-
- warn "Doing " . $self->getAttribute("Name") . "\n";
- my $type = $self->getAttribute("Type");
- if ($type =~ m/tlcore/i) {
- # already there
-# push @patterns, $self->getList("RunPatterns");
-# push @patterns, $self->getList("DocPatterns");
-# push @patterns, $self->getList("SourcePatterns");
- }
- elsif ($type =~ m/package/i) {
- $self->buildPatternsPackage();
- # Add them
- push @patterns, $self->getList("RunPatterns");
- push @patterns, $self->getList("DocPatterns");
- push @patterns, $self->getList("SourcePatterns");
-
- $self->setList("RunPatterns", () );
- $self->setList("DocPatterns", () );
- $self->setList("SourcePatterns", () );
-
- }
- elsif ($type =~ m/documentation/i) {
- $self->buildPatternsDocumentation();
- push @patterns, $self->getList("RunPatterns");
- push @patterns, $self->getList("DocPatterns");
- push @patterns, $self->getList("SourcePatterns");
-
- $self->setList("RunPatterns", () );
- $self->setList("DocPatterns", () );
- $self->setList("SourcePatterns", () );
- }
- if ($recurse) {
- my %requires = $self->getHash("Requires");
- my @reqlist = ();
- foreach my $k (keys %requires) {
- foreach my $e (@{$requires{$k}}) {
- push @reqlist, ${Tpm::TexmfTreeOfType}{$k} . "/tpm/$e.tpm";
- }
- }
- map {
- print "testing $_\n";
- if (&FileUtils::member("$_", @patterns)) {
- print "Already done: $_\n";
- }
- else {
- my $tpm = Tpm->new("${MasterDir}/$_");
- push @patterns, $tpm->getPatterns($recurse);
- }
- } @reqlist;
- }
- return @patterns;
-}
-
-sub getFilesFromPatterns {
- my ($self, $n, $recurse) = @_;
- my @patterns = ();
- if ($n eq "BinFiles") {
- if ($CurrentArch eq "all") {
- my @l = $self->getList("BinPatterns");
- my @lgen = ();
- my @lwin32 = ();
- my @lothers = ();
- while (@l) {
- my $f = shift @l;
- if ($f =~ m/\/\$\{ARCH\}\//) {
- push @lgen, $f;
- }
- elsif ($f =~ m/\/win32(-static)?\//) {
- push @lwin32, $f;
- }
- else {
- push @lothers, $f;
- }
- }
-
- foreach my $a (@ArchList) {
- # Skip win32, since they are processed separately anyway
- next if ($a =~ m/^win32(-static)?/);
- my @l = @lgen;
- map { $_ =~ s/\$\{ARCH\}/${a}/sxo } @l;
- push @patterns, @l;
- }
- push @patterns, @lwin32;
- push @patterns, @lothers;
- }
- elsif ($CurrentArch =~ m/win32/) {
- my @l = grep { /\/${CurrentArch}\// } $self->getList("BinPatterns");
- push @patterns, @l;
- }
- else {
- push @patterns, (map {s/\$\{ARCH\}/$CurrentArch/ } $self->getList("BinPatterns"));
- push @patterns, (grep { /\/${CurrentArch}\// } $self->getList("BinPatterns"));
-
- }
- }
- else {
- $n =~ s/Files/Patterns/;
- my @files = $self->getList($n);
- push @patterns, @files;
- }
- my @files = ();
- if (@patterns) {
- @files = ();
- map {
- push @files, $dotfiles{$_};
- $_ = "$MasterDir/" . $_ ;
- } @patterns;
- for my $p (@patterns) {
- push @files, &FileUtils::globexpand ($recurse, $p);
- #print " files after $p: @files\n" if $::opt_debug;
- }
- map { $_ =~ s/^${MasterDir}\///; } @files;
- @files = &FileUtils::sort_uniq(@files);
- }
- return @files;
-}
-
-sub patternsExpand {
- my ($self, $recurse) = @_;
- my (%v, $size);
- my @allbinfiles = $self->getFilesFromPatterns("BinFiles", 0);
- my @files = ();
- my $file_number = $#allbinfiles + 1;
-
- foreach my $a (@ArchList) {
- my @archbinfiles = grep { /\/$a\// } @allbinfiles;
- if (@archbinfiles) {
- $size = &FileUtils::calc_file_size($MasterDir, @archbinfiles);
- my %v = ( );
- $v{"arch"} = $a;
- $v{"size"} = $size;
- push @{$v{"text"}}, @archbinfiles;
- push @files, \%v;
- }
- }
- $self->setList("BinFiles", @files);
- #print "binfiles = @files\n";
-
- for my $tag ("RunFiles", "DocFiles", "SourceFiles", "RemoteFiles") {
- #print ($self->getAttribute("Name") . ", tag $tag\n") if $::opt_debug;
- my %v = ( );
- @files = $self->getFilesFromPatterns($tag, $recurse);
- #print " files = @files\n" if $::opt_debug;
- $file_number += $#files + 1;
- $size = &FileUtils::calc_file_size($MasterDir, @files);
- $v{"arch"} = $a;
- $v{"size"} = $size;
- @{$v{"text"}} = @files;
- $self->setHash($tag, %v);
- }
-
- if ($file_number == 1) {
- # No need to complain about the collection tpm's,
- # they aren't intended to have files.
- my $name = $self->getAttribute("Provides");
- print "Package $name has no files !\n"
- unless $name =~ m!/(collection-*|scheme-*|xemtex|texlive)!;
- }
-}
-
-sub compress_bin {
- my (@files) = @_;
- my @result = ();
- # Compute architectures list without win32
- my @al = @ArchList;
- @al = grep { $_ !~ m at win32(-static)?@ } @al;
-
- # Process patterns one by one
- while (@files) {
- # First file in the list
- my $f = $files[0];
-
- # If it is a win32 file, nothing to do
- if ($f =~ m@/win32(-static)?/@) {
- push @result, $f;
- shift @files;
- next;
- }
- # Else, try to match an architecture in its path
- my $re = $f;
- my $a; # Keep the architecture that matched
- for my $arch (@al) {
- # Replace the architecture by a catch all pattern
- if ($re =~ s@/(${arch})/@/[^\/]*/@x) {
- $re = "^${re}\$";
- $a = $1; last;
- }
- }
- # Because of bg5+latex
- $re =~ s/\+/\\\+/;
-
- # Compute how many files in the list will match this pattern
- my @match = grep {$_ =~ m@${re}@ } @files;
- # If all the architectures are present, then do the replacement
- if (@match == @al) {
- @files = grep { $_ !~ m@${re}@ } @files;
- $f =~ s@/${a}/@/\${ARCH}/@;
- }
- else {
- shift @files;
- }
- push @result, $f;
- }
-
- return @result;
-}
-
-sub patternsUpdate {
- my ($self) = @_;
-
- my @patterns = &compress_bin(&FileUtils::regexpify(0, $MasterDir, $self->getFileList("BinFiles")));
- $self->setList("BinPatterns", @patterns);
- @patterns = &FileUtils::regexpify(0, $MasterDir, $self->getFileList("DocFiles"));
- $self->setList("DocPatterns", @patterns);
- @patterns = &FileUtils::regexpify(0, $MasterDir, $self->getFileList("RunFiles"));
- $self->setList("RunPatterns", @patterns);
- @patterns = &FileUtils::regexpify(0, $MasterDir, $self->getFileList("SourceFiles"));
- $self->setList("SourcePatterns", @patterns);
- @patterns = &FileUtils::regexpify(0, $MasterDir, $self->getFileList("RemoteFiles"));
- $self->setList("RemotePatterns", @patterns);
-}
-
-sub testSync {
- my ($self) = @_;
-
- my @files_from_patterns = () ;
- push @files_from_patterns, $self->getFilesFromPatterns("BinFiles");
- push @files_from_patterns, $self->getFilesFromPatterns("RunFiles");
- push @files_from_patterns, $self->getFilesFromPatterns("DocFiles");
- push @files_from_patterns, $self->getFilesFromPatterns("SourceFiles");
- push @files_from_patterns, $self->getFilesFromPatterns("RemoteFiles");
-
- my @files = ();
- push @files, $self->getFileList("BinFiles");
- push @files, $self->getFileList("RunFiles");
- push @files, $self->getFileList("DocFiles");
- push @files, $self->getFileList("SourceFiles");
- push @files, $self->getFileList("RemoteFiles");
- my @l1 = ();
- my @l2 = ();
- &FileUtils::diff_list(@files_from_patterns, @files, \@l1, \@l2);
- if ($#l1 < 0 && $#l2 < 0) {
- return 1;
- }
- else {
- print $self->getAttribute("Name") . ": patterns and file lists not in sync\n";
- print "Files in patterns not in lists :\n";
- map { print "$_\n"; } @l1;
- print "Files in lists not in patterns :\n";
- map { print "$_\n"; } @l2;
- return 0;
- }
-}
-
-
-sub formatdate {
- return sprintf("%4d/%02d/%02d %02d:%02d:%02d",
- $_[5]+1900, $_[4]+1, $_[3], $_[2], $_[1], $_[0]);
-}
-
-sub printdate {
- my ($strDate) = @_;
- my @mytime;
- my ($s, $strTime);
-
- ($strDate, $strTime) = split " ", $strDate;
- # print "strDate = $strDate; strTime = $strTime\n";
- if ($strDate =~ m@(\d\d\d\d|\d\d)/(\d\d)/(\d\d)@) {
- $mytime[5] = eval $1;
- $mytime[4] = eval $2;
- $mytime[3] = eval $3;
- if ($strTime =~ m@(\d\d):(\d\d):(\d\d)@) {
- $mytime[2] = eval $1;
- $mytime[1] = eval $2;
- $mytime[0] = eval $3;
- }
- $mytime[5] -= 1900 if ($mytime[5] > 1900);
- $mytime[4] -= 1;
- }
- else {
- @mytime = gmtime;
- }
-
- return &formatdate(@mytime);
-}
-
-sub debug_date
-{
- my ($str,$date) = @_;
- #warn "$str " . &formatdate(gmtime($date)) . "\n";
-}
-
-# if any of FILES are newer than OLDDATE, return the newest mtime.
-#
-sub max_date
-{
- my ($olddate, @files) = @_;
- my $tpmdate = 0;
- &debug_date (" max_date files=@files, olddate=", $olddate);
- for my $f (@files) {
- # although the texmf/tpm/*.tpm files are mostly hand-maintained, it
- # still seems best for the TPM:Date to reflect the newest date of
- # the actual files in the package; the sizes and such might still
- # get autoupdated.
- if ($f =~ m,/tpm/.*\.tpm$,) {
- $tpmdate = (stat("$MasterDir/$f"))[9];
- &debug_date (" tpm itself, found ", $tpmdate);
- }
- elsif (-f "$MasterDir/$f") {
- my @st = stat("$MasterDir/$f");
- &debug_date (" file $f is ", $st[9]);
- if ($st[9] > $olddate) {
- &debug_date (" replacing olddate ", $olddate);
- $olddate = $st[9];
- }
- }
- }
- if ($olddate == 0 && $tpmdate) {
- &debug_date (" max_date using tpm date", $tpmdate);
- $olddate = $tpmdate;
- }
- &debug_date (" max_date returning ", $olddate);
- return $olddate;
-}
-
-sub fixDate {
- my ($self) = @_;
- my $newdate = 0;
- my @binfiles = $self->getFileList("BinFiles");
- #warn "binfiles=@binfiles";
- if ($CurrentArch ne "all") {
- @binfiles = grep { m@/${CurrentArch}/@ } @binfiles;
- warn "arch-filtered for $CurrentArch binfiles=@binfiles";
- }
- $newdate = &max_date($newdate, @binfiles);
- &debug_date (" newdate after bin: ", $newdate);
- #
- $newdate = &max_date($newdate, $self->getFileList("DocFiles"));
- &debug_date (" newdate after doc: ", $newdate);
- #
- $newdate = &max_date($newdate, $self->getFileList("SourceFiles"));
- &debug_date (" newdate after source: " , $newdate);
- #
- $newdate = &max_date($newdate, $self->getFileList("RemoteFiles"));
- &debug_date (" newdate after remote: " , $newdate);
- #
- # Check the RunFiles last, because it includes the tpm itself, and we
- # only want to use that as a last resort.
- $rundate = &max_date($newdate, $self->getFileList("RunFiles"));
- &debug_date (" newdate after run: ", $newdate);
- $self->setAttribute("Date", &formatdate(gmtime($newdate)));
-}
-
-
-sub fixRequires {
- my ($self, $test) = @_;
-
- my %requires = $self->getHash("Requires");
- if (%requires) {
- foreach my $k (@TpmCategories) {
- my @taglist = @{$requires{$k}};
- my $texmf = $TexmfTreeOfType{$k};
- my @newtaglist = ( );
- for my $tag (@taglist) {
- if (-f "${MasterDir}/${texmf}/tpm/${tag}.tpm") {
- push @newtaglist, $tag;
- }
- elsif ($test == 0) {
- print "Requirement ${MasterDir}/${texmf}/tpm/${tag}.tpm is not found.\n";
- }
- }
-# @{$requires{$k}} = @newtaglist;
- }
-# if ($test >= 1) {
-# $self->setHash("Requires",%requires);
-# }
- }
-}
-#
-# This function will print every text node under given nodes
-# and catenate the result.
-#
-sub myToText {
- my (@nodes) = @_;
- return
- join '', ( map {
- if ($_->isTextNode) {
- my $s =$_->toString; chomp($s); $s;
- }
- else {
- if ($_->hasChildNodes) {
- myToText($_->getChildNodes) . " ";
- }
- else {
- '';
- }
- }
- } @nodes ) ;
-}
-
-sub trim {
- my ($str) = @_;
- $str =~ s/^[\n\s]+//;
- $str =~ s/[\n\s]+$//;
- return $str;
-}
-
-#
-# Look into the Catalogue to find any supplementary information
-# Get the license information, version and release numbers
-#
-sub completeUsingCatalogue {
- my ($self) = @_;
- my($author, $version, $license, $title, $description);
-
- my $pkgname = $self->getAttribute("Name");
- $pkgname =~ s/^(bin-|lib-|tex-)//;
-
- # handle several cases where the Catalogue name
- # is not the package name...
- if (defined($Tpm2Catalogue{$pkgname})) {
- $pkgcat = $Tpm2Catalogue{$pkgname};
- } else {
- $pkgcat = $pkgname;
- }print STDERR "Looking for $pkgname (as $pkgcat) in the Catalogue.\n" if $Verbose;
- my $fletter = substr($pkgcat, 0, 1);
- my $catname = "${CatalogueDir}/entries/$fletter/${pkgcat}.xml";
- return if (! -f $catname);
-# print "catname = $catname\n";
- my $parser = new XML::DOM::Parser;
- my $catdoc = $parser->parsefile($catname);
-
- my $nodelist = $catdoc->getElementsByTagName("author");
- $author = '';
- for (my $i = 0; $i < $nodelist->getLength; $i++) {
- if ($nodelist->item($i)->getElementsByTagName("name")->item(0)->getFirstChild) {
- $author .= ($i == 0 ? "" : " and ") . $nodelist->item($i)->getElementsByTagName("name")->item(0)->getFirstChild->toString;
- }
- }
-# print "author = $author \n";
- $nodelist = $catdoc->getElementsByTagName("version")->item(0);
- if ($nodelist && $nodelist->getElementsByTagName("number")->item(0)) {
- $version = $nodelist->getElementsByTagName("number")->item(0)->getFirstChild;
- if ($version) {
- $version = $version->toString;
-# print "version = $version\n";
- }
- }
- my $node = $catdoc->getElementsByTagName("license")->item(0);
- if ($node) {
- $license = $node->getAttribute("type");
- }
- $node = $catdoc->getElementsByTagName("caption")->item(0);
- if ($node) {
- $title = &trim($node->getFirstChild->toString);
- }
-
- $node = $catdoc->getElementsByTagName("description")->item(0);
- if ($node) {
- my $abstract = $node->getElementsByTagName("abstract")->item(0);
- $node = $abstract if ($abstract);
- $description = myToText( $node );
-# $description = join '', (map { ($_->isTextNode ? $_->toString : '') } $node->getChildNodes);
- $description = &trim($node->expandEntityRefs($description));
-# print "description = |$description|\n";
- }
- my $old_author = &trim($self->getAttribute("Author"));
- my $old_version = &trim($self->getAttribute("Version"));
- my $old_title = &trim($self->getAttribute("Title"));
- my $old_description = &trim($self->getAttribute("Description"));
- my $old_license = &trim($self->getAttribute("License"));
-
- if ($author && $author ne $old_author) {
- $self->setAttribute("Author", $author);
- print "Replacing $old_author by $author\n";
- }
- if ($version && $version ne $old_version) {
- $self->setAttribute("Version", $version);
- print "Replacing $old_version by $version\n";
- }
- if ($title && $title ne $old_title) {
- $self->setAttribute("Title", $title);
- print "Replacing $old_title by $title\n";
- }
- if ($description && ($description ne $old_description)) {
- $self->setAttribute("Description", $description);
- print "Replacing $old_description by $description\n";
- }
- if ($license && ($license ne $old_license)) {
- $self->setAttribute("License", $license);
- print "Replacing $old_license by $license\n";
- }
-}
-
-sub buildPatternsPackage {
- my ($self) = @_;
-
- my $type = $self->getAttribute("Type");
- return unless $type eq 'Package';
-
- my $name = $self->getAttribute("Name");
- my $texmf = $TexmfTreeOfType{$type};
-
- # set run patterns
- my @run_patterns = ( );
- my @doc_patterns = ( );
- my @source_patterns = ( );
-
- #
- # Usually the package name and the directory name match.
- # Here are the special cases when they don't.
- if (&FileUtils::member(${name}, @engines)) {
- print "special engine patterns for $name\n" if $::opt_debug;
- # If our $name is one of the engines
- push @run_patterns, (
- $texmf . "/${name}/base/*",
- $texmf . "/${name}/data/*", # for context
- $texmf . "/${name}/misc/*",
- $texmf . "/${name}/config/*",
- $texmf . "/metapost/${name}/*", # also for context
- $texmf . "/tex/${name}/*"
- );
- push @doc_patterns, ( $texmf . "/doc/${name}/base/*" );
- push @source_patterns, ( $texmf . "/source/${name}/base/*" );
- # Shouldn't we chose between the previous patterns
- # and these ones?
- map {
- push @run_patterns, $texmf . "/tex/$_/${name}/*";
- push @doc_patterns, ( $texmf . "/doc/$_/${name}/*" );
- push @source_patterns, ( $texmf . "/source/$_/${name}/*" );
- } @formats;
-
- # Exception for dvips and ttf2pk !
- if (${name} eq 'dvips' || ${name} eq 'ttf2pk') {
- push @run_patterns,
- ( $texmf . "/fonts/map/${name}/base/*", $texmf . "/fonts/map/${name}/config/*",
- $texmf . "/fonts/enc/${name}/base/*", $texmf . "/fonts/enc/${name}/config/*" );
-
- # exception for context doc, since everything belongs to context.tpm.
- } elsif (${name} eq 'context') {
- push (@doc_patterns, "$texmf/doc/context/*");
-
- # Exception for metapost !
- } elsif (${name} eq 'metapost') {
- push @run_patterns, $texmf . "/metapost/support/*";
-
- # Exception for tex4ht, since we just want everything.
- } elsif (${name} eq 'tex4ht') {
- push @run_patterns,
- ("$texmf/tex4ht/bin/*",
- "$texmf/tex4ht/ht-fonts/*",
- "$texmf/tex4ht/xttl/*",
- );
-
- # Exception for omega !
- } elsif (${name} eq 'omega') {
- push @run_patterns,
- ( $texmf . "/tex/generic/encodings/*",
- $texmf . "/tex/generic/omegahyph/*",
- $texmf . "/omega/otp/char2uni/*",
- $texmf . "/omega/otp/uni2char/*",
- $texmf . "/omega/ocp/char2uni/*",
- $texmf . "/omega/ocp/uni2char/*" );
-
- # Exception for vtex -- extra map files.
- } if (${name} eq 'vtex') {
- push @run_patterns, $texmf . "/fonts/map/${name}/*";
-
- }
-
- #
- } elsif (&FileUtils::member(${name}, @formats)) {
- print "special format patterns for $name\n" if $::opt_debug;
- # if our $name is one of the formats
- map {
- my $e = $_;
- push @run_patterns, ( $texmf . "/$e/${name}/base/*",
- $texmf . "/$e/${name}/config/*",
- );
- push @run_patterns, $texmf . "/$e/${name}/*"
- unless ($_ eq 'tex' || $_ eq 'omega')
- } @engines;
-
- map {
- push @run_patterns, $texmf . "/tex/$_/${name}/*";
- } @formats;
-
- # for xetex
- push @run_patterns, "$texmf/fonts/misc/$name/*";
- push @doc_patterns, ( $texmf . "/doc/$name/*" ) if $name eq "xetex";
-
- push @doc_patterns, ( $texmf . "/doc/${name}/base/*" );
-
- push @source_patterns, ( $texmf . "/source/${name}/base/*" );
-
- # exception for texinfo since it has no subdirs.
- if (${name} eq 'texinfo') {
- push @run_patterns, $texmf . "/tex/texinfo/*";
-
- # exception for eplain since it has no subdirs either.
- } elsif (${name} eq 'eplain') {
- push @run_patterns, "$texmf/tex/eplain/*";
- push @doc_patterns, "$texmf/doc/eplain/*";
- push @source_patterns, "$texmf/source/eplain/*";
-
- # Exception for fontinst, since it has lots of subdirs, including misc.
- # cyrfinst is really a separate package, but let's not clean that up now.
- } elsif (${name} eq 'fontinst') {
- push @run_patterns, $texmf . "/tex/fontinst/*/*";
- }
-
- #
- } elsif (&FileUtils::member(${name}, @vendors)) {
- print "special vendor patterns for $name\n" if $::opt_debug;
- push @run_patterns, $texmf . "/dvips/${name}/*";
-
- if ($name eq "groff") {
- # Exception for groff: we do not want subdirectories (e.g.,
- # times), we only want actual files (psyrgo.tfm). Let groff/times
- # end up in times.tpm.
- map { push @run_patterns, "$texmf/fonts/$_/${name}/*.*"; }
- @fonttypes;
- } else {
- # Everything but groff:
- map { push @run_patterns, "$texmf/fonts/$_/${name}/*"; }
- @fonttypes;
- }
-
- map {
- my $e = $_;
- map {
- push @run_patterns, $texmf . "/$e/$_/${name}/*"
- # keep fontinst/misc in fontinst:
- unless ($name eq "misc" && $_ eq "fontinst");
- } @formats;
- } @engines;
-
- # Exception for lh: also have source/latex/lh.
- push @source_patterns, ( $texmf . "/source/latex/$name/*" ); # lh
-
- # Exception for mathdesign: doc is in doc/latex instead of doc/fonts.
- push @doc_patterns, ( $texmf . "/doc/latex/$name/*" ); # mathdesign
-
- # Exception for vntex: doc is in doc/generic instead of doc/fonts.
- push @doc_patterns, ( $texmf . "/doc/generic/$name/*" ); # vntex
-
- #
- } else {
- print "normal patterns for $name\n" if $::opt_debug;
- map {
- my $e = $_;
- push @run_patterns, $texmf . "/$e/${name}/*";
- push @doc_patterns, $texmf . "/doc/$e/${name}/*";
- push @source_patterns, $texmf . "/source/$e/${name}/*";
- map {
- push @run_patterns, $texmf . "/$e/$_/${name}/*"
- # keep tex/context/pgf in context.
- unless $name eq "pgf" && $_ eq "context" && $e eq "tex";
- } @formats;
- #warn "run_patterns after engine $e = @run_patterns\n";
- } @engines;
-
- map {
- push @run_patterns, $texmf . "/tex/$_/${name}/*"
- # keep tex/context/pgf in context.
- unless $name eq "pgf" && $_ eq "context";
- #warn "run_patterns after format $_ = @run_patterns\n";
-
- push @doc_patterns, $texmf . "/doc/$_/${name}/*";
- push @source_patterns, $texmf . "/source/$_/${name}/*";
- } @formats;
-
- push @doc_patterns, $texmf . "/doc/${name}/*";
- push @source_patterns, $texmf . "/source/${name}/*";
-
- # Exceptions for fontname and glyphlist: their own odd map files.
- if ($name eq 'fontname') {
- push @run_patterns, "$texmf/fonts/map/${name}/*";
- } elsif ($name eq 'glyphlist') {
- push @run_patterns, "$texmf/fonts/map/${name}/*";
- }
- }
-
- # common to all.
- map {
- my $v = $_;
- map {
- push @run_patterns, $texmf . "/fonts/$_/$v/${name}/*";
- } @fonttypes;
- map {
- push @run_patterns, $texmf . "/fonts/pk/$_/$v/${name}/*";
- } @fontmodes;
- } @vendors;
-
- push @run_patterns, $texmf . "/scripts/${name}/*";
- push @run_patterns, $texmf . "/dvips/${name}/*";
-
- my $bibe = (${name} eq 'bibtex' ? 'base' : ${name});
- push @run_patterns,
- ( $texmf . "/bibtex/bib/${bibe}/*",
- $texmf . "/bibtex/bst/${bibe}/*",
- $texmf . "/bibtex/csf/${bibe}/*" );
-
- push @run_patterns,
- ( $texmf . "/fonts/map/dvips/${name}/*",
- $texmf . "/fonts/map/dvipdfm/${name}/*",
- $texmf . "/fonts/map/pdftex/${name}/*",
- $texmf . "/fonts/map/ttf2pk/${name}/*",
- $texmf . "/fonts/enc/dvips/${name}/*",
- $texmf . "/fonts/enc/dvipdfm/${name}/*",
- $texmf . "/fonts/enc/pdftex/${name}/*",
- $texmf . "/fonts/enc/ttf2pk/${name}/*" );
-
- push @run_patterns, "usergrps/$name/*";
-
- push @doc_patterns, $texmf . "/doc/fonts/${name}/*";
-
- push @run_patterns, $texmf . "/omega/ocp/${name}/*";
- push @run_patterns, $texmf . "/omega/otp/${name}/*";
-
- push @source_patterns, $texmf . "/source/fonts/${name}/*";
- push @run_patterns, $texmf. "/tpm/$name.tpm";
-
- #warn "final run_patterns for $name: @run_patterns\n";
- $self->setList("RunPatterns", @run_patterns);
- $self->setList("DocPatterns", @doc_patterns);
- $self->setList("SourcePatterns", @source_patterns);
-}
-
-
-sub autoPatternsCore {
- my ($self) = @_;
-
- return if ($self->getAttribute("Type") ne 'TLCore');
- my $type = $self->getAttribute("Type");
- my $name = $self->getAttribute("Name");
- my $texmf = $TexmfTreeOfType{$type};
-
-}
-
-sub buildPatternsDocumentation {
- my ($self) = @_;
-
- return if ($self->getAttribute("Type") ne 'Documentation');
- my $type = $self->getAttribute("Type");
- my $name = $self->getAttribute("Name");
- my $texmf = $TexmfTreeOfType{$type};
-
- # set run patterns
- my @run_patterns = ( );
- my @doc_patterns = ( );
- my @source_patterns = ( );
-
- map {
- push @doc_patterns, $texmf . "/doc/$_/${name}/*";
- push @source_patterns, $texmf . "/source/$_/${name}/*";
- } @languages;
-
- push @run_patterns, $texmf. "/tpm/$name.tpm";
-
- $self->setList("RunPatterns", @run_patterns);
- $self->setList("DocPatterns", @doc_patterns);
- $self->setList("SourcePatterns", @source_patterns);
-
-}
-
-sub autoPatternsPackage {
- my ($self) = @_;
-
- # map { print "$_\n"; } @run_patterns;
- # map { print "$_\n"; } @doc_patterns;
- # map { print "$_\n"; } @source_patterns;
-
- $self->buildPatternsPackage();
- $self->patternsExpand(1);
-
- $self->setList("RunPatterns", () );
- $self->setList("DocPatterns", () );
- $self->setList("SourcePatterns", () );
-}
-
-sub autoPatternsDocumentation {
- my ($self) = @_;
-
- $self->buildPatternsDocumentation();
- $self->patternsExpand(1);
-
- $self->setList("RunPatterns", () );
- $self->setList("DocPatterns", () );
- $self->setList("SourcePatterns", () );
-}
-
-sub patternsAuto {
- my ($self) = @_;
- my $type = $self->getAttribute("Type");
- if ($type =~ m/tlcore/i) {
- $self->autoPatternsCore();
- }
- elsif ($type =~ m/package/i) {
- $self->autoPatternsPackage();
- }
- elsif ($type =~ m/documentation/i) {
- $self->autoPatternsDocumentation();
- }
-}
-
-#
-# Get all files, optionnaly only for architecture $arch
-#
-sub getAllFileList {
- my ($self, $arch) = @_;
- my @files = ();
-# print "Getting all file list for " . $self->getAttribute("Name") . "\n";
- ($arch = $CurrentArch) if (undef $arch);
-
- push @files, $self->getFileList("BinFiles");
- push @files, $self->getFileList("RunFiles");
- push @files, $self->getFileList("DocFiles");
- push @files, $self->getFileList("SourceFiles");
- push @files, $self->getFileList("RemoteFiles");
-
- return @files;
-}
-
-sub fixSize {
- my ($self, $arch) = @_;
- my $size = 0;
- my @files = $self->getList("BinFiles");
-
- foreach my $f (@files) {
- $size += ${$f}{"size"};
- }
-
- foreach my $tag ("RunFiles", "DocFiles", "SourceFiles", "RemoteFiles") {
- my %v = $self->getHash("$tag");
- $size += $v{"size"};
- }
- if ($size != $self->getAttribute("Size")) {
- my $name = $self->getAttribute("Name");
- my $old_size = $self->getAttribute("Size");
- print " $name\t size=$size\t old size=$old_size\t diff="
- . ($size - $old_size) . "\n";
- $self->setAttribute("Size", $size);
- }
- return $size;
-}
-
-sub Tpm2Zip {
- my ($self, $destdir, $full, $standalone) = @_;
- if (! $destdir) {
- $destdir = $ZipDir;
- }
- my $name = $self->getAttribute("Name");
- my $type = $self->getAttribute("Type");
- my $version = $self->getAttribute("Version");
-
- my @files = ();
- if ($full eq "full") {
- push @files, $self->getRequiredFileList("RunFiles");
- push @files, $self->getRequiredFileList("DocFiles");
- push @files, $self->getRequiredFileList("SourceFiles");
- }
- else {
- push @files, $self->getFileList("RunFiles");
- push @files, $self->getFileList("DocFiles");
- push @files, $self->getFileList("SourceFiles");
- }
-
- my ($zipname, $tpmname, $zipcmd, $nul);
-
- # Create zip files for all $arch if type = binary
-
- # First, common files
- if ($#files >=0) {
-
-# if ($name =~ m/-static$/) {
- if ($standalone && &FileUtils::member("$type/$name", @StandAlonePackages)) {
- # static packages are expected to have more complete names
- if ($full eq "full") {
- push @files, $self->getRequiredFileList("BinFiles");
- } else {
- push @files, $self->getFileList("BinFiles");
- }
- $zipname = "$destdir/../standalone/$name";
- $zipname .= "-${version}-${CurrentArch}.zip";
- }
- else {
- $tpmname = "$destdir/$type/$name.tpm";
- $zipname = "$destdir/$type/$name.zip";
- }
- if ($^O =~ /MSWin32/) {
- $nul = "nul";
- }
- else {
- $nul = "/dev/null";
- }
- @files = &FileUtils::sort_uniq(@files);
-
- if ($zipname =~ /\/binary/ && $^O !~ /MSWin32/) {
- $zipcmd = "| zip -9\@ory "
- }
- else {
- $zipcmd = "| zip -9\@or "
- }
-
- &mkpath(&FileUtils::dirname($zipname)) if (! -d &FileUtils::dirname($zipname));
- my $cwd = &getcwd;
- chdir($MasterDir);
- unlink $zipname;
- print $zipcmd . $zipname . " > $nul\n" if ($::opt_debug);
- open ZIP, $zipcmd . $zipname . " > $nul";
- map {
- if (! -f $_) {
- print STDERR "!!!Error: non-existent $_\n";
- } else {
- print ZIP "$_\n";
- }
- } @files;
- close ZIP;
- print "Done $zipname\n" if ($::opt_debug);
- }
-
- if (! $standalone) {
- # Binaries
- my $DoCurrentArch = ${CurrentArch};
- foreach my $arch (@{ArchList}) {
- if (${DoCurrentArch} eq "all" || ${DoCurrentArch} eq ${arch}) {
- ${CurrentArch} = $arch;
- my @binfiles;
- if ($full eq "full") {
- @binfiles = $self->getRequiredFileList("BinFiles");
- }
- else {
- @binfiles = $self->getFileList("BinFiles");
- }
- $zipname = "$destdir/$type/$name-$arch.zip";
-
- if ($#binfiles >=0) {
- &mkpath(&FileUtils::dirname($zipname)) if (! -d &FileUtils::dirname($zipname));
- my $cwd = &getcwd;
- chdir($MasterDir);
- unlink $zipname;
- print $zipcmd . $zipname . " > $nul\n" if ($::opt_debug);
- open ZIP, $zipcmd . $zipname . " > $nul";
- map {
- if (! -f $_) {
- print STDERR "!!!Error: non-existent $_\n";
- } else {
- print ZIP "$_\n";
- }
- } @binfiles;
- close ZIP;
- print "Done $zipname\n" if ($::opt_debug);
- }
- }
- }
- ${CurrentArch} = ${DoCurrentArch};
- }
-
- # Write the tpm file together with the zip file in the current scheme
- $self->writeFile($tpmname) if ($tpmname);
- chdir($cwd);
-
-}
-
-sub Clean {
- my ($self, $patterns, $fixreq) = @_;
-
- # Update the Date to the date of the latest file in the package
- $self->fixDate();
-
- # Find missing information in the Catalogue if possible
- $self->completeUsingCatalogue();
-
- # Compute the overall size
- $self->fixSize();
-
- # Fix the tpm file
- my @run_patterns = $self->getList("RunPatterns");
-
- # First remove all tpm file present in the package
- #print "run_patterns before remove_list = @run_patterns\n";
- &FileUtils::remove_list(\@run_patterns, "\.tpm\$");
- #print "run_patterns after remove_list = @run_patterns\n";
-
- # Second, add the right one
- my $name = $self->getAttribute("Name");
- my $type = $self->getAttribute("Type");
- push @run_patterns, ${Tpm::TexmfTreeOfType}{$type} . "/tpm/$name.tpm";
- $self->setList("RunPatterns", @run_patterns);
-
- # Fix the Title
- if (! $self->getAttribute("Title")) {
- $self->setAttribute("Title", "The " . $self->getAttribute("Name") . " package.");
- }
-
- # Big step, get fiels from patterns.
- if ($patterns eq 'auto') {
- $self->patternsAuto();
- } elsif ($patterns eq 'to') {
- # Update patterns
- $self->patternsUpdate();
- } elsif ($patterns eq 'from') {
- $self->patternsExpand(0);
- }
-
- # Fix Requires field
- $self->fixRequires(undef $fixreq || $fixreq == 0 || $fixreq eq '' ? 0 : 1);
-
- $self->setList("RunPatterns", &FileUtils::sort_uniq($self->getList("RunPatterns")));
- $self->setList("DocPatterns", &FileUtils::sort_uniq($self->getList("DocPatterns")));
- $self->setList("SourcePatterns", &FileUtils::sort_uniq($self->getList("SourcePatterns")));
-
- # Alternatively you could expand patterns if for example you have just edited them
- # See the 'process2_tpm' function below
- # Test that patterns and files list are n sync
- if ($self->testSync()) {
- print "Writing $type/$name\n";
- $self->writeFile();
- }
- else {
- print "ERROR: out of sync between patterns and files in $tpmname (not written).\n";
- }
-}
-
-
-sub Remove {
- my ($self, $patterns, $dry) = @_;
- my @run_patterns = $self->getList("RunPatterns");
- # First remove all tpm file present in the package
- # print "run_patterns = @run_patterns\n";
- &FileUtils::remove_list(\@run_patterns, "\.tpm\$");
- # print "run_patterns = @run_patterns\n";
- # Second, add the right one
- my $name = $self->getAttribute("Name");
- my $type = $self->getAttribute("Type");
- push @run_patterns, ${Tpm::TexmfTreeOfType}{$type} . "/tpm/$name.tpm";
- $self->setList("RunPatterns", @run_patterns);
- if ($patterns eq 'auto') {
- $self->patternsAuto();
- }
- elsif ($patterns eq 'to') {
- # Update patterns
- $self->patternsUpdate();
- }
- elsif ($patterns eq 'from') {
- $self->patternsExpand(0);
- }
- $self->setList("RunPatterns", &FileUtils::sort_uniq($self->getList("RunPatterns")));
- $self->setList("DocPatterns", &FileUtils::sort_uniq($self->getList("DocPatterns")));
- $self->setList("SourcePatterns", &FileUtils::sort_uniq($self->getList("SourcePatterns")));
-
- map {
- my $file = "${MasterDir}/$_";
- if ($dry) {
- print "would unlink $file\n";
- } else {
- unlink($file) || warn "unlink($file) failed: $!";
- print "unlinked $file\n";
- }
- } $self->getAllFileList();
-}
-
-
-# Log LABEL followed by hash elements, all on one line.
-#
-sub debug_hash
-{
- my ($label) = shift;
- my (%hash) = (ref $_[0] && $_[0] =~ /.*HASH.*/) ? %{$_[0]} : @_;
-
- my $str = "$label: {";
- my @items = ();
- for my $key (sort keys %hash) {
- my $val = $hash{$key};
- $key =~ s/\n/\\n/g;
- $val =~ s/\n/\\n/g;
- push (@items, "$key:$val");
- }
- $str .= join (",", @items);
- $str .= "}";
-
- print "$str\n";
-}
-
-1;
Deleted: tex-common/branches/v3/scripts/tpm2licenses
===================================================================
--- tex-common/branches/v3/scripts/tpm2licenses 2012-03-10 03:16:23 UTC (rev 5200)
+++ tex-common/branches/v3/scripts/tpm2licenses 2012-03-10 03:19:21 UTC (rev 5201)
@@ -1,459 +0,0 @@
-#!/usr/bin/perl -w
-#
-# tpm2licenses.pl
-# (c) 2005-2006 Norbert Preining
-# (c) 2006 Frank Küster
-#
-# Lists for every filename.tpm the license as specified in the catalogue
-#
-# usage:
-# perl tpm2licenses.pl <options> [tpm file]
-# where <options> =
-# --catalogue
-# --nocheckcatalogue
-# --tpmdir
-# --package
-# --listallfiles
-# --nocoverage
-# --nosourcefiles
-# optional tpm file: check only that one
-#
-
-BEGIN { # get our other local perl modules.
- ($mydir = $0) =~ s,/[^/]*$,,;
- if ($mydir eq $0) { $mydir = `pwd` ; chomp($mydir); }
- if (!($mydir =~ m,/.*,,)) { $mmydir = `pwd`; chomp($mmydir); $mydir = "$mmydir/$mydir" ; }
- unshift (@INC, $mydir);
-# unshift (@INC, "$mydir/..");
-}
-
-use strict;
-use Data::Dumper;
-#use Getopt::Long;
-use File::Basename;
-use File::Copy;
-use File::Path;
-use File::Temp qw/ tempfile tempdir /;
-use AppConfig;
-#use XML::DOM;
-use Cwd;
-#use FileUtils qw(canon_dir cleandir make_link newpath member
-# normalize substitute_var_val dirname diff_list remove_list
-# rec_rmdir sync_dir walk_dir start_redirection stop_redirection);
-#use Tpm;
-
-
-# initialize AppConfig
-my $config = AppConfig->new("catalogue=s", "nocheckcatalogue", "tpmdir=s", "package=s", "what=s", "listallfiles", "texmfPath=s", "nocoverage", "nosourcefiles");
-
-# parse configurationfile, if present
-my @cfgDirs = (".","./debian","..","~");
-my $cfgName = ".tpm2license.cfg";
-
-for my $cfgDir (@cfgDirs) {
- if ( -r "$cfgDir/$cfgName" ) {
- print STDERR "Using configuration file $cfgDir/$cfgName\n";
- $config->file("$cfgDir/$cfgName");
- };
- };
-# now parse commandline
-$config->getopt();
-
-# assign conffile, commandline or default values:
-my $Catalogue = $config->catalogue() ? $config->catalogue() : "/src/TeX/texcatalogue/" ;
-my $what = $config->what() ? $config->what() : "files";
-my $debian_package = $config->package() ? $config->package() : "tetex-base";
-my $tpmdir = $config->tpmdir() ? $config->tpmdir() : "./debian/tpm";
-my $nocatalogue = $config->nocheckcatalogue() ? $config->nocheckcatalogue() : '';
-my $listallfiles = $config->listallfiles() ? 1 : 0;
-my $texmfPathString = $config->texmfPath() ? $config->texmfPath() : ".";
-my @texmfPath = split ' ', $texmfPathString;
-my $nocoverage = $config->nocoverage() ? $config->nocoverage() : '';
-my $nosourcefiles = $config->nosourcefiles() ? 1 : 0;
-
-if ($debian_package) {
- die "Unknown Debian package: $debian_package." unless
- ( $debian_package =~ /^tetex-base$/ ||
- $debian_package =~ /^tetex-src$/ ||
- $debian_package =~ /^texlive$/ ||
- $debian_package =~ /^texlive-base$/ ||
- $debian_package =~ /^texlive-extra$/ ||
- $debian_package =~ /^texlive-lang$/ ||
- $debian_package =~ /^texlive-doc$/ ||
- $debian_package =~ /^texlive-bin$/ );
-};
-
-# texlive
-# my $TpmDirGlob = $Master . "./texmf-dist/tpm/*.tpm";
-# teTeX
-my $TpmDirGlob = "$tpmdir/*.tpm";
-
-# only needed if we're in the sourcedir, so no need to bother
-my $sourceDir;
-chomp( $sourceDir = `pwd`);
-$sourceDir .= "/";
-
-# require Strict;
-require XML::DOM;
-require FileUtils;
-import FileUtils qw(canon_dir cleandir make_link newpath member
- normalize substitute_var_val diff_list remove_list
- rec_rmdir sync_dir walk_dir start_redirection stop_redirection);
-require Tpm;
-#
-# what the hell, how do I import this array from Tpm.pm ???
-#
-my %Tpm2Catalogue = (
- "ctib" => "ctib4tex",
- "CJK" => "cjk",
- "bayer" => "universa",
- "bigfoot" => "suffix",
- "cb" => "cbgreek",
- "cd-cover" => "cdcover",
- "cmex" => "cmextra",
- "cs" => "csfonts",
- "cyrplain" => "t2",
- "devanagr" => "devanagari",
- "eCards" => "ecards",
- "ESIEEcv" => "esieecv",
- "euclide" => "pst-eucl",
- "GuIT" => "guit",
- "HA-prosper" => "prosper",
- "ibycus" => "ibycus4",
- "ibygrk" => "ibycus4",
- "IEEEconf" => "ieeeconf",
- "IEEEtran" => "ieeetran",
- "iso" => "isostds",
- "iso10303" => "isostds",
- "jknapltx" => "jknappen",
- "kastrup" => "binhex",
- "le" => "frenchle",
- "mathtime" => "mathtime-ltx",
- "omega-devanagari" => "devanagari-omega",
- "pdftexdef" => "pdftex-def",
- "procIAGssymp" => "prociagssymp",
- "resume" => "res",
- "SIstyle" => "sistyle",
- "SIunits" => "siunits",
- "syntax" => "syntax2",
- "Tabbing" => "tabbing",
-# the following were added in tpm2licenses
- "avantgar" => "urw-base35",
- "bookman" => "urw-base35",
- "courier" => "urw-base35",
- "helvetic" => "urw-base35",
- "palatino" => "urw-base35",
- "symbol" => "urw-base35",
- "times" => "urw-base35",
- "zapfchan" => "urw-base35",
- "zapfding" => "urw-base35"
- );
-
-my $parser = new XML::DOM::Parser;
-my $startdir=getcwd();
-chdir($startdir);
-File::Basename::fileparse_set_fstype('unix');
-
-my @TpmList;
-my @coveredfiles;
-
-if (@ARGV) {
- # we have a (list of) packages on the command line
- @TpmList = @ARGV;
-}
-else {
- create_tpmlist();
-};
-
-list_licenses();
-
-1;
-
-my $LocalTPM;
-my $licline;
-my $bn;
-my $pkgcat;
-my $node;
-my $printfiles = '';
-
-sub create_tpmlist {
- foreach (<$TpmDirGlob >) {push(@TpmList,$_)};
-};
-
-sub list_licenses {
- foreach $LocalTPM (@TpmList) {
- $printfiles = '';
- $licline = "";
- $bn = &basename($LocalTPM,".tpm");
- next if ($bn =~ m/bin-|collection-/);
- if (defined($Tpm2Catalogue{$bn})) {
- $pkgcat = $Tpm2Catalogue{$bn};
- } else {
- $pkgcat = $bn;
- }
- $licline .= "$bn: ";
- if ($Catalogue =~ m/file:(.*)$/) {
- # use the precompiled list of liclines extracted from the Catalogue
- $licline = `grep ^${bn}: $1`;
- chomp $licline;
- if ($licline eq "") { $licline = "tpm $bn not found in $1, strange"; }
- $printfiles = 1;
- } else {
- my $fletter = substr($pkgcat, 0, 1);
- my $catname = "${Catalogue}/entries/$fletter/${pkgcat}.xml";
- if (! -r $catname) {
- $catname = "$tpmdir/${pkgcat}.xml";
- if (! -r $catname) {
- $licline .= "not-in-catalogue";
- };
- }
- my $ltype;
- unless ($nocatalogue || (! -r $catname) || $pkgcat =~ m/^individual.*/) {
- #don't try to parse the xml file if we don't have a catalogue
- my $cat = $parser->parsefile($catname);
- my ($version, $lversion, $lchecked, $luser, $lfile);
- $node = $cat->getElementsByTagName("version")->item(0);
- if ($node) {
- $version = $node->getAttribute("number");
- }
- $node = $cat->getElementsByTagName("license")->item(0);
- if ($node) {
- # ok we have a license entry in there
- $ltype = $node->getAttribute("type");
- $lversion = $node->getAttribute("version");
- $lchecked = $node->getAttribute("checked");
- $luser = $node->getAttribute("username");
- $lfile = $node->getAttribute("file");
- }
- if ("$lversion$lchecked$luser" eq "") {
- if ("$ltype" eq "") {
- $licline .= "unknown";
- } else {
- $licline .= "$ltype (unverified)";
- # we know the license, it makes sense to output the files
- $printfiles = '1';
- }
- } else {
- $version ||= ''; # make sure we have no uninitialized string values
- $lversion ||= '';
- $licline .= "$ltype (verification data:$version:$lversion:$lchecked:$luser:$lfile)";
- $printfiles = '1';
- }
- }
- if ( $pkgcat =~ m/^individual.*/ ) {
- $ltype = $pkgcat;
- $ltype =~ s/individual_(.*)/$1/;
- $licline = "$pkgcat $ltype (verification data:::::header)";
- $printfiles = '1';
- };
- } # else part of Catalogue = file:...
- $what eq "license" && print "$licline\n";
- # we know the license, it makes sense to output the files
- $what eq "files" && print "\n% $licline\n";
- if ($what eq "files" && ($printfiles || $nocatalogue || $listallfiles)) {
- printFiles($LocalTPM,$licline);
- }
- }
- $what eq "files" && ! $nocoverage && CheckCoverage();
-}
-
-sub printFiles {
- my ($LocalTPM,$licline)= @_;
- my $pkg_header = "";
- my $dom_parser = new XML::DOM::Parser;
- my $doc = $dom_parser->parsefile($LocalTPM);
- my %SourceFiles = Tpm::getListField($doc, "SourceFiles");
- my %RunFiles = Tpm::getListField($doc, "RunFiles");
- my %DocFiles = Tpm::getListField($doc, "DocFiles");
-
- #
- # NORBERT
- # getListField returns a hash, and s{text} SHOULD be an array reference
- # why isn't it like this???
- # If it would be an array reference one could easily check whether
- # sourcefile(text) is empty or not!!!
- # Trick: If it was emtpy there is not size key!
- #
- if (!defined($SourceFiles{"size"})) {
- $SourceFiles{"text"} = "";
- }
- if (!defined($DocFiles{"size"})) {
- $DocFiles{"text"} = "";
- }
- if (!defined($RunFiles{"size"})) {
- $RunFiles{"text"} = "";
- }
-
- foreach ($RunFiles{"text"}, $DocFiles{"text"}, $SourceFiles{"text"}) {
- # this is already done in Tpm.pm, why isn't that sufficient?
- $_ =~ s/^\n*// ;
- # remove the texmf-dist/ etc we don't need
- $_ =~ s at texmf-dist/@@g;
- $_ =~ s at texmf-doc/@@g;
- $_ =~ s at texmf/@@g;
- # make sure there's exactly one newline at the end
- chomp;
- $_ =~ s/$/\n/ ;
- };
-
- # we don't want the tpm file which isn't installed
- $RunFiles{"text"} =~ s/\n.*\.tpm$//m;
-
- my @SourceFiles = split(/\n/m,$SourceFiles{"text"});
- my @RunFiles = split(/\n/m,$RunFiles{"text"});
- my @DocFiles = split(/\n/m,$DocFiles{"text"});
- foreach (@SourceFiles) {
- s/^\s//;
- s@^[\s\n]*(.*)[\s\n]*$@$1 at so;
- s@\n\s*@\n at gm;
- };
- foreach (@RunFiles) {
- s/\s//;
- s@^[\s\n]*(.*)[\s\n]*$@$1 at so;
- s@\n\s*@\n at gm;
- };
- foreach (@DocFiles) {
- s/\s//;
- s@^[\s\n]*(.*)[\s\n]*$@$1 at so;
- s@\n\s*@\n at gm;
- };
- @DocFiles = grep(!/^$/, at DocFiles);
- @RunFiles = grep(!/^$/, at RunFiles);
- @SourceFiles = grep(!/^$/, at SourceFiles);
-
- # fake case statement
- for ($debian_package) {
- #my @texmfPath;
- if ( /^texlive/ ) {
- #@texmfPath = ("texmf","texmf-dist","texmf-doc");
- #
- # DocFiles are installed into /u/s/d/pkg/...
- # do we have to strip the first doc/ part
- @DocFiles = map { $_ =~ s,^doc/,, ; $_; } @DocFiles ;
- foreach (@RunFiles) {CheckFileExistence($_)};
- foreach (@DocFiles) {CheckFileExistence($_)};
- if (!$nosourcefiles) {
- foreach (@SourceFiles) {CheckFileExistence($_)};
- }
- MergeDirectories(\@RunFiles);
- MergeDirectories(\@DocFiles) if (@DocFiles);
- if (!$nosourcefiles) {
- MergeDirectories(\@SourceFiles) if (@SourceFiles);
- }
- print @RunFiles;
- print @DocFiles;
- print @SourceFiles if (!$nosourcefiles);
- };
- if ( /^tetex-base$/ ) {
- #@texmfPath = (".");
- foreach (@RunFiles) {CheckFileExistence($_)};
- foreach (@DocFiles) {CheckFileExistence($_)};
-
- MergeDirectories(\@RunFiles);
- MergeDirectories(\@DocFiles) if (@DocFiles);
- print @RunFiles;
- print @DocFiles;
- };
- if ( /^tetex-src$/ ) {
- #@texmfPath = (".");
- foreach (@SourceFiles) {CheckFileExistence($_)};
- MergeDirectories(\@SourceFiles);
- unless (! @SourceFiles) {
- print @SourceFiles;
- }
- };
- };
-}
-
-sub CheckCoverage {
- my @allfilesinpackage;
- my @notcoveredfiles;
- foreach my $tmf (@texmfPath) {
- push @allfilesinpackage, `find $tmf -type f`;
- }
- chomp @allfilesinpackage;
- foreach (@allfilesinpackage) {
- next if (m/\.tpm$/);
- if (!(in_list($_, at coveredfiles))) {
- push @notcoveredfiles, $_;
- }
- }
- print "\n\nCOVERAGE CHECK:";
- if ($#notcoveredfiles < 0) {
- print "OK\n";
- } else {
- print "NOT COVERED FILES:\n";
- foreach (@notcoveredfiles) {
- print $_,"\n";
- }
- }
-}
-
-sub in_list {
- my ($what, @list) = @_;
- foreach (@list) {
- if ($what eq $_) { return 1; }
- }
- return 0;
-}
-
-sub CheckFileExistence {
- my ($file) = @_;
- my $found = 0;
- foreach my $texmfDir (@texmfPath) {
- -f $texmfDir . "/" . $file && ($found =1) && push @coveredfiles , "$texmfDir/$file" ;
- };
- print STDERR "$file: Does not exist!\n" if ! $found;
-}
-
-sub MergeDirectories {
- my ($filelist) = @_; # filelist is actually a pointer
- # create a list of dirnames, and remove duplicates
- my @dirnames = map {dirname($_) } @{$filelist};
- my %UniqueHash = map { $_ , 1 } @dirnames;
- @dirnames = keys %UniqueHash;
-
- # For searching, we create a hash that contains the filenames as keys:
- my %SearchHash;
- %SearchHash = map { $_, 1 } @{$filelist} ;
-
- my %DirComplete = map { $_, 1 } @dirnames;
- for (@dirnames) {
- my $dirname = $_;
- my $fullDir;
- my $rootDir;
- for (@texmfPath) {
- if ( -d ( $_ . "/" . $dirname )) {
- $rootDir = $_;
- $fullDir = ( $_ . "/" . $dirname );
- last;
- };
- };
- if (!$fullDir) {
- printf STDERR "This should not happen: no directory $dirname, nowhere.\n";
- next;
- }
- my @AllInstalledFiles = `find $fullDir -maxdepth 1 -type f 2>/dev/null`;
- if ($#AllInstalledFiles == -1) { next; }
- my @InstalledFiles = `find $fullDir -maxdepth 1 -type f 2>/dev/null | grep -v tetex`
- or die "Calling find for $dirname, expanded to $fullDir, failed.";
- for (@InstalledFiles) {
- chomp;
- s@^$rootDir/@@;
- $DirComplete{$dirname} = 0 unless $SearchHash{$_};
- };
- if ( $DirComplete{$dirname} ) {
- for (@{$filelist} ) {
- # replace the file by its directory name
- s@$dirname/.*@$dirname/*@;
- };
- };
-# print STDERR "Directory $_ is $DirComplete{$dirname}\n";
- };
-
- # now the complete directories occur multiple times, remove duplicates again
- %UniqueHash = map { ("$_\n" , 1) } @{$filelist} ;
- @{$filelist} = sort keys %UniqueHash;
-}
-
-
Deleted: tex-common/branches/v3/scripts/tpm2licenses.README
===================================================================
--- tex-common/branches/v3/scripts/tpm2licenses.README 2012-03-10 03:16:23 UTC (rev 5200)
+++ tex-common/branches/v3/scripts/tpm2licenses.README 2012-03-10 03:19:21 UTC (rev 5201)
@@ -1,330 +0,0 @@
-README file for tpm2licenses
-*****************************
-
-This README file explains what the script tpm2licenses is meant for,
-and how it can be used.
-
-1. Purpose
-2. Requirements
-3. Usage of the script
-4. License verification procedure
-
-1. Purpose
-===========
-
-TeXlive is a big collection, itself a distribution put together from
-individual packages on CTAN (ftp://cam.ctan.org/tex-archive/).
-Upstream (the TeXLive team) do share Debian's view on Free Software
-(except maybe for documentation issues), but there might still be
-files included that are non-free or are intended to be free, but don't
-have a proper license statement. The reason is mostly historical - in
-the old days, both upstream and individual package authors didn't care
-about these things as they should have. And TeX has grown for a long
-time...
-
-In the past, the Debian teTeX packages (the predecessor of TeXLive)
-have been audited for license freeness at least once. However, this
-has been done on a per-CTAN- package basis (and even that, perhaps,
-not too systematically), not on a per-file basis. Furthermore, the
-process of auditing has not been documented. Therefore, it is not
-possible today to check which parts were included and checked back
-then.
-
-As a consequence, we have decided to do it systematically this time,
-and to keep information about which files are associated with a
-particular package, which license they're under, and where this
-information can be found.
-
-This information will ultimately end up in debian/copyright in a very
-condensed form. For maintaining the information, we use different,
-more structured files at different locations, re-using already
-existing infrastructure in the TeXlive package building mechanisms and
-the TeX Catalogue. This script is used to verify whether this
-existing information is correct and applies to the current TeXLive
-packages, and to merge the information into the copyright file.
-
-2. Requirements
-======================
-
-- installed packages
-
- tpm2licenses is installed with the tex-common package, as an
- executable in /usr/share/tex-common, but since it is not at the core
- of tex-common's functionality, two additional packages are needed
- that tex-common does not depend upon:
-
- libxml-dom-perl, libappconfig-perl.
-
-- Available sources
-
- Obviously, you need the tetex-base[1] source package. You also need
- the tetex-src package - either the installed binary package or,
- better, the source package.
-
- Having TeXlive sources installed is not strictly needed, but it
- makes your contribution much more valuable
-
- Finally, the script can access a local checkout of the TeX Catalogue
- sources, but this is not needed to do the auditing, only for the
- final copyright file generation (and even here an intermediate file
- can be used)
-
-3. Usage of the script
-========================
-
-SYNTAX:
-
- /usr/share/tex-common/tpm2licenses [ options ] [ tpm file(s) ]
-
-The script must be run from the root directory of an unpacked source
-package (e.g. tetex-base-3.0/) [FIXME: texlive runs it on installed
-files?] and understands the following options:
-
- --catalogue <directory>
- --catalogue file:<file>
-
- Path to a local checkout of the TeX Catalogue sources, or in
- the second form the path to a file that contains a precompiled
- list of "license lines" for CTAN packages.
-
- --nocheckcatalogue
-
- Do not try to check the catalogue
-
- --tpmdir
-
- The directory where tpm files can be found. Not necessary
- when auditing single tpm files
-
- --package [tetex-base|tetex-src|texlive-*]
-
- Assume we are in a source tree of this package (affects
- whether sources or runtime files are searched for, or both)
-
- --listallfiles
-
- list the files even in the tpm files for which we do not have
- Catalogue information, even if a Catalogue location is given
-
- --nocoverage
-
- Do not list files in the source package that are not listed in
- any of the tpm files. Useful if you're giving tpm files on
- the command line.
-
-The options can also be written into a configuration file, like this:
-
-Catalogue = /home/frank/src/Upstream-source/texcatalogue
-nocoverage
-
-The file should be named .tpm2license.cfg and will be searched for in
-the current directory, it's subdirectory debian, the parent directory
-and the user's home directory (in this order). If multiple
-configuration files exist, all are read, and later entries override
-earlier ones. Thus, you can e.g. specify "nocheckcatalogue" in your
-home directory.
-
-The script will do the following things:
-
-- Extract filenames with path information from a tpm file, one tpm
- file after the other.
-
-- Check whether all files in the tpm do in fact exist in the source
- tree, and warn if some are missing.
-
-- Extract license information from the TeX Catalogue, if available,
- and print it.
-
-- For each directory mentioned in the tpm file, check whether the
- directory is complete with the files from that tpm. If there are
- additional files in it, only the files listed in the tpm are
- returned. If the directory is complete (not counting subdirectories
- and their contents), only the directory name with a * appended is
- printed.
-
-If more than one tpm file is given, or the whole tpmdir is acted on,
-this sequence is repeated multiple times, separately for each tpm file.
-
-- After that, unless nocoverage is given, the script complains about any
- files that are in the source tree but not in the tpm files used in
- this run. The coverage should be complete for TeXLive, but it isn't
- for teTeX - therefore tetex-base and tetex-src should have noocoverage
- in their configuration files currently.
-
-4. License verification procedure
-===================================
-
-We suggest that everybody follows the procedure outlined below.
-
-a) coordinate on debian-tetex-maint and/or in the Wiki at
- http://wiki.debian.org/LicenseAuditing which parts you are going to
- check, to prevent duplicate work.
-
-b) copy a tpm file from texlive to tetex-base's debian/tpm/ directory.
- Of course, if you've got SVN write access, use "svn copy". In
- texlive's SVN repository, the tpm files are alltogether in
- LocalTPM/texmf-dist/tpm/. In the individual source packages, they
- are in texmf-dist/tpm.
-
- The tpm files consist of some general information about the
- package, and three lists of RunFiles, DocFiles and SourceFiles.
- Any of these may be empty. Run and Doc files should be in
- tetex-base, Source files in tetex-src.
-
-c) Change directory to the tetex-base source tree and run
-
-/usr/share/tex-common/tpm2licenses debian/tpm/<your_new>.tpm >/dev/null
-
- The redirection makes sense because this time, you're only
- interested in the error messages about missing files. There are
- many possible reasons for missing files, for example:
-
- 1. TeXLive has a newer version of the package, and the newer
- version has additional files. Of course, other files may also
- have vanished, see below.
-
- 2. TeXlive often installs files into the documentation tree
- (DocFiles) that are in tetex-src.
-
- 3. Different file extensions, e.g. DVI files instead of PDF, or a
- file "packagename.readme" has been renamed to "readme.txt" since
- it's installed in the packagename directory, anyway
-
- 4. Packaging errors by teTeX's upstream, the file *should* be
- there.
-
- Therefore, for any file missing in the RunFiles or DocFiles sections,
- don't delete the line in the tpm file. Instead, move it to
- SourceFiles and change "doc" to "source", "tex" to "source" etc.
-
- Proceed to the next step if there are no more error messages
-
-d) Change to the tetex-src source tree and run
-
-/usr/share/tex-common/tpm2licenses path/to/<your_new>.tpm >/dev/null
-
- In many cases, files moved to SourceFiles from RunFiles or DocFiles
- will be reported as missing again - sometimes because they are
- really missing, sometimes because the paths or names don't fit
- completely.
-
-e) Now come two technically distinct steps which can conveniently be
- done at once: On the one hand, we have to check whether any files
- exist in the source trees that should be in the tpm file we're
- looking at. On the other hand, we need to verify whether the
- license the package is under actually covers all the files listed
- in its tpm file.
-
- 1. Adding files
-
- To check for files you can possibly add to the tpm file, rerun the
- above commands without the redirection. In the ideal case, you'll
- get a list of directories, like this:
-
-% acronym: lppl (verification data:1.25:1.17:2006-03-07:frank:header)
-tex/latex/acronym/*
-doc/latex/acronym/*
-
- This indicates that all files in these two directories are already
- listed in acronym.tpm - no need to add any. However, if you get a
- list of many individual files in the same directory, chances are
- that one or two are missing: It might be that the file no longer
- exists in TeXlive's newer version, an error in TeXlive, or
- whatever.
-
- Furthermore, in many cases files need to be copied from DocFiles to
- SourceFiles. This is because in TeXlive, where the tpms have been
- developed, every file exists only once. In teTeX, on the other
- hand, the source directories in tetex-src just mirror what is on
- CTAN: Some of these files are source files, others are
- documentation which has also been copied to the tetex-base source
- tree by teTeX's upstream. They are therefore in two source trees
- and need to be in two sections in the tpm file.
-
- 2. Checking Licenses
-
- Of course, we cannot have files in a package's tpm file that in
- fact is not covered by the same license! Therefore you have to
- carefully check the license. First of all, find out where the
- license is specified and whether it is free; then find out which
- files are covered.
-
- Some packages have a file "manifest.txt" or similar which lists all
- files included, and is referenced from the file that specifies the
- license. Others have the license statement in the header of every
- source file, or also in extracted TeX input files. In any case,
- there may be files which are not indicated as belonging to the
- package, being licensed under its license, and still belong to the
- tpm. These fall into two categories:
-
- - trivial files
-
- Very simple readme files, simple Makefiles and their TeX
- counterparts, *.ins files, don't need a license statement. They
- still should have one, so if we're contacting upstream, we can as
- well request to add them to the list of covered files. But it's
- not required.
-
- Also, pure license files, including manifest.txt-style files,
- don't need a license statement.
-
- - generated files
-
- The files that can be autogenerated from a *.dtx file are usually
- listed in an *.ins file (which might have a different name) in a
- command starting with \generate on a line containing
- \file{<filename>}. Some distributions also contain the generated
- file <dtx-basename>.drv. Both from the *.dtx file itself and
- from tex input files generated by the *.ins file, documentation
- in PDF, PS or DVI format can be generated (and in other formats
- using appropriate converters).
-
- Most tpm files refer to only one subdirectory in the tetex-src
- tree, and all files in that directory should be covered by the tpm
- file (except any additions by teTeX upstream, usually indicated by
- "tetex" in their name). In tetex-base, however, files in a
- particular subdirectory *may* also come from a different tpm file.
- If you are unsure, just ignore them, they will be found in the end
- by the coverage check.
-
-f) Reporting success and problems
-
- If all is well, just submit the following information to
- debian-tetex-maint at lists.debian.org:
-
- - the working tpm file
-
- - the license text, or a name if it is LPPL or in
- /usr/share/common-licenses
-
- - The name of the file where the license information is given, the
- version in teTeX and, if you also checked that, versions in
- TeXlive and on CTAN.
-
- If you found incomplete license information, or non-free license
- texts, please report as much info as you have to the mailing list
- and to the Wiki at http://wiki.debian.org/LicenseAuditing. Steps
- to perform now can include:
-
- - Check whether problematic files exist elsewhere on CTAN (some
- files are only in zip or tar.gz archives!) and have other,
- hopefully newer license information
-
- - Check whether any license discussion is archived by Google or
- other search engines
-
- - Find out the responsible upstream author and contact them.
-
- When contacting upstream, please be careful. Remind yourself
- that most of the time, upstream authors want their work to be
- free and think they have already done enough. Explain in some
- detail and with polite words what should be done and why. If
- upstream has been inactive in the TeX community, it might make
- sense to offer that you do an upload on behalf of them. Maybe
- not in the initial mail, but later in the conversation.
-
-
-
-
-[1] Eventually, tetex-bin will have to be checked, too, but currently
-we're concentrating on tetex-base.
\ No newline at end of file
Deleted: tex-common/branches/v3/split-texmf
===================================================================
--- tex-common/branches/v3/split-texmf 2012-03-10 03:16:23 UTC (rev 5200)
+++ tex-common/branches/v3/split-texmf 2012-03-10 03:19:21 UTC (rev 5201)
@@ -1,71 +0,0 @@
-#!/bin/bash -e
-
-# for creating the patch, we need files with extenstion .orig:
-ext=".cnf"
-
-if [ "$1" = "--create-patch" ]; then
- ext=".cnf.orig";
-else
- # make backup copies
- for file in $destdir/*.cnf; do
- if [ -f $file ]; then mv $file $file.bak; fi
- done
-fi
-
-source=texk/kpathsea/texmf.cnf
-destdir=debian/texmf.d
-
-test -d $destdir || mkdir $destdir
-
-
-# main helper function
-selectpart(){
- sed -n -e "$startpattern,$endpattern p" $source | sed -e "$endpattern d"
- startpattern="$endpattern"
-}
-
-startpattern=0
-
-# 05TeXMF.cnf
-endpattern="/^%%%%/"
-selectpart > $destdir/05TeXMF$ext
-
-# 15Plain.cnf
-endpattern="/^% LaTeX/"
-selectpart > $destdir/15Plain$ext
-
-# 45TeXinputs.cnf
-endpattern="/^% Device-independent font metric files./"
-selectpart > $destdir/45TeXinputs$ext
-
-# 55Fonts.cnf
-endpattern="/^% BibTeX bibliographies and style files./"
-selectpart > $destdir/55Fonts$ext
-
-# 65BibTeX.cnf
-endpattern="/^% PostScript headers and prologues/"
-selectpart > $destdir/65BibTeX$ext
-
-# 75DviPS.cnf
-endpattern="/^% Makeindex style (.ist) files./"
-selectpart > $destdir/75DviPS$ext
-
-# 85Misc.cnf
-endpattern="/^# \$progname: kpathsea v. 3.5.3 or later/"
-selectpart > $destdir/85Misc$ext
-
-# 90TeXDoc.cnf
-# Debian-specific
-cat texmf.d/90TeXDoc.cnf > $destdir/90TeXDoc$ext
-
-# 95NonPath.cnf
-endpattern="$"
-selectpart > $destdir/95NonPath$ext
-
-needed_files="05TeXMF 15Plain 45TeXinputs 55Fonts \
- 65BibTeX 75DviPS 85Misc 90TeXDoc 95NonPath"
-
-for file in $needed_files; do
- # test whether a file is empty
- test -n "`cat $destdir/$file$ext`" || exit 1
-done
More information about the Debian-tex-commits
mailing list