1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
|
#!/usr/bin/env perl
# $Id: tl-update-containers 5188 2007-10-14 20:32:44Z karl $
# Copyright 2008 Norbert Preining
# This file is licensed under the GNU General Public License version 2
# or any later version.
#
# Generate archive file(s) for the packages specified on the cmdline
# (doesn't really work, not documented), or all if none specified.
BEGIN {
$^W = 1;
($mydir = $0) =~ s,/[^/]*$,,;
unshift (@INC, "$mydir/..");
}
use strict;
use TeXLive::TLConfig;
use TeXLive::TLPOBJ;
use TeXLive::TLPDB;
use TeXLive::TLUtils;
use Getopt::Long;
use Pod::Usage;
use File::Path;
our $mydir;
my $opt_debug = 0;
my $opt_location = ".";
my $opt_relative = 0;
my $opt_recreate = 0;
my $help = 0;
GetOptions(
"location=s" => \$opt_location,
"debug!" => \$opt_debug,
"recreate" => \$opt_recreate,
"help|?" => \$help) or pod2usage(1);
pod2usage(-exitstatus => 0, -verbose => 2) if $help;
if ($opt_debug) {
$::LOGLEVELFILE = $::LOG_DDDEBUG;
$::LOGLEVELTERMINAL = $::LOG_DDDEBUG;
}
exit (&main ());
sub main
{
# get the db.
chomp(my $Master = `cd $mydir/../.. && pwd`); # xx TLPDB should default
my $tlpdb = TeXLive::TLPDB->new("root" => $Master);
die "cannot find tlpdb in $Master" unless defined($tlpdb);
my @packs = @ARGV ? @ARGV : $tlpdb->list_packages;
# get configuration of package splitting
my $srcsplit = $tlpdb->config_src_container;
my $docsplit = $tlpdb->config_doc_container;
my $format = $tlpdb->config_container_format;
my $type = "lzma";
if (($format eq "lzma") || ($format eq "zip")) {
$type = $format;
} else {
warn "$0: unknown container format specified in 00texlive.config: $format"
. "; ignoring and continuing with $type";
}
tllog($::LOG_DEBUG, "format=$type srcsplit=$srcsplit docsplit=$docsplit\n");
my @todopacks = ();
my $opt_containerdir = "$opt_location/$TeXLive::TLConfig::NetArchive";
my %count;
if ($opt_recreate) {
@todopacks = $tlpdb->list_packages();
} else {
my $nettlpdb = TeXLive::TLPDB->new(root => $opt_location);
if (!defined($nettlpdb)) {
die "Cannot init tlpdb from $opt_location ...";
}
my %archiverevs;
foreach my $pkg ($nettlpdb->list_packages()) {
$archiverevs{$pkg} = $nettlpdb->get_package($pkg)->revision();
}
# collect packages to be updated.
$count{"new"} = $count{"removed"} = $count{"updated"} = $count{"unchanged"}
= 0;
for my $pkg (@packs) {
next if ($pkg eq "00texlive.config");
next if ($pkg eq "00texlive.installer");
my $oldrev = 0;
if (-r "$opt_containerdir/$pkg.tar.$type"
&& defined($archiverevs{$pkg})) {
$oldrev = $archiverevs{$pkg};
} else {
tllog($::LOG_NORMAL, "$pkg is new, found no containers\n");
$count{"new"}++;
}
my $tlp = $tlpdb->get_package($pkg);
my $newrev = 0;
if (defined($tlp)) {
$newrev = $tlp->revision;
} else {
tllog($::LOG_NORMAL, "$pkg has disappeared, removing its containers\n");
`rm $opt_containerdir/$pkg.*`;
$count{"removed"}++;
}
if ($oldrev == $newrev) {
tllog($::LOG_DEBUG, "$pkg up to date\n");
$count{"unchanged"}++;
} elsif ($oldrev < $newrev) {
push @todopacks, $pkg;
$count{"updated"}++ if $oldrev;
} else {
die "This shouldn't happen! The revision of $pkg in texlive.tlpdb"
. "($newrev) is OLDER than the one in"
. "$opt_location/tlpkg/texlive.tlpdb ($oldrev), goodbye";
}
}
}
# get list of packages.
for my $pkg (sort @todopacks) {
next if ($pkg eq "00texlive.config");
next if ($pkg eq "00texlive.installer");
my $obj = $tlpdb->get_package ($pkg);
die "$0: no TL package named $pkg in $Master" if ! $obj;
tllog($::LOG_DEBUG, "updating $pkg containers ...\n");
# we have to make a copy otherwise the src/doc files in the original
# tlpobj are removed, and thus also in the tlpdb to be saved!!!
my $objcopy = $obj->copy;
if ($srcsplit) {
my $objsrc = $obj->srcfiles_package;
$objcopy->clear_srcfiles;
if ($objsrc) {
$objsrc->make_container($type, $Master, $opt_containerdir,
"$pkg.source", $opt_relative);
}
}
if ($docsplit) {
my $objdoc = $obj->docfiles_package;
$objcopy->clear_docfiles;
if ($objdoc) {
$objdoc->make_container($type, $Master, $opt_containerdir,
"$pkg.doc", $opt_relative);
}
}
$objcopy->make_container($type, $Master, $opt_containerdir,
$pkg, $opt_relative);
}
if (@todopacks) {
# we updated something
print "$0: $count{new} new, $count{removed} removed, "
. "$count{updated} updated, $count{unchanged} unchanged.\n";
# Finally we copy the source tlpdb over to the destination tlpdb
} else {
print "$0: nothing to be done.\n";
}
# STRANGE: It seems that calling -recreate did somehow not safe the
# docfiles into the texlive.tlpdb, no idea why. So update should now
# do that
$tlpdb->root($opt_location);
$tlpdb->save;
system("lzma -k -z $opt_location/tlpkg/texlive.tlpdb");
}
__END__
=head1 NAME
tl-update-containers - create, update, or remove TL containers
=head1 SYNOPSIS
tl-update-containers [OPTION]...
=head1 OPTIONS
=over 8
=item B<-containerdir> I<containerdir>
The location to find the previously generated containers;
default is C<./tlpkg>. If this is changed so that the containers appear
in a different directory on the net, then you need to also
specify C<<--netarchive>> to C<install-tl.pl> or they will not be found.
=back
The standard options C<-help> and C<-debug> are also accepted.
See the tlpfiles documentation for details.
The format of the containers and the splitting off of source and
documentation files are controlled by the TLPDB options in the
pseudo-package C<00texlive.config>. See the documentation for TLPDB.
=head1 DESCRIPTION
The B<tl-update-containers> program compares the revision of each
package found in C<containerdir> with the revision of the same package
in C<texlive.tlpdb>, found relative to this script. Where the latter is
newer (i.e., a higher number), the container(s) for the package are
updated. Where the container(s) do not exist, they are created. When
the package no longer exists in tlpdb, the container(s) are removed.
=head1 AUTHORS AND COPYRIGHT
This script and its documentation were written for the TeX Live
distribution (L<http://tug.org/texlive>) and both are licensed under the
GNU General Public License Version 2 or later.
=cut
### Local Variables:
### perl-indent-level: 2
### tab-width: 2
### indent-tabs-mode: nil
### End:
# vim:set tabstop=2 expandtab: #
|
