From ef1fe0008177382d8ad2ddfe21c0b8719022aa90 Mon Sep 17 00:00:00 2001
From: Norbert Preining <preining@logic.at>
Date: Fri, 22 May 2009 13:41:13 +0000
Subject: move the fmtutil.cnf, updmap.cfg, langauge.dat/def generation code
 into TLPOBJ

git-svn-id: svn://tug.org/texlive/trunk@13386 c570f23f-e606-0410-a88d-b1316a301751
---
 Master/tlpkg/TeXLive/TLPOBJ.pm | 194 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 194 insertions(+)

(limited to 'Master/tlpkg/TeXLive/TLPOBJ.pm')

diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm
index f008f10f32e..8bd4e4c8a30 100644
--- a/Master/tlpkg/TeXLive/TLPOBJ.pm
+++ b/Master/tlpkg/TeXLive/TLPOBJ.pm
@@ -910,6 +910,180 @@ sub make_return_hash_from_executes {
   return(\%ret);
 }
 
+
+
+#
+# execute stuff
+#
+sub fmtutil_cnf_lines {
+  my $obj = shift;
+  my @fmtlines = ();
+  my $first = 1;
+  my $pkg = $obj->name;
+  foreach my $e ($obj->executes) {
+    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";
+    }
+  }
+  return @fmtlines;
+}
+
+
+sub updmap_cfg_lines {
+  my $obj = shift;
+  my %maps;
+  foreach my $e ($obj->executes) {
+    if ($e =~ m/addMap (.*)$/) {
+      $maps{$1} = 1;
+    } elsif ($e =~ m/addMixedMap (.*)$/) {
+      $maps{$1} = 2;
+    }
+    # others are ignored here
+  }
+  my @updmaplines;
+  foreach (sort keys %maps) {
+    if ($maps{$_} == 2) {
+      push @updmaplines, "MixedMap $_\n";
+    } else {
+      push @updmaplines, "Map $_\n";
+    }
+  }
+  return(@updmaplines);
+}
+
+
+sub language_dat_lines {
+  sub make_dat_lines {
+    my ($name, $lhm, $rhm, $file, @syn) = @_;
+    my @ret;
+    push @ret, "$name $file\n";
+    foreach (@syn) {
+      push @ret, "=$_\n";
+    }
+    return(@ret);
+  }
+  my $self = shift;
+  my @lines = $self->_parse_hyphen_execute(\&make_dat_lines);
+  return(@lines);
+}
+
+
+sub language_def_lines {
+  sub make_def_lines {
+    my ($name, $lhm, $rhm, $file, @syn) = @_;
+    my $exc = "";
+    my @ret;
+    push @ret, "\\addlanguage\{$name\}\{$file\}\{$exc\}\{$lhm\}\{$rhm\}\n";
+    foreach (@syn) {
+      # synonyms in language.def ???
+      push @ret, "\\addlanguage\{$_\}\{$file\}\{$exc\}\{$lhm\}\{$rhm\}\n";
+      #debug("Ignoring synonym $_ for $name when creating language.def\n");
+    }
+    return(@ret);
+  }
+  my $self = shift;
+  my @lines = $self->_parse_hyphen_execute(\&make_def_lines);
+  return(@lines);
+}
+    
+
+
+sub _parse_hyphen_execute {
+  my ($obj, $coderef) = @_;
+  my @langlines = ();
+  my $pkg = $obj->name;
+  my $first = 1;
+  foreach my $e ($obj->executes) {
+    if ($e =~ m/AddHyphen\s+(.*)\s*/) {
+      my $name;
+      my $lefthyphenmin;
+      my $righthyphenmin;
+      my $file;
+      my @synonyms;
+      if ($first) {
+        push @langlines, "% from $pkg:\n";
+        $first = 0;
+      }
+      foreach my $p (split(' ', $1)) {
+        my ($a, $b) = split /=/, $p;
+        if ($a eq "name") { 
+          die "$0: AddHyphen line needs name=something: $pkg, $e" unless $b;
+          $name = $b; next; 
+        }
+        if ($a eq "lefthyphenmin") { 
+          # lefthyphenmin default to 3
+          $lefthyphenmin = ( $b ? $b : 2 );
+          next;
+        }
+        if ($a eq "righthyphenmin") { 
+          $righthyphenmin = ( $b ? $b : 3); 
+          next; 
+        }
+        if ($a eq "file") { 
+          die "$0: AddHyphen line needs file=something: $pkg, $e" unless $b;
+          $file = $b;
+          next;
+        }
+        if ($a eq "synonyms") {
+          @synonyms = split /,/, $b;
+          next;
+        }
+        die "$0: Unknown language directive in $pkg: $e";
+      }
+      my @foo = &$coderef ($name, $lefthyphenmin, $righthyphenmin,
+                           $file, @synonyms);
+      push @langlines, @foo;
+    }
+  }
+  return @langlines;
+}
+
+
 
 # member access functions
 #
@@ -1435,6 +1609,26 @@ returns a list of all files of all types.
 
 returns a list of all binary files.
 
+=item C<< $tlpobj->fmtutil_cnf_lines >>
+
+The function C<fmtutil_cnf_lines> returns the lines for fmtutil.cnf 
+for this package.
+
+=item C<< $tlpobj->updmap_cfg_lines >>
+
+The function C<updmap_cfg_lines> returns the list lines for updmap.cfg
+for the given package.
+
+=item C<< $tlpobj->language_dat_lines >>
+
+The function C<language_dat_lines> returns the list of all
+lines for language.dat that can be generated from the tlpobj
+
+=item C<< $tlpobj->language_def_lines >>
+
+The function C<language_def_lines> returns the list of all
+lines for language.def that can be generated from the tlpobj.
+
 =back
 
 =head1 SEE ALSO
-- 
cgit v1.2.3