diff options
author | Norbert Preining <preining@logic.at> | 2007-06-18 14:23:18 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2007-06-18 14:23:18 +0000 |
commit | dfd6e494fcfcfe684312b959c68d589b06d33594 (patch) | |
tree | 9d14cbe7b574ddcb88afbc910ab89a4af4c7f7cf /Master/tlpkg/TeXLive/TLPOBJ.pm | |
parent | 7fb60a74aab3febff8b73f2c8485f038d6a5e8cf (diff) |
it is tlpsrc not tlsrc, tlpobj not tlp, tlpdb not tldb...
git-svn-id: svn://tug.org/texlive/trunk@4469 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/TeXLive/TLPOBJ.pm')
-rw-r--r-- | Master/tlpkg/TeXLive/TLPOBJ.pm | 924 |
1 files changed, 461 insertions, 463 deletions
diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm index fa80650a973..b5d4a3a6e2e 100644 --- a/Master/tlpkg/TeXLive/TLPOBJ.pm +++ b/Master/tlpkg/TeXLive/TLPOBJ.pm @@ -1,6 +1,6 @@ # # TeXLive::TLPOBJ.pm -# module for using tlp files +# module for using tlpobj files # Copyright 2007 Norbert Preining # # This file is licensed under the GNU General Public Licence version 2 @@ -18,556 +18,556 @@ my $_tmp; my $_zipdir; sub new { - my $class = shift; - my %params = @_; - my $self = { - name => $params{'name'}, - category => defined($params{'category'}) ? $params{'category'} : "Package", - shortdesc => $params{'shortdesc'}, - longdesc => $params{'longdesc'}, - catalogue => $params{'catalogue'}, - runfiles => defined($params{'runfiles'}) ? $params{'runfiles'} : [], - runsize => $params{'runsize'}, - srcfiles => defined($params{'srcfiles'}) ? $params{'srcfiles'} : [], - srcsize => $params{'srcsize'}, - docfiles => defined($params{'docfiles'}) ? $params{'docfiles'} : [], - docsize => $params{'docsize'}, - executes => defined($params{'executes'}) ? $params{'executes'} : [], - # note that binfiles is an ARRAY with keys of $arch! - binfiles => defined($params{'binfiles'}) ? $params{'binfiles'} : {}, - binsize => defined($params{'binsize'}) ? $params{'binsize'} : {}, - depends => defined($params{'depends'}) ? $params{'depends'} : [], - revision => $params{'revision'}, - }; - $_zipdir = $params{'zipdir'} if defined($params{'zipdir'}); - bless $self, $class; - return $self; + my $class = shift; + my %params = @_; + my $self = { + name => $params{'name'}, + category => defined($params{'category'}) ? $params{'category'} : "Package", + shortdesc => $params{'shortdesc'}, + longdesc => $params{'longdesc'}, + catalogue => $params{'catalogue'}, + runfiles => defined($params{'runfiles'}) ? $params{'runfiles'} : [], + runsize => $params{'runsize'}, + srcfiles => defined($params{'srcfiles'}) ? $params{'srcfiles'} : [], + srcsize => $params{'srcsize'}, + docfiles => defined($params{'docfiles'}) ? $params{'docfiles'} : [], + docsize => $params{'docsize'}, + executes => defined($params{'executes'}) ? $params{'executes'} : [], + # note that binfiles is an ARRAY with keys of $arch! + binfiles => defined($params{'binfiles'}) ? $params{'binfiles'} : {}, + binsize => defined($params{'binsize'}) ? $params{'binsize'} : {}, + depends => defined($params{'depends'}) ? $params{'depends'} : [], + revision => $params{'revision'}, + }; + $_zipdir = $params{'zipdir'} if defined($params{'zipdir'}); + bless $self, $class; + return $self; } sub from_file { - my $self = shift; - if (@_ != 1) { - die("Need a filename for initialization!"); - } - open(TMP,"<$_[0]") || die("Cannot open tlp file: $_[0]"); - $self->from_fh(\*TMP); -} - + my $self = shift; + if (@_ != 1) { + die("Need a filename for initialization!"); + } + open(TMP,"<$_[0]") || die("Cannot open tlpobj file: $_[0]"); + $self->from_fh(\*TMP); +} + sub from_fh { - my ($self,$fh,$multi) = @_; - my $started = 0; - my $lastcmd = ""; - my $arch; - my $size; + my ($self,$fh,$multi) = @_; + my $started = 0; + my $lastcmd = ""; + my $arch; + my $size; - while (my $line = $fh->getline) { - &TeXLive::TLUtils::debug("reading line: >>>$line<<<\n"); - &TeXLive::TLUtils::debug("multi=...$multi...\n"); - $line =~ /^\s*#/ && next; # skip comment lines - if ($line =~ /^\s*$/) { - if (!$started) { next; } - if (defined($multi)) { - # we may read from a tldb file - return 1; - } else { - # we are reading one tldb file, nothing else allowed - die("No empty line allowed within tlp files!"); - } - } - if ($line =~ /^ /) { - if ( ($lastcmd eq "longdesc") || - ($lastcmd eq "runfiles") || - ($lastcmd eq "binfiles") || - ($lastcmd eq "docfiles") || - ($lastcmd eq "srcfiles") || - ($lastcmd eq "executes") || - ($lastcmd eq "depend") ) { - $line =~ s/^ /${lastcmd}continued /; - } else { - die("Continuation of $lastcmd not allowed, please fix tlp!\n"); - } - } - if ($line =~ /^name\s*([-\w]+)$/) { - $name = "$1"; - $lastcmd = "name"; - $self->name("$name"); - $started && die("Cannot have two name directives: $line!"); - $started = 1; - } else { - $started || die("First directive needs to be 'name'"); - if ($line =~ /^shortdesc\s+(.*)$/) { - $self->{'shortdesc'} .= "$1"; - $lastcmd = "shortdesc"; - next; - } elsif ($line =~ /^longdesc(continued)?\s+(.*)$/) { - if (defined($1) && ("$1" eq "continued")) { - $self->{'longdesc'} .= " $2"; - } else { - $self->{'longdesc'} = "$2"; - } - $lastcmd = "longdesc"; - next; - } elsif ($line =~ /^category\s+(Package|TLCore|Documentation)$/) { - $self->{'category'} = "$1"; - $lastcmd = "category"; - next; - } elsif ($line =~ /^revision\s+(.*)$/) { - $self->{'revision'} = "$1"; - $lastcmd = "revision"; - next; - } elsif ($line =~ /^catalogue\s+(.*)$/) { - $self->catalogue("$1"); - $lastcmd = "catalogue"; - next; - } elsif ($line =~ /^(doc|src|run)files\s+/) { - my $type = $1; - my @words = split ' ',$line; - # first entry is "XXXfiles", shift it away - $lastcmd = shift @words; - while (@words) { - $_ = shift @words; - if (/^size=(.*)$/) { - $size=$1; - } else { - die "Unknown tag: $line"; - } - } - if (defined($size)) { - $self->{"${type}size"} = $size; - } - next; - } elsif ($line =~ /^(doc|src|run)filescontinued\s+(.*)$/) { - push @{$self->{$1."files"}}, "$2"; - next; - } elsif ($line =~ /^binfiles\s+/) { - my @words = split ' ',$line; - # first entry is "binfiles", shift it away - shift @words; - while (@words) { - $_ = shift @words; - if (/^arch=(.*)$/) { - $arch=$1; - } elsif (/^size=(.*)$/) { - $size=$1; - } else { - die "Unknown tag: $line"; - } - } - if (defined($size)) { - $self->{'binsize'}{$arch} = $size; - } - $lastcmd = "binfiles"; - next; - } elsif ($line =~ /^binfilescontinued\s+(.*)$/) { - push @{$self->{'binfiles'}{$arch}}, "$1"; - next; - } elsif ($line =~ /^execute(continued)?\s*(.*)$/) { - push @{$self->{'executes'}}, "$2" unless "$2" eq ""; - $lastcmd = "execute"; - next; - } elsif ($line =~ /^depend(continued)?\s*(.*)$/) { - push @{$self->{'depends'}}, "$2" unless "$2" eq ""; - $lastcmd = "depend"; - next; - } else { - die("Unknown directive ...$line... , please fix it!"); - } - } - } - return $started; + while (my $line = $fh->getline) { + &TeXLive::TLUtils::debug("reading line: >>>$line<<<\n"); + &TeXLive::TLUtils::debug("multi=...$multi...\n"); + $line =~ /^\s*#/ && next; # skip comment lines + if ($line =~ /^\s*$/) { + if (!$started) { next; } + if (defined($multi)) { + # we may read from a tldb file + return 1; + } else { + # we are reading one tldb file, nothing else allowed + die("No empty line allowed within tlpobj files!"); + } + } + if ($line =~ /^ /) { + if ( ($lastcmd eq "longdesc") || + ($lastcmd eq "runfiles") || + ($lastcmd eq "binfiles") || + ($lastcmd eq "docfiles") || + ($lastcmd eq "srcfiles") || + ($lastcmd eq "executes") || + ($lastcmd eq "depend") ) { + $line =~ s/^ /${lastcmd}continued /; + } else { + die("Continuation of $lastcmd not allowed, please fix tlpobj!\n"); + } + } + if ($line =~ /^name\s*([-\w]+)$/) { + $name = "$1"; + $lastcmd = "name"; + $self->name("$name"); + $started && die("Cannot have two name directives: $line!"); + $started = 1; + } else { + $started || die("First directive needs to be 'name'"); + if ($line =~ /^shortdesc\s+(.*)$/) { + $self->{'shortdesc'} .= "$1"; + $lastcmd = "shortdesc"; + next; + } elsif ($line =~ /^longdesc(continued)?\s+(.*)$/) { + if (defined($1) && ("$1" eq "continued")) { + $self->{'longdesc'} .= " $2"; + } else { + $self->{'longdesc'} = "$2"; + } + $lastcmd = "longdesc"; + next; + } elsif ($line =~ /^category\s+(Scheme|Collection|Package|TLCore|Documentation)$/) { + $self->{'category'} = "$1"; + $lastcmd = "category"; + next; + } elsif ($line =~ /^revision\s+(.*)$/) { + $self->{'revision'} = "$1"; + $lastcmd = "revision"; + next; + } elsif ($line =~ /^catalogue\s+(.*)$/) { + $self->catalogue("$1"); + $lastcmd = "catalogue"; + next; + } elsif ($line =~ /^(doc|src|run)files\s+/) { + my $type = $1; + my @words = split ' ',$line; + # first entry is "XXXfiles", shift it away + $lastcmd = shift @words; + while (@words) { + $_ = shift @words; + if (/^size=(.*)$/) { + $size=$1; + } else { + die "Unknown tag: $line"; + } + } + if (defined($size)) { + $self->{"${type}size"} = $size; + } + next; + } elsif ($line =~ /^(doc|src|run)filescontinued\s+(.*)$/) { + push @{$self->{$1."files"}}, "$2"; + next; + } elsif ($line =~ /^binfiles\s+/) { + my @words = split ' ',$line; + # first entry is "binfiles", shift it away + shift @words; + while (@words) { + $_ = shift @words; + if (/^arch=(.*)$/) { + $arch=$1; + } elsif (/^size=(.*)$/) { + $size=$1; + } else { + die "Unknown tag: $line"; + } + } + if (defined($size)) { + $self->{'binsize'}{$arch} = $size; + } + $lastcmd = "binfiles"; + next; + } elsif ($line =~ /^binfilescontinued\s+(.*)$/) { + push @{$self->{'binfiles'}{$arch}}, "$1"; + next; + } elsif ($line =~ /^execute(continued)?\s*(.*)$/) { + push @{$self->{'executes'}}, "$2" unless "$2" eq ""; + $lastcmd = "execute"; + next; + } elsif ($line =~ /^depend(continued)?\s*(.*)$/) { + push @{$self->{'depends'}}, "$2" unless "$2" eq ""; + $lastcmd = "depend"; + next; + } else { + die("Unknown directive ...$line... , please fix it!"); + } + } + } + return $started; } sub recompute_revision { - my ($self,$tltree) = @_; - my @files; - foreach my $a (keys %{$self->{'binfiles'}}) { - push @files, @{$self->{'binfiles'}{$a}}; - } - push @files, $self->runfiles; - push @files, $self->docfiles; - push @files, $self->srcfiles; - $filemax = 0; - foreach my $f (@files) { - $filemax = $tltree->file_svn_lastrevision($f); - $self->revision(($filemax > $self->revision) ? $filemax : $self->revision); - } + my ($self,$tltree) = @_; + my @files; + foreach my $a (keys %{$self->{'binfiles'}}) { + push @files, @{$self->{'binfiles'}{$a}}; + } + push @files, $self->runfiles; + push @files, $self->docfiles; + push @files, $self->srcfiles; + $filemax = 0; + foreach my $f (@files) { + $filemax = $tltree->file_svn_lastrevision($f); + $self->revision(($filemax > $self->revision) ? $filemax : $self->revision); + } } sub recompute_sizes { - my ($self,$tltree) = @_; - $self->{'docsize'} = $self->_recompute_size("doc",$tltree); - $self->{'srcsize'} = $self->_recompute_size("src",$tltree); - $self->{'runsize'} = $self->_recompute_size("run",$tltree); - foreach $a ($tltree->architectures) { - $self->{'binsize'}{$a} = $self->_recompute_size("bin",$tltree,$a); - } + my ($self,$tltree) = @_; + $self->{'docsize'} = $self->_recompute_size("doc",$tltree); + $self->{'srcsize'} = $self->_recompute_size("src",$tltree); + $self->{'runsize'} = $self->_recompute_size("run",$tltree); + foreach $a ($tltree->architectures) { + $self->{'binsize'}{$a} = $self->_recompute_size("bin",$tltree,$a); + } } sub _recompute_size { - my ($self,$type,$tltree,$arch) = @_; - my $size = 0; - if ($type eq "bin") { - my %binfiles = %{$self->{'binfiles'}}; - if (defined($binfiles{$arch})) { - foreach $f (@{$binfiles{$arch}}) { - $size += $tltree->size_of($f); - } - } - } else { - if (defined($self->{"${type}files"}) && (@{$self->{"${type}files"}})) { - foreach $f (@{$self->{"${type}files"}}) { - my $s = $tltree->size_of($f); - if (defined($s)) { - $size += $s; - } else { - printf STDERR "size for $f not defined, strange ...\n"; - } - } - } - } - return $size; + my ($self,$type,$tltree,$arch) = @_; + my $size = 0; + if ($type eq "bin") { + my %binfiles = %{$self->{'binfiles'}}; + if (defined($binfiles{$arch})) { + foreach $f (@{$binfiles{$arch}}) { + $size += $tltree->size_of($f); + } + } + } else { + if (defined($self->{"${type}files"}) && (@{$self->{"${type}files"}})) { + foreach $f (@{$self->{"${type}files"}}) { + my $s = $tltree->size_of($f); + if (defined($s)) { + $size += $s; + } else { + printf STDERR "size for $f not defined, strange ...\n"; + } + } + } + } + return $size; } sub writeout { - my $self = shift; - my $fd = (@_ ? $_[0] : STDOUT); - format_name $fd "multilineformat"; - print $fd "name ", $self->name, "\n"; - print $fd "category ", $self->category, "\n"; - defined($self->{'revision'}) && print $fd "revision $self->{'revision'}\n"; - defined($self->{'catalogue'}) && print $fd "catalogue $self->{'catalogue'}\n"; - defined($self->{'shortdesc'}) && print $fd "shortdesc $self->{'shortdesc'}\n"; - if (defined($self->{'longdesc'})) { - $_tmp = "longdesc $self->{'longdesc'}"; - write $fd; - } - if (defined($self->{'depends'})) { - foreach (@{$self->{'depends'}}) { - print $fd "depend $_\n"; - } - } - if (defined($self->{'executes'})) { - foreach (@{$self->{'executes'}}) { - print $fd "execute $_\n"; - } - } - if (defined($self->{'docfiles'}) && (@{$self->{'docfiles'}})) { - print $fd "docfiles size=$self->{'docsize'}\n"; - foreach (sort @{$self->{'docfiles'}}) { - print $fd " $_\n"; - } - } - if (defined($self->{'srcfiles'}) && (@{$self->{'srcfiles'}})) { - print $fd "srcfiles size=$self->{'srcsize'}\n"; - foreach (sort @{$self->{'srcfiles'}}) { - print $fd " $_\n"; - } - } - if (defined($self->{'runfiles'}) && (@{$self->{'runfiles'}})) { - print $fd "runfiles size=$self->{'runsize'}\n"; - foreach (sort @{$self->{'runfiles'}}) { - print $fd " $_\n"; - } - } - foreach my $arch (keys %{$self->{'binfiles'}}) { - if (@{$self->{'binfiles'}{$arch}}) { - print $fd "binfiles arch=$arch size=", $self->{'binsize'}{$arch}, "\n"; - foreach (sort @{$self->{'binfiles'}{$arch}}) { - print $fd " $_\n"; - } - } - } + my $self = shift; + my $fd = (@_ ? $_[0] : STDOUT); + format_name $fd "multilineformat"; + print $fd "name ", $self->name, "\n"; + print $fd "category ", $self->category, "\n"; + defined($self->{'revision'}) && print $fd "revision $self->{'revision'}\n"; + defined($self->{'catalogue'}) && print $fd "catalogue $self->{'catalogue'}\n"; + defined($self->{'shortdesc'}) && print $fd "shortdesc $self->{'shortdesc'}\n"; + if (defined($self->{'longdesc'})) { + $_tmp = "$self->{'longdesc'}"; + write $fd; + } + if (defined($self->{'depends'})) { + foreach (@{$self->{'depends'}}) { + print $fd "depend $_\n"; + } + } + if (defined($self->{'executes'})) { + foreach (@{$self->{'executes'}}) { + print $fd "execute $_\n"; + } + } + if (defined($self->{'docfiles'}) && (@{$self->{'docfiles'}})) { + print $fd "docfiles size=$self->{'docsize'}\n"; + foreach (sort @{$self->{'docfiles'}}) { + print $fd " $_\n"; + } + } + if (defined($self->{'srcfiles'}) && (@{$self->{'srcfiles'}})) { + print $fd "srcfiles size=$self->{'srcsize'}\n"; + foreach (sort @{$self->{'srcfiles'}}) { + print $fd " $_\n"; + } + } + if (defined($self->{'runfiles'}) && (@{$self->{'runfiles'}})) { + print $fd "runfiles size=$self->{'runsize'}\n"; + foreach (sort @{$self->{'runfiles'}}) { + print $fd " $_\n"; + } + } + foreach my $arch (keys %{$self->{'binfiles'}}) { + if (@{$self->{'binfiles'}{$arch}}) { + print $fd "binfiles arch=$arch size=", $self->{'binsize'}{$arch}, "\n"; + foreach (sort @{$self->{'binfiles'}{$arch}}) { + print $fd " $_\n"; + } + } + } } sub writeout_simple { - my $self = shift; - my $fd = (@_ ? $_[0] : STDOUT); - format_name $fd "multilineformat"; - print $fd "name ", $self->name, "\n"; - print $fd "category ", $self->category, "\n"; - if (defined($self->{'depends'})) { - foreach (@{$self->{'depends'}}) { - print $fd "depend $_\n"; - } - } - if (defined($self->{'executes'})) { - foreach (@{$self->{'executes'}}) { - print $fd "execute $_\n"; - } - } - if (defined($self->{'docfiles'}) && (@{$self->{'docfiles'}})) { - print $fd "docfiles\n"; - foreach (sort @{$self->{'docfiles'}}) { - print $fd " $_\n"; - } - } - if (defined($self->{'srcfiles'}) && (@{$self->{'srcfiles'}})) { - print $fd "srcfiles\n"; - foreach (sort @{$self->{'srcfiles'}}) { - print $fd " $_\n"; - } - } - if (defined($self->{'runfiles'}) && (@{$self->{'runfiles'}})) { - print $fd "runfiles\n"; - foreach (sort @{$self->{'runfiles'}}) { - print $fd " $_\n"; - } - } - foreach my $arch (sort keys %{$self->{'binfiles'}}) { - if (@{$self->{'binfiles'}{$arch}}) { - print $fd "binfiles arch=$arch\n"; - foreach (sort @{$self->{'binfiles'}{$arch}}) { - print $fd " $_\n"; - } - } - } + my $self = shift; + my $fd = (@_ ? $_[0] : STDOUT); + format_name $fd "multilineformat"; + print $fd "name ", $self->name, "\n"; + print $fd "category ", $self->category, "\n"; + if (defined($self->{'depends'})) { + foreach (@{$self->{'depends'}}) { + print $fd "depend $_\n"; + } + } + if (defined($self->{'executes'})) { + foreach (@{$self->{'executes'}}) { + print $fd "execute $_\n"; + } + } + if (defined($self->{'docfiles'}) && (@{$self->{'docfiles'}})) { + print $fd "docfiles\n"; + foreach (sort @{$self->{'docfiles'}}) { + print $fd " $_\n"; + } + } + if (defined($self->{'srcfiles'}) && (@{$self->{'srcfiles'}})) { + print $fd "srcfiles\n"; + foreach (sort @{$self->{'srcfiles'}}) { + print $fd " $_\n"; + } + } + if (defined($self->{'runfiles'}) && (@{$self->{'runfiles'}})) { + print $fd "runfiles\n"; + foreach (sort @{$self->{'runfiles'}}) { + print $fd " $_\n"; + } + } + foreach my $arch (sort keys %{$self->{'binfiles'}}) { + if (@{$self->{'binfiles'}{$arch}}) { + print $fd "binfiles arch=$arch\n"; + foreach (sort @{$self->{'binfiles'}{$arch}}) { + print $fd " $_\n"; + } + } + } } sub make_zip { - my ($self,$tltree,$destdir,$zipname) = @_; - my $zipn; - if (not(defined($zipname))) { - $zipname = $self->name . ".zip"; - } - if (not(defined($destdir))) { - $destdir = TeXLive::TLPOBJ->zipdir; - } - die("Undefined tltree argument!") if (not(defined($tltree))); - # first build the arch independet part - $self->_make_zip($tltree,$destdir,$zipname,"all"); - # now the $pkg.$arch.zip - if ($self->is_arch_dependent) { - foreach my $t (keys %{$self->{'binfiles'}}) { - &TeXLive::TLUtils::debug("arch=$t\n"); - if ($zipname =~ /^(.*)\.zip$/) { - $zipn = "$1.$t.zip"; - } else { - $zipn = "$zipname.$t.zip"; - } - $self->_make_zip($tltree,$destdir,$zipn,$t); - } - } + my ($self,$tltree,$destdir,$zipname) = @_; + my $zipn; + if (not(defined($zipname))) { + $zipname = $self->name . ".zip"; + } + if (not(defined($destdir))) { + $destdir = TeXLive::TLPOBJ->zipdir; + } + die("Undefined tltree argument!") if (not(defined($tltree))); + # first build the arch independet part + $self->_make_zip($tltree,$destdir,$zipname,"all"); + # now the $pkg.$arch.zip + if ($self->is_arch_dependent) { + foreach my $t (keys %{$self->{'binfiles'}}) { + &TeXLive::TLUtils::debug("arch=$t\n"); + if ($zipname =~ /^(.*)\.zip$/) { + $zipn = "$1.$t.zip"; + } else { + $zipn = "$zipname.$t.zip"; + } + $self->_make_zip($tltree,$destdir,$zipn,$t); + } + } } sub _make_zip { - my ($self,$tltree,$destdir,$zipname,$arch) = @_; - my $root = $tltree->svnroot; - my @files = (); - my $zipcmd; - if ($arch ne "all") { - push @files, @{$self->{'binfiles'}{$arch}}; - } else { - push @files, $self->runfiles; - push @files, $self->docfiles; - push @files, $self->srcfiles; - } - # note that the Tpm.pm module had something like - # if ($zipname =~ /\/binary/ && $^O !~ /MSWin32/) { - # $zipcmd = "| zip -9\@ory " - # } else { - # $zipcmd = "| zip -9\@or " - # } - if ($^O =~ /MSWin32/) { - $nul = "nul"; - $zipcmd = "| zip -9\@or " - } else { - $nul = "/dev/null"; - $zipcmd = "| zip -9\@ory " - } - @files = TeXLive::TLUtils::sort_uniq(@files); - if (!@files) { - &TeXLive::TLUtils::debug("Not creating empty zip file $zipname\n"); - return; - } - &mkpath("$destdir") if (! -d "$destdir"); - my $cwd = &getcwd; - chdir($tltree->svnroot); - unlink($zipname); - print $zipcmd . "$destdir/$zipname" . " > $nul\n" if ($::opt_debug); - open ZIP, $zipcmd . "$destdir/$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); + my ($self,$tltree,$destdir,$zipname,$arch) = @_; + my $root = $tltree->svnroot; + my @files = (); + my $zipcmd; + if ($arch ne "all") { + push @files, @{$self->{'binfiles'}{$arch}}; + } else { + push @files, $self->runfiles; + push @files, $self->docfiles; + push @files, $self->srcfiles; + } + # note that the Tpm.pm module had something like + # if ($zipname =~ /\/binary/ && $^O !~ /MSWin32/) { + # $zipcmd = "| zip -9\@ory " + # } else { + # $zipcmd = "| zip -9\@or " + # } + if ($^O =~ /MSWin32/) { + $nul = "nul"; + $zipcmd = "| zip -9\@or " + } else { + $nul = "/dev/null"; + $zipcmd = "| zip -9\@ory " + } + @files = TeXLive::TLUtils::sort_uniq(@files); + if (!@files) { + &TeXLive::TLUtils::debug("Not creating empty zip file $zipname\n"); + return; + } + &mkpath("$destdir") if (! -d "$destdir"); + my $cwd = &getcwd; + chdir($tltree->svnroot); + unlink($zipname); + print $zipcmd . "$destdir/$zipname" . " > $nul\n" if ($::opt_debug); + open ZIP, $zipcmd . "$destdir/$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); } sub is_arch_dependent { - my $self = shift; - if (keys %{$self->{'binfiles'}}) { - return 1; - } else { - return 0; - } + my $self = shift; + if (keys %{$self->{'binfiles'}}) { + return 1; + } else { + return 0; + } } # computes the total size of a package # if no arguments are given this is -# docsize + runsize + srcsize + max of binsizes +# docsize + runsize + srcsize + max of binsizes sub total_size { - my ($self,@archs) = @_; - my $ret = $self->docsize + $self->runsize + $self->srcsize; - if ($self->is_arch_dependent) { - my $max = 0; - my %foo = %{$self->binsizes}; - foreach my $k (keys %foo) { - $max = $foo{$k} if ($foo{$k} > $max); - } - $ret += $max; - } - return($ret); + my ($self,@archs) = @_; + my $ret = $self->docsize + $self->runsize + $self->srcsize; + if ($self->is_arch_dependent) { + my $max = 0; + my %foo = %{$self->binsizes}; + foreach my $k (keys %foo) { + $max = $foo{$k} if ($foo{$k} > $max); + } + $ret += $max; + } + return($ret); } # # member access functions # sub name { - my $self = shift; - if (@_) { $self->{'name'} = shift } - return $self->{'name'}; + my $self = shift; + if (@_) { $self->{'name'} = shift } + return $self->{'name'}; } sub category { - my $self = shift; - if (@_) { $self->{'category'} = shift } - return $self->{'category'}; + my $self = shift; + if (@_) { $self->{'category'} = shift } + return $self->{'category'}; } sub shortdesc { - my $self = shift; - if (@_) { $self->{'shortdesc'} = shift } - return $self->{'shortdesc'}; + my $self = shift; + if (@_) { $self->{'shortdesc'} = shift } + return $self->{'shortdesc'}; } sub longdesc { - my $self = shift; - if (@_) { $self->{'longdesc'} = shift } - return $self->{'longdesc'}; + my $self = shift; + if (@_) { $self->{'longdesc'} = shift } + return $self->{'longdesc'}; } sub revision { - my $self = shift; - if (@_) { $self->{'revision'} = shift } - return $self->{'revision'}; + my $self = shift; + if (@_) { $self->{'revision'} = shift } + return $self->{'revision'}; } sub catalogue { - my $self = shift; - if (@_) { $self->{'catalogue'} = shift } - return $self->{'catalogue'}; + my $self = shift; + if (@_) { $self->{'catalogue'} = shift } + return $self->{'catalogue'}; } sub srcfiles { - my $self = shift; - if (@_) { @{ $self->{'srcfiles'} } = @_ } - return @{ $self->{'srcfiles'} }; + my $self = shift; + if (@_) { @{ $self->{'srcfiles'} } = @_ } + return @{ $self->{'srcfiles'} }; } sub srcsize { - my $self = shift; - if (@_) { $self->{'srcsize'} = shift } - return ( defined($self->{'srcsize'}) ? $self->{'srcsize'} : 0 ); + my $self = shift; + if (@_) { $self->{'srcsize'} = shift } + return ( defined($self->{'srcsize'}) ? $self->{'srcsize'} : 0 ); } sub add_srcfiles { - my ($self,@files) = @_; - $self->add_files("src",@files); + my ($self,@files) = @_; + $self->add_files("src",@files); } sub remove_srcfiles { - my ($self,@files) = @_; - $self->remove_files("src",@files); + my ($self,@files) = @_; + $self->remove_files("src",@files); } sub docfiles { - my $self = shift; - if (@_) { @{ $self->{'docfiles'} } = @_ } - return @{ $self->{'docfiles'} }; + my $self = shift; + if (@_) { @{ $self->{'docfiles'} } = @_ } + return @{ $self->{'docfiles'} }; } sub docsize { - my $self = shift; - if (@_) { $self->{'docsize'} = shift } - return ( defined($self->{'docsize'}) ? $self->{'docsize'} : 0 ); + my $self = shift; + if (@_) { $self->{'docsize'} = shift } + return ( defined($self->{'docsize'}) ? $self->{'docsize'} : 0 ); } sub add_docfiles { - my ($self,@files) = @_; - $self->add_files("doc",@files); + my ($self,@files) = @_; + $self->add_files("doc",@files); } sub remove_docfiles { - my ($self,@files) = @_; - $self->remove_files("doc",@files); + my ($self,@files) = @_; + $self->remove_files("doc",@files); } sub binfiles { - my $self = shift; - my %newfiles = @_; - if (@_) { $self->{'binfiles'} = \%newfiles } - return $self->{'binfiles'}; + my $self = shift; + my %newfiles = @_; + if (@_) { $self->{'binfiles'} = \%newfiles } + return $self->{'binfiles'}; } sub binsizes { - my $self = shift; - my %newsizes = @_; - if (@_) { $self->{'binsizes'} = \%newsizes } - return $self->{'binsizes'}; + my $self = shift; + my %newsizes = @_; + if (@_) { $self->{'binsizes'} = \%newsizes } + return $self->{'binsizes'}; } sub add_binfiles { - my ($self,$arch,@files) = @_; - &TeXLive::TLUtils::push_uniq(\@{ $self->{'binfiles'}{$arch} }, @files); + my ($self,$arch,@files) = @_; + &TeXLive::TLUtils::push_uniq(\@{ $self->{'binfiles'}{$arch} }, @files); } sub remove_binfiles { - my ($self,$arch,@files) = @_; - my @finalfiles; - foreach my $f (@{$self->{'binfiles'}{$arch}}) { - if (not(&TeXLive::TLUtils::member($f,@files))) { - push @finalfiles,$f; - } - } - $self->{'binfiles'}{$arch} = [ @finalfiles ]; + my ($self,$arch,@files) = @_; + my @finalfiles; + foreach my $f (@{$self->{'binfiles'}{$arch}}) { + if (not(&TeXLive::TLUtils::member($f,@files))) { + push @finalfiles,$f; + } + } + $self->{'binfiles'}{$arch} = [ @finalfiles ]; } sub runfiles { - my $self = shift; - if (@_) { @{ $self->{'runfiles'} } = @_ } - return @{ $self->{'runfiles'} }; + my $self = shift; + if (@_) { @{ $self->{'runfiles'} } = @_ } + return @{ $self->{'runfiles'} }; } sub runsize { - my $self = shift; - if (@_) { $self->{'runsize'} = shift } - return ( defined($self->{'runsize'}) ? $self->{'runsize'} : 0 ); + my $self = shift; + if (@_) { $self->{'runsize'} = shift } + return ( defined($self->{'runsize'}) ? $self->{'runsize'} : 0 ); } sub add_runfiles { - my ($self,@files) = @_; - $self->add_files("run",@files); + my ($self,@files) = @_; + $self->add_files("run",@files); } sub remove_runfiles { - my ($self,@files) = @_; - $self->remove_files("run",@files); + my ($self,@files) = @_; + $self->remove_files("run",@files); } sub add_files { - my ($self,$type,@files) = @_; - die("Cannot use add_files for binfiles, we need that arch!") if ($type eq "bin"); - &TeXLive::TLUtils::push_uniq(\@{ $self->{"${type}files"} }, @files); + my ($self,$type,@files) = @_; + die("Cannot use add_files for binfiles, we need that arch!") if ($type eq "bin"); + &TeXLive::TLUtils::push_uniq(\@{ $self->{"${type}files"} }, @files); } sub remove_files { - my ($self,$type,@files) = @_; - die("Cannot use add_files for binfiles, we need that arch!") if ($type eq "bin"); - my @finalfiles; - foreach my $f (@{$self->{"${type}files"}}) { - if (not(&TeXLive::TLUtils::member($f,@files))) { - push @finalfiles,$f; - } - } - $self->{"${type}files"} = [ @finalfiles ]; + my ($self,$type,@files) = @_; + die("Cannot use add_files for binfiles, we need that arch!") if ($type eq "bin"); + my @finalfiles; + foreach my $f (@{$self->{"${type}files"}}) { + if (not(&TeXLive::TLUtils::member($f,@files))) { + push @finalfiles,$f; + } + } + $self->{"${type}files"} = [ @finalfiles ]; } sub depends { - my $self = shift; - if (@_) { @{ $self->{'depends'} } = @_ } - return @{ $self->{'depends'} }; + my $self = shift; + if (@_) { @{ $self->{'depends'} } = @_ } + return @{ $self->{'depends'} }; } sub executes { - my $self = shift; - if (@_) { @{ $self->{'executes'} } = @_ } - return @{ $self->{'executes'} }; + my $self = shift; + if (@_) { @{ $self->{'executes'} } = @_ } + return @{ $self->{'executes'} }; } sub zipdir { - my @self = shift; - if (@_) { $_zipdir = $_[0] } - return $_zipdir; + my @self = shift; + if (@_) { $_zipdir = $_[0] } + return $_zipdir; } 1; @@ -576,15 +576,13 @@ sub zipdir { ###### Formats format multilineformat = -^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -$_tmp - ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~ +longdesc ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~ $_tmp . ### Local Variables: -### perl-indent-level: 4 -### tab-width: 4 -### indent-tabs-mode: t +### perl-indent-level: 2 +### tab-width: 2 +### indent-tabs-mode: nil ### End: -# vim:set tabstop=4: # +# vim:set tabstop=2: # |