summaryrefslogtreecommitdiff
path: root/Master/tlpkg/TeXLive/TLPDB.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/TeXLive/TLPDB.pm')
-rw-r--r--Master/tlpkg/TeXLive/TLPDB.pm187
1 files changed, 134 insertions, 53 deletions
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index 0fdf61039ec..bd0458c963e 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -214,49 +214,49 @@ sub from_file {
my $tlpdbfile;
if ($path =~ m;^((http|ftp)://|file:\/\/*);) {
debug("TLPDB.pm: trying to initialize from $path\n");
- # if we have lzmadec available we try the lzma file
- if (defined($::progs{'lzmadec'})) {
- # we first try the lzma compressed file
+ # if we have xzdec available we try the xz file
+ if (defined($::progs{'xzdec'})) {
+ # we first try the xz compressed file
my $tmpdir = TeXLive::TLUtils::get_system_tmpdir();
my $bn = TeXLive::TLUtils::basename("$path");
- my $lzmafile = "$tmpdir/$bn.$$.lzma";
- my $lzmafile_quote = $lzmafile;
+ my $xzfile = "$tmpdir/$bn.$$.xz";
+ my $xzfile_quote = $xzfile;
# this is a variable of the whole sub as we have to remove the file
# before returning
$tlpdbfile = "$tmpdir/$bn.$$";
my $tlpdbfile_quote = $tlpdbfile;
if (win32()) {
- $lzmafile =~ s!/!\\!g;
+ $xzfile =~ s!/!\\!g;
$tlpdbfile =~ s!/!\\!g;
}
- $lzmafile_quote = "\"$lzmafile\"";
+ $xzfile_quote = "\"$xzfile\"";
$tlpdbfile_quote = "\"$tlpdbfile\"";
- debug("trying to download $path.lzma to $lzmafile\n");
- my $ret = TeXLive::TLUtils::download_file("$path.lzma", "$lzmafile");
+ debug("trying to download $path.xz to $xzfile\n");
+ my $ret = TeXLive::TLUtils::download_file("$path.xz", "$xzfile");
# better to check both, the return value AND the existence of the file
- if ($ret && (-r "$lzmafile")) {
+ if ($ret && (-r "$xzfile")) {
# ok, let the fun begin
- debug("un-lzmaing $lzmafile to $tlpdbfile\n");
- # lzmadec *hopefully* returns 0 on success and anything else on failure
+ debug("un-xzing $xzfile to $tlpdbfile\n");
+ # xzdec *hopefully* returns 0 on success and anything else on failure
# we don't have to negate since not zero means error in the shell
# and thus in perl true
- if (system("$::progs{'lzmadec'} <$lzmafile_quote >$tlpdbfile_quote")) {
- debug("un-lzmaing $lzmafile failed, tryin gplain file\n");
- # to be sure we unlink the lzma file and the tlpdbfile
- unlink($lzmafile);
+ if (system("$::progs{'xzdec'} <$xzfile_quote >$tlpdbfile_quote")) {
+ debug("un-xzing $xzfile failed, tryin gplain file\n");
+ # to be sure we unlink the xz file and the tlpdbfile
+ unlink($xzfile);
unlink($tlpdbfile);
} else {
- unlink($lzmafile);
+ unlink($xzfile);
open($retfh, "<$tlpdbfile") || die "$0: open($tlpdbfile) failed: $!";
- debug("found the uncompressed lzma file\n");
+ debug("found the uncompressed xz file\n");
}
}
} else {
- debug("no lzmadec defined, not trying tlpdb.lzma ...\n");
+ debug("no xzdec defined, not trying tlpdb.xz ...\n");
}
if (!defined($retfh)) {
- debug("TLPDB: downloading $path.lzma didn't succeed, try $path\n");
- # lzma did not succeed, so try the normal file
+ debug("TLPDB: downloading $path.xz didn't succeed, try $path\n");
+ # xz did not succeed, so try the normal file
$retfh = TeXLive::TLUtils::download_file($path, "|");
if (!$retfh) {
die "open tlpdb($path) failed: $!";
@@ -277,7 +277,7 @@ sub from_file {
}
} until (!$ret);
tlwarn("unusable location $path, could not load any packages\n") if (!$found);
- # remove the un-lzma-ed tlpdb file from temp dir
+ # remove the un-xz-ed tlpdb file from temp dir
# THAT IS RACY!!! we should fix that in some better way with tempfile
unlink($tlpdbfile) if $tlpdbfile;
return($found);
@@ -394,13 +394,13 @@ sub _add_tlpcontainer {
$container .= ".zip";
$unpackprog="unzip";
$args="-o -qq $container -d $dest";
- } elsif (-r "$container.lzma") {
- $container .= ".lzma";
+ } elsif (-r "$container.xz") {
+ $container .= ".xz";
$unpackprog="NO_IDEA_HOW_TO_UNPACK_LZMA";
$args="NO IDEA WHAT ARGS IT NEEDS";
- die "$0: lzma checked for but not implemented, maybe update TLPDB.pm";
+ die "$0: xz checked for but not implemented, maybe update TLPDB.pm";
} else {
- die "$0: No package $container (.zip or .lzma) in $ziplocation";
+ die "$0: No package $container (.zip or .xz) in $ziplocation";
}
tlwarn("Huuu, this needs testing and error checking!\n");
tlwarn("Should we use -a -- adapt line endings etc?\n");
@@ -788,7 +788,7 @@ Return the location of the actual C<texlive.tlpdb> file used. This is a
read-only function; you cannot change the root of the TLPDB using this
function.
-See C<00texlive-installation.config.tlpsrc> for a description of the
+See C<00texlive.installation.tlpsrc> for a description of the
special value C<__MASTER>.
=cut
@@ -1110,12 +1110,16 @@ Need to be documented
=cut
sub _set_option_value {
- my ($self,$key,$value) = @_;
- my $pkg = $self->{'tlps'}{'00texlive-installation.config'};
+ my $self = shift;
+ $self->_set_option_value_pkg('00texlive.installation', @_);
+}
+sub _set_option_value_pkg {
+ my ($self,$pkgname,$key,$value) = @_;
+ my $pkg = $self->{'tlps'}{$pkgname};
my @newdeps;
if (!defined($pkg)) {
$pkg = new TeXLive::TLPOBJ;
- $pkg->name("00texlive-installation.config");
+ $pkg->name($pkgname);
$pkg->category("TLCore");
push @newdeps, "$key:$value";
} else {
@@ -1133,20 +1137,25 @@ sub _set_option_value {
}
}
$pkg->depends(@newdeps);
- $self->{'tlps'}{'00texlive-installation.config'} = $pkg;
+ $self->{'tlps'}{$pkgname} = $pkg;
}
sub _option_value {
- my ($self,$key) = @_;
- if (defined($self->{'tlps'}{'00texlive-installation.config'})) {
- foreach my $d ($self->{'tlps'}{'00texlive-installation.config'}->depends) {
+ my $self = shift;
+ $self->_option_value_pkg('00texlive.installation', @_);
+}
+
+sub _option_value_pkg {
+ my ($self,$pkg,$key) = @_;
+ if (defined($self->{'tlps'}{$pkg})) {
+ foreach my $d ($self->{'tlps'}{$pkg}->depends) {
if ($d =~ m!^$key:(.*)$!) {
return "$1";
}
}
return;
}
- tlwarn("00texlive-installation.config not found, cannot read option $key.\n");
+ tlwarn("$pkg not found, cannot read option $key.\n");
return;
}
@@ -1156,6 +1165,15 @@ sub option {
if (@_) { $self->_set_option_value($key, shift); }
return $self->_option_value($key);
}
+
+sub option_pkg {
+ my $self = shift;
+ my $pkg = shift;
+ my $key = shift;
+ if (@_) { $self->_set_option_value_pkg($pkg, $key, shift); }
+ return $self->_option_value_pkg($pkg, $key);
+}
+
# TODO the above function should be used in the functions below as
# far as possible ...
@@ -1179,6 +1197,31 @@ sub option_create_symlinks {
if (@_) { $self->_set_option_value("opt_create_symlinks", shift); }
return $self->_option_value("opt_create_symlinks");
}
+sub option_desktop_integration {
+ my $self = shift;
+ if (@_) { $self->_set_option_value("opt_desktop_integration", shift); }
+ return $self->_option_value("opt_desktop_integration");
+}
+sub option_file_assocs {
+ my $self = shift;
+ if (@_) { $self->_set_option_value("opt_file_assocs", shift); }
+ return $self->_option_value("opt_file_assocs");
+}
+sub option_post_code {
+ my $self = shift;
+ if (@_) { $self->_set_option_value("opt_post_code", shift); }
+ return $self->_option_value("opt_post_code");
+}
+sub option_path {
+ my $self = shift;
+ if (@_) { $self->_set_option_value("opt_path", shift); }
+ return $self->_option_value("opt_path");
+}
+sub option_w32_multi_user {
+ my $self = shift;
+ if (@_) { $self->_set_option_value("opt_w32_multi_user", shift); }
+ return $self->_option_value("opt_w32_multi_user");
+}
sub option_install_docfiles {
my $self = shift;
if (@_) { $self->_set_option_value("opt_install_docfiles", shift); }
@@ -1239,26 +1282,64 @@ containing only those formats present in the installation.
=cut
sub fmtutil_cnf_lines {
my $self = shift;
- my %fmtcnffiles;
- foreach my $p ($self->list_packages) {
- my $obj = $self->get_package ($p);
- die "$0: No TeX Live package named $p, strange" if ! $obj;
+ my @fmtlines = ();
+
+ foreach my $pkg ($self->list_packages) {
+ my $obj = $self->get_package ($pkg);
+ die "No TeX Live package named $pkg, too strange" if ! $obj;
+ my $first = 1;
foreach my $e ($obj->executes) {
- if ($e =~ m/BuildFormat (.*)$/) {
- $fmtcnffiles{$1} = 1;
- }
- # others are ignored here
+ if ($e =~ m/AddFormat\s+(.*)\s*/) {
+ my $name;
+ my $engine;
+ my $patterns = "-";
+ my $options = "";
+ my $mode = "";
+ if ($first) {
+ push @fmtlines, "# from $pkg:\n";
+ $first = 0;
+ }
+ foreach my $p (&TeXLive::TLUtils::quotewords('\s+', 0, "$1")) {
+ # foreach my $p (split(' ', $1)) {
+ my ($a, $b);
+ if ($p =~ m/^(name|engine|mode|patterns|options)=(.*)$/) {
+ $a = $1;
+ $b = $2;
+ } else {
+ die "Unknown format directive in $pkg: $e";
+ }
+ if ($a eq "name") {
+ die "AddFormat line needs name=something: $pkg, $e" unless $b;
+ $name = $b; next;
+ }
+ if ($a eq "engine") {
+ die "AddFormat line needs engine=something: $pkg, $e" unless $b;
+ $engine = $b; next;
+ }
+ if ($a eq "patterns") {
+ $patterns = ( $b ? $b : "-");
+ next;
+ }
+ if ($a eq "mode") {
+ if ($b eq "disabled") {
+ $mode = "#! ";
+ } else {
+ $mode = "";
+ }
+ next;
+ }
+ if ($a eq "options") {
+ $options = ( $b ? $b : "");
+ next;
+ }
+ # should not be reached at all
+ die "Unknown language directive in $pkg: $e";
+ }
+ push @fmtlines, "$mode$name $engine $patterns $options\n";
+ }
}
}
- my @formatlines;
- foreach my $f (sort keys %fmtcnffiles) {
- open(INFILE,"<$self->{'root'}/texmf/fmtutil/format.$f.cnf")
- or tlwarn("Cannot open $self->{'root'}/texmf/fmtutil/format.$f.cnf\nThe generated fmtutil.cnf file might be incomplete.\nError: $!\n");
- @tmp = <INFILE>;
- close(INFILE);
- push @formatlines, @tmp;
- }
- return(@formatlines);
+ return @fmtlines;
}
=item C<< $tlpdb->updmap_cfg_lines >>
@@ -1420,7 +1501,7 @@ named C<package.source.extension> and C<package.doc.extension>.
=item C<container_format/I<format>>
This option specifies a format for containers. The currently supported
-formats are C<lzma> and C<zip>. But note that C<zip> is untested.
+formats are C<xz> and C<zip>. But note that C<zip> is untested.
=back