diff options
author | Karl Berry <karl@freefriends.org> | 2008-10-30 23:53:32 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2008-10-30 23:53:32 +0000 |
commit | 21d4b8295b97ae4c4d29d2078df8dd9ac17dd2bb (patch) | |
tree | 15874c46a2bcc773cf4215232e0e13b40e8a1150 /Master/tlpkg/TeXLive/TLPSRC.pm | |
parent | 340b2f9342a45371be3c91cd28c13354f3160786 (diff) |
TeXLive/TLPSRC.pm (autopatterns): new global.
(find_default_patterns): new fn for getting default patterns.
(make_tlpobj): call it; third arg now dir in which to find autopatterns.
TeXLive/TLUtils.pm (debug_hash): new fn.
bin/tlpsrc2tlpdb: move new defalt pattern logic to TLPSRC.pm, change call.
bin/place: change call.
git-svn-id: svn://tug.org/texlive/trunk@11129 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/TeXLive/TLPSRC.pm')
-rw-r--r-- | Master/tlpkg/TeXLive/TLPSRC.pm | 81 |
1 files changed, 73 insertions, 8 deletions
diff --git a/Master/tlpkg/TeXLive/TLPSRC.pm b/Master/tlpkg/TeXLive/TLPSRC.pm index 0a0eb0faeb4..e21d938b6c9 100644 --- a/Master/tlpkg/TeXLive/TLPSRC.pm +++ b/Master/tlpkg/TeXLive/TLPSRC.pm @@ -14,6 +14,7 @@ use TeXLive::TLPOBJ; use TeXLive::TLTREE; my $_tmp; +my %autopatterns; # computed once internally sub new { @@ -201,11 +202,10 @@ sub writeout # sub make_tlpobj { - my ($self,$tltree,$defaultpatterns) = @_; - my %patterns; - if (defined($defaultpatterns)) { - %patterns = %{$defaultpatterns}; - } + my ($self,$tltree,$autopattern_root) = @_; + my %allpatterns = &find_default_patterns($autopattern_root); + my $category_patterns = $allpatterns{$self->category}; + my $tlp = TeXLive::TLPOBJ->new; $tlp->name($self->name); $tlp->category($self->category); @@ -220,7 +220,7 @@ sub make_tlpobj my @allpospats; my @allnegpats; my $pkgname = $self->name; - # + # src/run/doc patterns # # WARNING WARNING WARNING @@ -243,8 +243,10 @@ sub make_tlpobj $usedefault = 0; } } - if ($usedefault && defined($patterns{$pattype})) { - for my $p (@{$patterns{$pattype}}) { + + if ($usedefault && defined($category_patterns)) { + my $type_patterns = $category_patterns->{$pattype}; + for my $p (@{$type_patterns}) { # replace the string %NAME% with the actual package name # we have to make a copy of $p otherwise we change it in the # hash once and for all @@ -261,6 +263,7 @@ sub make_tlpobj # at this point we do NOT do the actual pattern matching for # bin patterns, since we have some specialities to do last if ($pattype eq "bin"); + # for all other patterns we create the list and add the files foreach my $p (@allpospats) { ddebug("pos pattern $p\n"); @@ -384,6 +387,68 @@ sub _do_normal_pattern { } +# get the default patterns for all categories from an external file, +# return hash with keys being the categories (Package, Documentation) +# and values being refs to another hash. The subhash's keys are the +# file types (run bin doc ...) with values being refs to an array of +# patterns for that type. +# +sub find_default_patterns +{ + my ($tlroot) = @_; + # %autopatterns is global. + return %autopatterns if keys %autopatterns; # only compute once + + my $apfile = "$tlroot/tlpkg/tlpsrc/00texlive.autopatterns.tlpsrc"; + die "No autopatterns file found: $apfile" if ! -r $apfile; + + my $tlsrc = new TeXLive::TLPSRC; + $tlsrc->from_file ($apfile); + if ($tlsrc->binpatterns) { + for my $p ($tlsrc->binpatterns) { + my ($cat, @rest) = split ' ', $p; + push @{$autopatterns{$cat}{"bin"}}, join(' ', @rest); + } + } + if ($tlsrc->srcpatterns) { + for my $p ($tlsrc->srcpatterns) { + my ($cat, @rest) = split ' ', $p; + push @{$autopatterns{$cat}{"src"}}, join(' ', @rest); + } + } + if ($tlsrc->docpatterns) { + for my $p ($tlsrc->docpatterns) { + my ($cat, @rest) = split ' ', $p; + push @{$autopatterns{$cat}{"doc"}}, join(' ', @rest); + } + } + if ($tlsrc->runpatterns) { + for my $p ($tlsrc->runpatterns) { + my ($cat, @rest) = split ' ', $p; + push @{$autopatterns{$cat}{"run"}}, join(' ', @rest); + } + } + + for my $cat (keys %autopatterns) { + debug ("Category $cat\n"); + for my $d (@{$autopatterns{$cat}{"bin"}}) { + debug ("Found auto bin pattern $d\n"); + } + for my $d (@{$autopatterns{$cat}{"src"}}) { + debug ("Found auto src pattern $d\n"); + } + for my $d (@{$autopatterns{$cat}{"doc"}}) { + debug ("Found auto doc pattern $d\n"); + } + for my $d (@{$autopatterns{$cat}{"run"}}) { + debug ("Found auto run pattern $d\n"); + } + } + + return %autopatterns; +} + + # member access functions # sub _srcfile { |