diff options
author | Norbert Preining <preining@logic.at> | 2009-05-12 15:53:11 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2009-05-12 15:53:11 +0000 |
commit | 7e5585bcd4f8ba119cad8f0a7e13b6a7a610776f (patch) | |
tree | c48db3cea0e4511d09d0e7b7fdf7ef7a04f68f6e /Master/tlpkg/TeXLive/TLPDB.pm | |
parent | c84165218f94bc15a1441e91a421f4d070bc5eb7 (diff) |
Move most of the stuff from tlpkg, tlmgr from branch to trunk
git-svn-id: svn://tug.org/texlive/trunk@13054 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/TeXLive/TLPDB.pm')
-rw-r--r-- | Master/tlpkg/TeXLive/TLPDB.pm | 187 |
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 |