diff options
author | Norbert Preining <preining@logic.at> | 2009-04-28 17:02:15 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2009-04-28 17:02:15 +0000 |
commit | 4339206c571c33145edc07d2bab3bcaad01c678b (patch) | |
tree | 8b9137ddd8adba056118d8399c02f584bf2e03dc | |
parent | 1877317b9327abdb7ea6908db542f0a4fd57bd84 (diff) |
support
postaction script file=.... filew32=...
in tlp code
git-svn-id: svn://tug.org/texlive/branches/branch2009-dev@12837 c570f23f-e606-0410-a88d-b1316a301751
-rw-r--r-- | Master/tlpkg/TeXLive/TLPSRC.pm | 13 | ||||
-rw-r--r-- | Master/tlpkg/TeXLive/TLUtils.pm | 62 |
2 files changed, 40 insertions, 35 deletions
diff --git a/Master/tlpkg/TeXLive/TLPSRC.pm b/Master/tlpkg/TeXLive/TLPSRC.pm index 0032aa28866..41ff0601915 100644 --- a/Master/tlpkg/TeXLive/TLPSRC.pm +++ b/Master/tlpkg/TeXLive/TLPSRC.pm @@ -791,15 +791,14 @@ On W32 associates the file type I<name> with the command I<cmd>. On W32 declares files with the extenstion I<.ext> of file type I<name>. -=item C<postaction on> +=item C<postaction script file=I<file> [filew32=I<filew32>]> -If a package wants to use this postaction it has to drop a file named -C<package.pm> into C<tlpkg/TeXLive/PostActions/>. If that is present -it has to be a proper perl modules, will be loaded with require, and -the functions C<post_install> and C<post_remove> of that module will -be called. +This postaction executes the given I<file> with two arguments, the first +being the root of the installation, the second being either the string +C<install> or C<remove>. -TODO Arguments to the functions have to be specified +If the C<filew32> argument is given this script is run on Windows systems +instead of the one given via C<file>. =back diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm index 7bdc09b777f..d1e47147095 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -1225,17 +1225,19 @@ sub install_package { return 1; } -=item C<do_postaction($how, $tlpobj)> +=item C<do_postaction($how, $tlpobj, $do_fileassocs, $do_shortcuts, $do_script)> -Evaluates the C<postaction> fields in the C<$tlpobj> -MISSING DOCUMENTATION TODO TODO +Evaluates the C<postaction> fields in the C<$tlpobj>. The first parameter +can be either C<install> or C<remove>. The second gives the TLPOBJ whos +postactions should be evaluated, and the last three arguments specify +what type of postactions should (or shouldn't) be evaluated. Returns 1 on success, and 0 on failure. =cut sub do_postaction { - my ($how, $tlpobj, $do_fileassocs, $do_shortcuts, $do_postcode) = @_; + my ($how, $tlpobj, $do_fileassocs, $do_shortcuts, $do_script) = @_; my $ret = 1; if (!defined($tlpobj)) { tlwarn("do_postaction: didn't get a tlpobj\n"); @@ -1253,9 +1255,9 @@ sub do_postaction { } elsif ($pa =~ m/\s*fileassoc\s+(.*)\s*$/) { next unless $do_fileassocs; $ret &&= _do_postaction_fileassoc($how, $tlpobj, $1); - } elsif ($pa =~ m/\s*on\s*$/) { - next unless $do_postcode; - $ret &&= _do_postaction_code($how, $tlpobj); + } elsif ($pa =~ m/\s*script\s+(.*)\s*$/) { + next unless $do_script; + $ret &&= _do_postaction_script($how, $tlpobj, $1); } else { tlwarn("do_postaction: don't know how to do $pa\n"); $ret = 0; @@ -1335,31 +1337,35 @@ sub _do_postaction_filetype { } return 1; } -sub _do_postaction_code { - my ($how, $tlpobj) = @_; - my $n = $tlpobj->name; - my $reqline = "require TeXLive::PostAction::$n;"; - eval { $reqline }; - if ($@) { - tlwarn("Cannot load TeXLive::PostAction::$n\n"); - tlwarn("Post Action for $n disabled!\n"); - tlwarn("Output: $@\n"); + +sub _do_postaction_script { + my ($how, $tlpobj, $pa) = @_; + my ($errors, %keyval) = + parse_into_keywords($pa, qw/file filew32/); + + if ($errors) { + tlwarn("parsing the postaction line >>$pa<< did not succeed!\n"); return 0; } - # now we load it again and evaluate the post install/remove code - if ($how eq "install") { - $reqline .= " TeXLive::PostAction::$n::post_install();"; - } elsif ($how eq "remove") { - $reqline .= " TeXLive::PostAction::$n::post_remove();"; - } else { - tlwarn("Unknown mode $how\n"); + + # file can be an arbitrary string + if (!defined($keyval{'file'})) { + tlwarn("filename of script not given\n"); return 0; } - eval { $reqline }; - if ($@) { - # loading has worked, so assume that calling the function did not work - tlwarn("Cannot run the function TeXLive::PostAction::$n::post_$how\n"); - tlwarn("Output: $@\n"); + my $file = $keyval{'file'}; + my $filew = $file; + $filew = $keyval{'filew32'} if defined($keyval{'filew32'}); + my $texdir = `kpsewhich -var-value=SELFAUTOPARENT`; + chomp($texdir); + my $ret; + my @syscmd; + push @syscmd, (win32() ? $filew : $file), $texdir, $how; + my $ret = system (@syscmd); + if ($ret != 0) { + $ret /= 256 if $ret > 0; + my $pwd = cwd (); + warn "$0: calling post action script $file did not succeed in $pwd, status $ret"; return 0; } return 1; |