[subversion-commit] SVN tex-common commit + diffs: r1180 -
tex-common/trunk/scripts
Frank Küster
frank at costa.debian.org
Mon Apr 10 13:28:17 UTC 2006
Author: frank
Date: 2006-04-10 13:28:09 +0000 (Mon, 10 Apr 2006)
New Revision: 1180
Added:
tex-common/trunk/scripts/Tpm.pm
Log:
Copying Tpm.pm to tex-common for installation
Copied: tex-common/trunk/scripts/Tpm.pm (from rev 1106, texlive/trunk/LocalTPM/Tools/Tpm.pm)
===================================================================
--- texlive/trunk/LocalTPM/Tools/Tpm.pm 2006-03-23 17:40:23 UTC (rev 1106)
+++ tex-common/trunk/scripts/Tpm.pm 2006-04-10 13:28:09 UTC (rev 1180)
@@ -0,0 +1,1782 @@
+# $Id: //depot/Master/Tools/Tpm.pm#92 $ $Date: 2005/10/19 $ $Author: 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",
+ "i386-darwin",
+ "i386-freebsd",
+ "i386-linux",
+ "mips-irix",
+ "powerpc-aix",
+ "powerpc-darwin",
+ "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"
+ );
+
+$IgnoredFiles = "(bin/i386-freebsd|bin/i386-openbsd|bin/i386-solaris|bin/mips-irix|bin/powerpc-aix|bin/powerpc-darwin|bin/sparc-solaris|bin/win32/TeXLive.exe|texmf/tpm/(collection-binaries|texlive|xemtex|scheme-.*|.*-static)\.tpm|texmf(-doc|-dist)?/(ls-R|aliases|lists/.*|README|tpm/tpm.dtd)|source/.*)";
+
+# 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", "xmltex", "ytex", );
+# Kind of font files
+my @fonttypes = (
+ "afm", "misc", "ofm", "opentype", "ovf", "ovp", "pfb",
+ "pk", "sfd", "source", "tfm", "truetype", "type1", "vf"
+ );
+# Font vendors
+my @vendors = (
+ "adobe", "amsfonts", "archaic", "arphic",
+ "bakoma", "bh", "bitstrea", "bluesky",
+ "cg", ,"cns", "cspsfonts-adobe",
+ "hoekwater", "ibm", "itc", "jknappen", "jmn", "korean", "lh",
+ "misc", "monotype", "paragrap",
+ "public", "uhc", "urw", "urw35vf", "vntex", "wadalab",
+ "yandy");
+my @fontmodes = (
+ "ljfour", "ljfive", "cx"
+ );
+my @languages = ("bulgarian", "czechslovak", "dutch", "english",
+ "finnish", "french", "general",
+ "german", "greek", "italian", "japanese", "korean",
+ "mongolian",
+ "polish", "portuguese", "russian", "slovak", "spanish",
+ "thai", "ukrainian", "vietnamese");
+
+my %dotfiles = (
+ "texmf-dist/tex/latex/tools/*" => ( "texmf-dist/tex/latex/tools/.tex" ),
+ "texmf/chktex/*" => ( "texmf/chktex/.chktexrc" )
+ );
+
+my $CatalogueDir = "/src/TeX/texcatalogue";
+my $Catalogue;
+
+#
+# missing entries
+# ? bengali:pandey
+# ? grotesq:urwvf
+# ? helvetic:urwvf
+# ? knuthotherfonts:halftone
+# makedtx:makedtx not working!
+# ? oberdiek:twoopt, tabularht, tabularkv, settobox, refcount, alphalph, chemarr, classlist, dvipscol, engord, hypbmsec, hypcap, ifdraft, ifpdf, ifvtexm pagesel, 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 = "";
+ if (defined($s{"text"})) {
+ $str = $s{"text"};
+ }
+ $str =~ s/^\n*//gmx;
+ $str =~ s/\n*$//gm;
+ $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 \"../../Tools/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>864</TPM:Size>\
+ <TPM:Description></TPM:Description>\
+ <TPM:Build>\
+ <TPM:RunPatterns>${texmf}/tpm/${name}.tpm</TPM:RunPatterns>\
+ </TPM:Build>\
+ <TPM:RunFiles size=\"679\">${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 \"../../Tools/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 (@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}) {
+ push @l, @{${$v}{"text"}};
+ }
+ }
+ }
+ elsif ($n =~ /^(Run|Doc|Source|Remote)Files$/) {
+ my %v = %{$self->{$n}};
+ @l = @{$v{"text"}};
+ }
+ else {
+ @l = @{$self->{$n}};
+ }
+
+ if (wantarray) {
+ return @l;
+ }
+ else {
+ 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 max_date
+{
+ my ($olddate, @files) = @_;
+ my ($f, $tpmdate);
+# print "olddate was " . &formatdate(gmtime($oldate)) . "\n";
+ foreach $f (@files) {
+ if ($f =~ m@^texmf-dist/tpm/.*\.tpm@) {
+ $tpmdate = ${stat($f)}[9];
+ }
+ else {
+ my @st = stat("$MasterDir/$f");
+# print "file $f is " . &formatdate(gmtime($st[9])) . "\n";
+ if ($st[9] > $olddate) {
+# print "replacing\n";
+ $olddate = $st[9];
+ }
+ }
+ }
+ if ($olddate == 0) {
+ $olddate = $tpmdate;
+ }
+# print "newdate is " . &formatdate(gmtime($oldate)) . "\n";
+ return $olddate;
+}
+
+sub fixDate {
+ my ($self) = @_;
+ my $newdate = 0;
+ foreach my $s (@{$self->getFileList("BinFiles")}) {
+ if ($CurrentArch eq "all" || $s =~ m@/${CurrentArch}/@) {
+ $newdate = &max_date($newdate, ${$s}{"text"});
+ }
+ }
+# print "#### newdate is " . &formatdate(gmtime($newdate)) . "\n";
+ $newdate = &max_date($newdate, $self->getFileList("RunFiles"));
+# print "#### newdate is " . &formatdate(gmtime($newdate)) . "\n";
+ $newdate = &max_date($newdate, $self->getFileList("DocFiles"));
+# print "#### newdate is " . &formatdate(gmtime($newdate)) . "\n";
+ $newdate = &max_date($newdate, $self->getFileList("SourceFiles"));
+ $newdate = &max_date($newdate, $self->getFileList("RemoteFiles"));
+ $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-)//;
+
+ 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 metapost !
+ } elsif (${name} eq 'metapost') {
+ push @run_patterns, $texmf . "/metapost/support/*";
+
+ # Exception for tex4ht !
+ } elsif (${name} eq 'tex4ht') {
+ push @run_patterns, $texmf . "/tex4ht/ht-fonts/*";
+
+ # 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}/*" if ($_ ne 'tex' && $_ ne 'omega');
+ } @engines;
+
+ map {
+ push @run_patterns, $texmf . "/tex/$_/${name}/*";
+ } @formats;
+
+ push @doc_patterns, ( $texmf . "/doc/${name}/base/*" );
+
+ push @source_patterns, ( $texmf . "/source/${name}/base/*" );
+
+ # Exception for Context !
+ if (${name} eq 'context') {
+ push @run_patterns, $texmf . "/tex/context/*";
+
+ # exception for texinfo since it has no subdirs.
+ } elsif (${name} eq 'texinfo') {
+ push @run_patterns, $texmf . "/tex/texinfo/*";
+
+ # 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}/*";
+
+ map { push @run_patterns, $texmf . "/fonts/$_/${name}/*"; } @fonttypes;
+
+ map {
+ my $e = $_;
+ map {
+ push @run_patterns, $texmf . "/$e/$_/${name}/*"
+ unless $name eq "misc" && $_ eq "fontinst";
+ # keep fontinst/misc in fontinst.
+ } @formats;
+ } @engines;
+
+ # Exception for amsfonts -- te/staw decided in June 2005 to use ams
+ # for the directory name within fonts, but amsfonts elsehwere.
+ if (${name} eq 'amsfonts') {
+ push @run_patterns,
+ ( $texmf . "/dvips/ams/config.*",
+ $texmf . "/fonts/map/*/ams/*",
+ $texmf . "/fonts/*/bluesky/ams/*",
+ $texmf . "/fonts/*/public/ams/*",
+ );
+ push @source_patterns,
+ ( $texmf . "/source/latex/amsfonts/*" );
+ }
+
+ # 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}/*";
+ } @formats;
+
+ } @engines;
+
+ map {
+ push @run_patterns, $texmf . "/tex/$_/${name}/*";
+ 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}/*";
+
+ # one more special case, fontname has its own odd map files.
+ if ($name eq 'fontname') {
+ push @run_patterns, $texmf . "/fonts/map/${name}/*";
+ }
+ }
+
+ 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";
+
+ $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, $newdir) = @_;
+
+ # 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
+ # If newdir is not set or it is a direcory
+ $outfname = "";
+ if ($newdir) {
+ if (!(-e $newdir)) {
+ `mkdir -p $newdir`;
+ }
+ if (!(-d $newdir)) {
+ print "ERROR: $newdir is not a directory, not writing tpm file!\n";
+ return;
+ }
+ $outfname = "$newdir/" . ${Tpm::TexmfTreeOfType}{$type} . "/tpm/$name.tpm";
+ $dn = &FileUtils::dirname($outfname);
+ `mkdir -p $dn`;
+ }
+ # Test that patterns and files list are n sync
+ if ($self->testSync()) {
+ print "Writing $type/$name $outfname\n";
+ $self->writeFile($outfname);
+ }
+ 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();
+}
+
+1;
More information about the Pkg-tetex-commits
mailing list