[xml/sgml-commit] [SCM] linuxdoc-tools package for Debian. branch, master, updated. debian/0.9.31-5-g870695b

Agustin Martin Domingo agmartin at debian.org
Mon Jun 9 10:20:29 UTC 2008


The following commit has been merged in the master branch:
commit c3409261e47cc55df206c4a1d7843c619dcdb9dc
Author: Agustin Martin Domingo <agmartin at debian.org>
Date:   Mon May 26 22:28:35 2008 +0200

    lib/LinuxDocTools.pm: First cut of a major rewrite
    
    * Code reformatted and trailing whitespace removed. Comments improved.
      Many cosmetic changes. Simplify $global->{NsgmlsPrePipe} handling.
    * ldt_searchfile:
      - New function to look for readabble files in different locations.
      - Make sgml catalogs, backends, entities, styles  and mapping
        searches use it. $file existence check will also use it.
    * Rewritten backends search and load, along woth $format check.
    * Move dtd search from (process_file) to separate functions. This was
      previously done in two ways. We keep both in two functions checking
      both results for consistency.
    * latin1 to sgml conversion moved to a new ldt_latin1tosgml function.
    * Set sgmlpre location through a $global->{sgmlpre} variable
    * Better error handling if temporary dir already exists.
    * Avoid old FileHandle use.
    * Define intermediate file names in a single place outside of the
      functions where they are used. This should simplify renaming them.

diff --git a/lib/LinuxDocTools.pm b/lib/LinuxDocTools.pm
index 8d6cf51..24c0808 100755
--- a/lib/LinuxDocTools.pm
+++ b/lib/LinuxDocTools.pm
@@ -1,4 +1,4 @@
-#! /usr/bin/perl 
+#! /usr/bin/perl
 #
 #  LinuxDocTools.pm
 #
@@ -7,9 +7,11 @@
 #  LinuxDoc-Tools driver core. This contains all the basic functionality
 #  we need to control all other components.
 #
-#  © Copyright 1996, Cees de Groot.
-#  © Copyright 2000, Taketoshi Sano
-#
+#  Copyright © 1996, Cees de Groot.
+#  Copyright © 2000, Taketoshi Sano
+#  Copyright © 2008, Agustin Martin
+# --------------------------------------------------------------------------------
+
 package LinuxDocTools;
 
 require 5.004;
@@ -31,8 +33,8 @@ LinuxDocTools - SGML conversion utilities for LinuxDoc DTD.
 =head1 DESCRIPTION
 
 The LinuxDocTools package encapsulates all the functionality offered by
-LinuxDoc-Tools. It is used, of course, by LinuxDoc-Tools; 
-but the encapsulation should provide for a simple interface for other users as well. 
+LinuxDoc-Tools. It is used, of course, by LinuxDoc-Tools;
+but the encapsulation should provide for a simple interface for other users as well.
 
 =head1 FUNCTIONS
 
@@ -54,7 +56,7 @@ use LinuxDocTools::Vars;
 sub BEGIN
 {
   #
-  #  Make sure we're always looking here. Note that "use lib" adds 
+  #  Make sure we're always looking here. Note that "use lib" adds
   #  on the front of the search path, so we first push dist, then
   #  site, so that site is searched first.
   #
@@ -62,51 +64,221 @@ sub BEGIN
   use lib "$main::DataDir/site";
 }
 
+# -----------------------------------------------------------------------------------
+sub ldt_searchfile {
+# -----------------------------------------------------------------------------------
+# Look for a readable file in the locations. Return first math.
+# -----------------------------------------------------------------------------------
+  my $files = shift;
+  foreach my $file  ( @$files ){
+    return $file if -r $file;
+  }
+}
+
+# -----------------------------------------------------------------------------------
+sub ldt_getdtd_v1 {
+# -----------------------------------------------------------------------------------
+# Get the dtd
+# -----------------------------------------------------------------------------------
+  my $file = shift;
+  my $dtd;
+  my $FILE;
+
+  open ($FILE, "< $file")
+    or die "Could not open \"$file\" for reading. Aborting ...\n";
+
+  while ( <$FILE> ) {
+    tr/A-Z/a-z/;
+    # check for [<!doctype ... system] type definition
+    if ( /<!doctype\s*(\w*)\s*system/ ) {
+      $dtd = $1;
+      last;
+      # check for <!doctype ... PUBLIC ... DTD ...
+    } elsif ( /<!doctype\s*\w*\s*public\s*.*\/\/dtd\s*(\w*)/mi ) {
+      $dtd = $1;
+      last;
+      # check for <!doctype ...
+      #          PUBLIC  ... DTD ...
+      # (multi-line version)
+    } elsif ( /<!doctype\s*(\w*)/ ) {
+      $dtd = "precheck";
+      next;
+    } elsif ( /\s*public\s*.*\/\/dtd\s*(\w*)/ && $dtd eq "precheck" ) {
+      $dtd = $1;
+      last;
+    }
+  }
+  close $FILE;
+
+  # Warn about non-supported DTDs
+  if ( ( $dtd ne "linuxdoc" ) && ( $dtd ne "linuxdoctr" ) ) {
+    print " DTD check - Error: this linuxdoc-tools package supports";
+    print " Linuxdoc DTD only.\n\n";
+
+    # This is Debian Specific, but if debiandoc dtd is used on other system,
+    # then that user may needs the debiandoc-sgml anyway.
+    if ( $dtd eq "debiandoc" ) {
+      print "   If you wish to convert DebianDoc DTD files,\n";
+      print "     then please install and use";
+      print " debiandoc-sgml package.\n\n";
+    } else {
+      print "   If you wish to convert DocBook or other DTD files,\n";
+      print "     then please install and use";
+      print " SGMLTools-Lite or Jade/OpenJade package.\n\n";
+    }
+      die " --- LinuxDoc-Tools aborting.\n";
+  }
+
+  return $dtd;
+}
+
+# -----------------------------------------------------------------------------------
+sub ldt_getdtd_v2 {
+# -----------------------------------------------------------------------------------
+# Second way of getting dtd, fron nsgmls output.
+# -----------------------------------------------------------------------------------
+  my $preaspout = shift;
+  my $dtd2;
+  my $TMP;
+
+  open ($TMP,"< $preaspout")
+    or die "Could not open $preaspout for reading\n";
+  while ( ($dtd2 = <$TMP>) && ! ( $dtd2 =~ /^\(/) ) { };
+  close $TMP;
+  $dtd2 =~ s/^\(//;
+  $dtd2 =~ tr/A-Z/a-z/;
+  chomp $dtd2;
+  return $dtd2;
+}
+
+# -----------------------------------------------------------------------------------
+sub ldt_latin1tosgml {
+# -----------------------------------------------------------------------------------
+# Convert latin1 chars in input filehandle to sgml entities in the returned string
+# -----------------------------------------------------------------------------------
+  my $FILE     = shift;
+  my $sgmlout;
+
+  while (<$FILE>){
+    # Outline these commands later on - CdG
+    #change latin1 characters to SGML
+    #by Farzad Farid, adapted by Greg Hankins
+    s/À/\&Agrave;/g;
+    s/Á/\&Aacute;/g;
+    s/Â/\&Acirc;/g;
+    s/Ã/\&Atilde;/g;
+    s/Ä/\&Auml;/g;
+    s/Å/\&Aring;/g;
+    s/Æ/\&AElig;/g;
+    s/Ç/\&Ccedil;/g;
+    s/È/\&Egrave;/g;
+    s/É/\&Eacute;/g;
+    s/Ê/\&Ecirc;/g;
+    s/Ë/\&Euml;/g;
+    s/Ì/\&Igrave;/g;
+    s/Í/\&Iacute;/g;
+    s/Î/\&Icirc;/g;
+    s/Ï/\&Iuml;/g;
+    s/Ñ/\&Ntilde;/g;
+    s/Ò/\&Ograve;/g;
+    s/Ó/\&Oacute;/g;
+    s/Ô/\&Ocirc;/g;
+    s/Õ/\&Otilde;/g;
+    s/Ö/\&Ouml;/g;
+    s/Ø/\&Oslash;/g;
+    s/Ù/\&Ugrave;/g;
+    s/Ú/\&Uacute;/g;
+    s/Û/\&Ucirc;/g;
+    s/Ü/\&Uuml;/g;
+    s/Ý/\&Yacute;/g;
+    s/Þ/\&THORN;/g;
+    s/ß/\&szlig;/g;
+    s/à/\&agrave;/g;
+    s/á/\&aacute;/g;
+    s/â/\&acirc;/g;
+    s/ã/\&atilde;/g;
+    s/ä/\&auml;/g;
+    s/å/\&aring;/g;
+    s/æ/\&aelig;/g;
+    s/ç/\&ccedil;/g;
+    s/è/\&egrave;/g;
+    s/é/\&eacute;/g;
+    s/ê/\&ecirc;/g;
+    s/ë/\&euml;/g;
+    s/ì/\&igrave;/g;
+    s/í/\&iacute;/g;
+    s/î/\&icirc;/g;
+    s/ï/\&iuml;/g;
+    s/µ/\&mu;/g;
+    s/ð/\&eth;/g;
+    s/ñ/\&ntilde;/g;
+    s/ò/\&ograve;/g;
+    s/ó/\&oacute;/g;
+    s/ô/\&ocirc;/g;
+    s/õ/\&otilde;/g;
+    s/ö/\&ouml;/g;
+    s/ø/\&oslash;/g;
+    s/ù/\&ugrave;/g;
+    s/ú/\&uacute;/g;
+    s/û/\&ucirc;/g;
+    s/ü/\&uuml;/g;
+    s/ý/\&yacute;/g;
+    s/þ/\&thorn;/g;
+    s/ÿ/\&yuml;/g;
+    $sgmlout .= $_;
+  }
+  return $sgmlout;
+}
+
+# ------------------------------------------------------------------------
+
 =item LinuxDocTools::init
 
 Takes care of initialization of package-global variables (which are actually
 defined in L<LinuxDocTools::Vars>). The package-global variables are I<$global>,
 a reference to a hash containing numerous settings, I<%Formats>, a hash
 containing all the formats, and I<%FmtList>, a hash containing the currently
-active formats for help texts. 
+active formats for help texts.
 
 Apart from this, C<LinuxDocTools::init> also finds all distributed and site-local
 formatting backends and C<require>s them.
 
 =cut
 
-sub init
-{
+# -----------------------------------------------------------------------------------
+sub init {
+# -----------------------------------------------------------------------------------
   trap_signals;
 
-  #
-  #  Register the ``global'' pseudoformat. Apart from the global settings,
-  #  we also use $global to keep the global variable name space clean; 
-  #  everything that we need to provide to other modules is stuffed
-  #  into $global.
-  #
-  $global = {};
-  $global->{NAME} = "global";
-  $global->{HELP} = "";
-  $global->{OPTIONS} = [
-    { option => "backend", type => "l",
-      'values' => [ "html", "info", "latex", 
-			"lyx", "rtf", "txt", "check" ],
-	 short => "B" },
-    { option => "papersize", type => "l",
-      'values' => [ "a4", "letter" ], short => "p" },
-    { option => "language",  type => "l",
-      'values' => [ @LinuxDocTools::Lang::Languages ], short => "l" },
-    { option => "charset",   type => "l",
-      'values' => [ "latin", "ascii", "nippon", "euc-kr" ], short => "c" },
-    { option => "style",     type => "s", short => "S" },
-    { option => "tabsize",   type => "i", short => "t" },
-#    { option => "verbose",   type => "f", short => "v" },
-    { option => "debug",     type => "f", short => "d" },
-    { option => "define",    type => "s", short => "D" },
-    { option => "include",   type => "s", short => "i" },
-    { option => "pass",      type => "s", short => "P" }
-  ];
+  # Register the ``global'' pseudoformat. Apart from the global settings, we
+  # also use $global to keep the global variable name space clean everything
+  # that we need to provide to other modules is stuffed into $global.
+  $global              = {};
+  $global->{NAME}      = "global";
+  $global->{HELP}      = "";
+  $global->{OPTIONS}   = [
+			  { option => "backend",
+			    type => "l",
+			    'values' => [ "html", "info", "latex", "lyx", "rtf", "txt", "check" ],
+			    short => "B" },
+			  { option => "papersize",
+			    type => "l",
+			    'values' => [ "a4", "letter" ],
+			    short => "p" },
+			  { option => "language",
+			    type => "l",
+			    'values' => [ @LinuxDocTools::Lang::Languages ],
+			    short => "l" },
+			  { option => "charset",   type => "l",
+			    'values' => [ "latin", "ascii", "nippon", "euc-kr" ], short => "c" },
+			  { option => "style",     type => "s", short => "S" },
+			  { option => "tabsize",   type => "i", short => "t" },
+			  # { option => "verbose",   type => "f", short => "v" },
+			  { option => "debug",     type => "f", short => "d" },
+			  { option => "define",    type => "s", short => "D" },
+			  { option => "include",   type => "s", short => "i" },
+			  { option => "pass",      type => "s", short => "P" }
+			  ];
   $global->{backend}   = "linuxdoc";
   $global->{papersize} = "a4";
   $global->{language}  = "en";
@@ -121,15 +293,17 @@ sub init
   $global->{InFiles}   = [];
   $Formats{$global->{NAME}} = $global;	# All formats we know.
   $FmtList{$global->{NAME}} = $global;  # List of formats for help msgs.
-  
+
+  $global->{sgmlpre}     = "sgmlpre";
+
   if ( -e "/etc/papersize" ){
-      open (PAPERSIZE,"</etc/papersize") ||
-	  die "Count not open \"/etc/papersize\" for reading\n";
-      chomp (my $paper = <PAPERSIZE>);
-      $global->{papersize} = "letter" if ( $paper eq "letter");
-      close PAPERSIZE;
+    open (PAPERSIZE,"< /etc/papersize") ||
+      die "Count not open \"/etc/papersize\" for reading\n";
+    chomp (my $paper = <PAPERSIZE>);
+    $global->{papersize} = "letter" if ( $paper eq "letter");
+    close PAPERSIZE;
   }
-  
+
   # automatic language detection: disabled by default
   # {
   #    my $lang;
@@ -143,42 +317,37 @@ sub init
   #     }
   # }
 
-  #
-  #  Used when the format is "global" (from sgmlcheck).
-  #
+  # --------------------------------------------------------------------------------
   $global->{preNSGMLS} = sub {
-    $global->{NsgmlsOpts} .= " -s ";
+    # ------------------------------------------------------------------------------
+    #  Define a fallback preNSGMLS. Used when the format is "global" (from sgmlcheck).
+    # ------------------------------------------------------------------------------
+    $global->{NsgmlsOpts}   .= " -s ";
     $global->{NsgmlsPrePipe} = "cat $global->{file}";
   };
 
-  #
-  #  Build up the list of formatters.
-  #
-  my $savdir = cwd;
-  my %Locs;
-  chdir "$main::DataDir/dist";
-  my $dir = new DirHandle(".");
-  die "Unable to read directory $main::DataDir/dist: $!" unless defined($dir);
-  foreach my $fmt (grep(/^fmt_.*\.pl$/, $dir->read()))
-  {
-    $Locs{$fmt} = "dist";
-  }
-  $dir->close();
-  chdir "$main::DataDir/site";
-  $dir = new DirHandle(".");
-  die "Unable to read directory $main::DataDir/site: $!" unless defined($dir);
-  foreach my $fmt (grep(/^fmt_.*\.pl$/, $dir->read()))
-  {
-    $Locs{$fmt} = "site";
+  # We need to load all fmt files here, so the allowed options for all
+  # format are put into $global and a complete usage message is built,
+  # including options for all formats.
+  my %locations = ();
+  foreach my $path ("$main::DataDir/site",
+		    "$main::DataDir/dist"){
+    foreach my $location (<$path/fmt_*.pl>){
+      my $fmt =  $location;
+      $fmt    =~ s/^.*_//;
+      $fmt    =~ s/\.pl$//;
+      $locations{$fmt} = $location unless defined $locations{$fmt};
+    }
   }
-  $dir->close();
-  foreach my $fmt (keys %Locs)
-  {
-    require $fmt;
+
+  foreach my $fmt ( keys %locations ){
+    # print STDERR "Loading \'$locations{$fmt}\' for format \'$fmt\'\n";
+    require $locations{$fmt};
   }
-  chdir $savdir;
 }
 
+# ------------------------------------------------------------------------
+
 =item LinuxDocTools::process_options ($0, @ARGV)
 
 This function contains all initialization that is bound to the current
@@ -187,90 +356,85 @@ should be used (ld2txt activates the I<txt> backend) and parses the
 options array. It returns an array of filenames it encountered during
 option processing.
 
-As a side effect, the environment variables I<SGMLDECL> and 
-I<SGML_CATALOG_FILES> are modified.
+As a side effect, the environment variable I<SGML_CATALOG_FILES> is
+modified and, once I<$global->{format}> is known, I<SGMLDECL> is set.
 
 =cut
 
-sub process_options
-{
+# ------------------------------------------------------------------------
+sub process_options {
+# ------------------------------------------------------------------------
   my $progname = shift;
-  my @args = @_;
+  my @tmpargs  = @_;
+  my @args     = ();
+  my $format   = '';
+
+  # Try getting the format. We need to do this here so process_options
+  # knows which is the format and which format options are allowed
+
+  while ( $_ = shift @tmpargs ){         # Process the backend option first.
+    if ( s/--backend=// ){
+      $format = $_;
+    } elsif ( $_ eq "-B" ){
+      $format = shift @tmpargs;
+    } else {
+      push @args, $_;
+    }
+  }
 
-  #
-  #  Deduce the format from the caller's file name
-  #
-  my ($format, $dummy1, $dummy2) = fileparse ($progname, "");
-  $global->{myname} = $format;
-  $format =~ s/sgml2*(.*)/$1/;
+  unless ( $format ){
+    my ($tmpfmt, $dummy1, $dummy2) = &fileparse($progname, "");
+    if ( $tmpfmt =~ s/^sgml2// ) {       # Calling program through sgml2xx symlinks
+      $format = $tmpfmt;
+    } elsif ( $tmpfmt eq "sgmlcheck" ) { # Calling program through sgmlcheck symlink
+      $format = "global";
+    }
+  }
 
-  #
-  # check the option "--backend / -B"
-  #
-  if ($format eq "linuxdoc") {
-      my @backends = @args;
-      my $arg;
-      while (@backends) {
-         $arg = shift @backends;
-         if ($arg eq "-B") {
-                $arg = shift @backends;
-                $format = $arg;
-                last;
-	 }
-         if ( $arg =~ s/--backend=(.*)/$1/ ) {
-                $format = $arg;
-                last;
-         }
-      }
+  if ( $format ) {
+    if ( $format eq "check" ){
+      $format = "global";
+    } elsif ( $format eq "latex" ){
+      $format = "latex2e";
+    }
+    $FmtList{$format} = $Formats{$format} or
+      &usage ("$format: unknown format");
+    $global->{format} = $format;
+  } else {
+    &usage("");
   }
 
-  $format = "global" if $format eq "check";
-  usage ("") if $format eq "linuxdoc";
-  $format = "latex2e" if $format eq "latex";
-  $FmtList{$format} = $Formats{$format} or 
-     usage ("$global->{myname}: unknown format");
-  $global->{format} = $format;
+  # Parse all the options from @args, and return files.
+  my @files    = LinuxDocTools::Utils::process_options (@args);
 
-  #
-  #  Parse all the options.
-  #
-  my @files = LinuxDocTools::Utils::process_options (@args);
-  $global->{language} = Any2ISO ($global->{language});
-  #
-  # check the number of given files 
+  # Check the number of given files
   $#files > -1 || usage ("no filenames given");
 
-  #
-  #  Setup the SGML environment.
-  #  (Note that Debian package rewrite path to catalog of
-  #   iso-entities using debian/rules so that it can use 
-  #   entities from sgml-data pacakge.  debian/rules also
-  #   removes iso-entites sub directory after doing make install.)
-  #
-  $ENV{SGML_CATALOG_FILES} .= (defined $ENV{SGML_CATALOG_FILES} ? ":" : "") .
-     "$main::prefix/share/sgml/iso-entities-8879.1986/iso-entities.cat";
-  $ENV{SGML_CATALOG_FILES} .= ":$main::DataDir/linuxdoc-tools.catalog";
-  $ENV{SGML_CATALOG_FILES} .= ":$main::/etc/sgml.catalog";
-  if (-f "$main::DataDir/dtd/$format.dcl")
-    {
-      $ENV{SGMLDECL} = "$main::DataDir/dtd/$format.dcl";
-    }
-  elsif (-f "$main::DataDir/dtd/$global->{style}.dcl")
-    {
-      $ENV{SGMLDECL} = "$main::DataDir/dtd/$global->{style}.dcl";
-    }
-  elsif (-f "$main::DataDir/dtd/sgml.dcl")
-    {
-      $ENV{SGMLDECL} = "$main::DataDir/dtd/sgml.dcl";
-    }
+  # Normalize language string
+  $global->{language} = Any2ISO ($global->{language});
 
-  #
-  #  OK. Give the list of files we distilled from the options
-  #  back to the caller.
-  #
+  # Setup the SGML environment.`iso-entites' sub directory will be removed for Debian package
+  # and entities from Debian sgml-data package used if present (first entry below).
+  my @sgmlcatalogs = ( "$main::prefix/share/sgml/entities/sgml-iso-entities-8879.1986/catalog",
+		       "$main::prefix/share/sgml/iso-entities-8879.1986/iso-entities.cat",
+		       "$main::DataDir/linuxdoc-tools.catalog",
+		       "$main::/etc/sgml.catalog");
+
+  @sgmlcatalogs = ($ENV{SGML_CATALOG_FILES}, @sgmlcatalogs) if defined $ENV{SGML_CATALOG_FILES};
+
+  $ENV{SGML_CATALOG_FILES} = join(':', @sgmlcatalogs);
+
+  # Set to one of these if readable, nil otherwise
+  $ENV{SGMLDECL} = &ldt_searchfile (["$main::DataDir/dtd/$global->{format}.dcl",
+				     "$main::DataDir/dtd/$global->{style}.dcl",
+				     "$main::DataDir/dtd/sgml.dcl"]);
+
+  # Return the list of files to be processed
   return @files;
 }
 
+# ------------------------------------------------------------------------
+
 =item LinuxDocTools::process_file
 
 With all the configuration done, this routine will take a single filename
@@ -299,354 +463,192 @@ etcetera. See the code for details.
 
 =cut
 
-sub process_file
-{
+# ------------------------------------------------------------------------
+sub process_file {
+# ------------------------------------------------------------------------
   my $file = shift (@_);
   my $saved_umask = umask;
+  my $IFILE;
+  my $WRITENSGMLS;
+  my $PREASP_IN;
+  my $PREASP_OUT;
 
   print "Processing file $file\n";
   umask 0077;
 
   my ($filename, $filepath, $filesuffix) = fileparse ($file, "\.sgml");
-  my $tmpnam = $filepath . '/' . $filename;
-  $file = $tmpnam . $filesuffix;
-  -f $file || $file =~ /.*.sgml$/ || ($file .= '.sgml');
-  -f $file || ($file = $tmpnam . '.SGML');
-  -f $file || die "Cannot find $file\n";
   $global->{filename} = $filename;
-  $global->{file} = $file;
   $global->{filepath} = $filepath;
+  $global->{file}     = &ldt_searchfile(["$filepath/$filename.sgml",
+					 "$filepath/$filename.SGML"])
+    or die "Cannot find $file\n";
 
-  my $tmp = new FileHandle "<$file";
-  my $dtd;
-  while ( <$tmp> )
-    {
-      tr/A-Z/a-z/;
-      # check for [<!doctype ... system] type definition
-      if ( /<!doctype\s*(\w*)\s*system/ )
-        {
-          $dtd = $1;
-          last;
-        }
-      # check for <!doctype ... PUBLIC ... DTD ...
-      if ( /<!doctype\s*\w*\s*public\s*.*\/\/dtd\s*(\w*)/mi )
-        {
-          $dtd = $1;
-          last;
-        }
-      # check for <!doctype ...
-      #          PUBLIC  ... DTD ...
-      # (multi-line version)
-      if ( /<!doctype\s*(\w*)/ )
-        {
-          $dtd = "precheck";
-          next;
-        }
-      if ( /\s*public\s*.*\/\/dtd\s*(\w*)/ && $dtd eq "precheck" )
-        {
-          $dtd = $1;
-          last;
-        }
-    }
-  $tmp->close;
-  if ( $global->{debug} )
-    {
-      print "DTD: " . $dtd . "\n";
-    }
-  $global->{dtd} = $dtd;
+  my $dtd = &ldt_getdtd_v1("$global->{file}");
+  print STDERR "DTD: " . $dtd . "\n" if $global->{debug};
 
-  if ( ( $dtd ne "linuxdoc" ) && ( $dtd ne "linuxdoctr" ) )
-    {
-       print " DTD check - Error: this linuxdoc-tools package supports";
-       print " Linuxdoc DTD only.\n\n";
-#
-# This is Debian Specific, but if debiandoc dtd is used on other system,
-# then that user may needs the debiandoc-sgml anyway.
-       if ( $dtd eq "debiandoc" )
-         {
-           print "   If you wish to convert DebianDoc DTD files,\n";
-           print "     then please install and use";
-           print " debiandoc-sgml package.\n\n";
-         }
-       else
-         {
-           print "   If you wish to convert DocBook or other DTD files,\n";
-           print "     then please install and use";
-           print " SGMLTools-Lite or Jade/OpenJade package.\n\n";
-         }
-       die " --- LinuxDoc-Tools aborting.\n";
-    }
-
-  # prepare temporary directory
+  # Prepare temporary directory
   my $tmpdir = $ENV{'TMPDIR'} || '/tmp';
   $tmpdir = $tmpdir . '/' . 'linuxdoc-dir-' . $$;
-  mkdir ($tmpdir, 0700) ||
-   die " - temporary files can not be created, aborted - \n";
+  if ( -e $tmpdir ) {
+    die "$tmpdir already exists. Aborting ...\n";
+  } else {
+    mkdir ($tmpdir, 0700) ||
+      die " - temporary files can not be created, aborted - \n";
+  }
 
-  my $tmpbase = $global->{tmpbase} = $tmpdir . '/sgmltmp.' . $filename;
-  $ENV{"SGML_SEARCH_PATH"} .= ":$filepath";
+  # Set common base name for temp files and temp file names
+  my $tmpbase   = $global->{tmpbase} = $tmpdir . '/sgmltmp.' . $filename;
+  my $nsgmlsout = "$tmpbase.1";      # Was $tmpbase.1
+  my $preaspout = "$tmpbase.2";      # Was $tmpbase.2
+  my $aspout    = "$tmpbase.3";      # Was $tmpbase.3
 
-  #
-  # Set up the preprocessing command.  Conditionals have to be
+  # Set up the preprocessing command. Conditionals have to be
   # handled here until they can be moved into the DTD, otherwise
   # a validating SGML parser will choke on them.
-  #
-  # check if output option for latex is pdf or not
-  if ($global->{format} eq "latex2e")
-    {
-      if ($Formats{$global->{format}}{output} eq "pdf")
-        {
-          $global->{define} .= " pdflatex=yes";
-        }
-    }
-  #
-  my($precmd) = "|sgmlpre output=$global->{format} $global->{define}";
 
-  #
-  #  You can hack $NsgmlsOpts here, etcetera.
-  #
-  $global->{NsgmlsOpts} .= "-D $main::prefix/share/sgml -D $main::DataDir";
-  $global->{NsgmlsOpts} .= "-i$global->{include}" if ($global->{include});
-  $global->{NsgmlsPrePipe} = "NOTHING";
-  if ( defined $Formats{$global->{format}}{preNSGMLS} )
-    {
-      $global->{NsgmlsPrePipe} = &{$Formats{$global->{format}}{preNSGMLS}};
+  # Check if output option for latex is pdf or not
+  if ($global->{format} eq "latex2e") {
+    if ($Formats{$global->{format}}{output} eq "pdf") {
+      $global->{define} .= " pdflatex=yes";
     }
+  }
 
-  #
-  #  Run the prepocessor and nsgmls.
-  #
-  my ($ifile, $writensgmls);
+  # Set the actual pre-processing command
+  my($precmd) = "| $global->{sgmlpre} output=$global->{format} $global->{define}";
 
-  if ($global->{NsgmlsPrePipe} eq "NOTHING")
-    {
-      $ifile = new FileHandle $file;
-    }
-  else
-    {
-      $ifile = new FileHandle "$global->{NsgmlsPrePipe}|";
-    }
+  # Make sure path of file to be processed is in SGML_SEARCH_PATH
+  $ENV{"SGML_SEARCH_PATH"} .= ":$filepath";
+
+  # You can hack $NsgmlsOpts here, etcetera.
+  $global->{NsgmlsOpts}   .= "-D $main::prefix/share/sgml -D $main::DataDir";
+  $global->{NsgmlsOpts}   .= "-i$global->{include}" if ($global->{include});
+
+  # If a preNSGMLS function is defined in the fmt file, pipe its output to $FILE,
+  # otherwise just open $global->{file} as $IFILE
+  # ----------------------------------------------------------------------------
+  if ( defined $Formats{$global->{format}}{preNSGMLS} ) {
+    $global->{NsgmlsPrePipe} = &{$Formats{$global->{format}}{preNSGMLS}};
+    open ($IFILE,"$global->{NsgmlsPrePipe} |")
+      || die "Could not open pipe from $global->{NsgmlsPrePipe}. Aborting ...\n";
+  } else {
+    open ($IFILE,"< $global->{file}")
+      || die "Could not open $global->{file} for reading. Aborting ...\n";
+  }
+
+  open ($WRITENSGMLS,
+	"$precmd | $main::progs->{NSGMLS} $global->{NsgmlsOpts} $ENV{SGMLDECL} > $nsgmlsout")
+    or die "Could not open pipe to $nsgmlsout\n";
+
+  if ($global->{charset} eq "latin") {
+    print $WRITENSGMLS &ldt_latin1tosgml($IFILE);
+  } else {
+    copy($IFILE,$WRITENSGMLS);
+  }
+
+  close $IFILE;
+  close $WRITENSGMLS;
 
-  create_temp("$tmpbase.1");
-  $writensgmls = new FileHandle
-      "$precmd|$main::progs->{NSGMLS} $global->{NsgmlsOpts} $ENV{SGMLDECL} >\"$tmpbase.1\"";
-  if ($global->{charset} eq "latin")
-    {
-      while (<$ifile>) 
-        {
-	  # Outline these commands later on - CdG
-	  #change latin1 characters to SGML
-	  #by Farzad Farid, adapted by Greg Hankins
-	  s/À/\&Agrave;/g;
-	  s/Á/\&Aacute;/g;
-	  s/Â/\&Acirc;/g;
-	  s/Ã/\&Atilde;/g;
-	  s/Ä/\&Auml;/g;
-	  s/Å/\&Aring;/g;
-	  s/Æ/\&AElig;/g;
-	  s/Ç/\&Ccedil;/g;
-	  s/È/\&Egrave;/g;
-	  s/É/\&Eacute;/g;
-	  s/Ê/\&Ecirc;/g;
-	  s/Ë/\&Euml;/g;
-	  s/Ì/\&Igrave;/g;
-	  s/Í/\&Iacute;/g;
-	  s/Î/\&Icirc;/g;
-	  s/Ï/\&Iuml;/g;
-	  s/Ñ/\&Ntilde;/g;
-	  s/Ò/\&Ograve;/g;
-	  s/Ó/\&Oacute;/g;
-	  s/Ô/\&Ocirc;/g;
-	  s/Õ/\&Otilde;/g;
-	  s/Ö/\&Ouml;/g;
-	  s/Ø/\&Oslash;/g;
-	  s/Ù/\&Ugrave;/g;
-	  s/Ú/\&Uacute;/g;
-	  s/Û/\&Ucirc;/g;
-	  s/Ü/\&Uuml;/g;
-	  s/Ý/\&Yacute;/g;
-	  s/Þ/\&THORN;/g;
-	  s/ß/\&szlig;/g;
-	  s/à/\&agrave;/g;
-	  s/á/\&aacute;/g;
-	  s/â/\&acirc;/g;
-	  s/ã/\&atilde;/g;
-	  s/ä/\&auml;/g;
-	  s/å/\&aring;/g;
-	  s/æ/\&aelig;/g;
-	  s/ç/\&ccedil;/g;
-	  s/è/\&egrave;/g;
-	  s/é/\&eacute;/g;
-	  s/ê/\&ecirc;/g;
-	  s/ë/\&euml;/g;
-	  s/ì/\&igrave;/g;
-	  s/í/\&iacute;/g;
-	  s/î/\&icirc;/g;
-	  s/ï/\&iuml;/g;
-	  s/µ/\&mu;/g;
-	  s/ð/\&eth;/g;
-	  s/ñ/\&ntilde;/g;
-	  s/ò/\&ograve;/g;
-	  s/ó/\&oacute;/g;
-	  s/ô/\&ocirc;/g;
-	  s/õ/\&otilde;/g;
-	  s/ö/\&ouml;/g;
-	  s/ø/\&oslash;/g;
-	  s/ù/\&ugrave;/g;
-	  s/ú/\&uacute;/g;
-	  s/û/\&ucirc;/g;
-	  s/ü/\&uuml;/g;
-	  s/ý/\&yacute;/g;
-	  s/þ/\&thorn;/g;
-	  s/ÿ/\&yuml;/g;
-          print $writensgmls $_;
-	}
-    }
-  else
-    {
-      while (<$ifile>)
-        {
-          print $writensgmls $_;
-	}
-    }
-  $ifile->close;
-  $writensgmls->close;
-        
-  #
   #  Special case: if format is global, we're just checking.
-  #
-  $global->{format} eq "global" && cleanup;
+  &cleanup if ( $global->{format} eq "global");
 
-  #
-  #  If the output file is empty, something went wrong.
-  #
-  ! -e "$tmpbase.1" and die "can't create file - exiting";
-  -z "$tmpbase.1" and die "SGML parsing error - exiting";
-  if ( $global->{debug} )
-    {
-      print "Nsgmls stage finished.\n";
-    }
+  #  If output file does not exists or is empty, something went wrong.
+  if ( ! -e "$nsgmlsout" ) {
+    die "can't create file $nsgmlsout - exiting";
+  } elsif ( -z "$nsgmlsout" ){
+    die "$nsgmlsout empty, SGML parsing error - exiting";
+  }
+
+  print "- Nsgmls stage finished.\n" if $global->{debug};
 
-  #
   #  If a preASP stage is defined, let the format handle it.
-  #  
-  #  preASP ($inhandle, $outhandle);
-  #
-  my $inpreasp = new FileHandle "<$tmpbase.1";
-  my $outpreasp = new FileHandle "$tmpbase.2",O_WRONLY|O_CREAT|O_EXCL,0600;
-  if (defined $Formats{$global->{format}}{preASP})
-    {
-      &{$Formats{$global->{format}}{preASP}}($inpreasp, $outpreasp) == 0 or
-       die "error pre-processing $global->{format}.\n";
-    }  
-  else
-    {
-      copy ($inpreasp, $outpreasp);
-    }
-  $inpreasp->close;
-  $outpreasp->close;
-  ! -e "$tmpbase.2" and die "can't create file - exiting";
+  #  --------------------------------------------------------
+  open ($PREASP_IN, "< $nsgmlsout")
+    or die "Could not open $nsgmlsout for reading\n";
+  open ($PREASP_OUT, "> $preaspout")
+    or die "Could not open $preaspout for writing\n";
+
+  if (defined $Formats{$global->{format}}{preASP}) {
+    # preASP ($INHANDLE, $OUTHANDLE);
+    &{$Formats{$global->{format}}{preASP}}($PREASP_IN, $PREASP_OUT) == 0
+      or die "error pre-processing $global->{format}.\n";
+  } else {
+    copy ($PREASP_IN, $PREASP_OUT);
+  }
 
-  if ( $global->{debug} )
-    {
-      print "PreASP stage finished.\n";
-    }
+  close $PREASP_IN;
+  close $PREASP_OUT;
+  die "Can't create $preaspout file - exiting" unless -e "$preaspout";
+
+  print "- PreASP stage finished.\n" if ( $global->{debug} );
+
+  # Run sgmlsasp, with an optional style if specified.
+  # -----------------------------------------------------------
+  my $dtd2 = &ldt_getdtd_v2($preaspout)
+    or "Could not read dtd from $preaspout. Aborting ...\n";
+
+  unless ( $dtd eq $dtd2 ){
+    print STDERR "Warning: Two different values for dtd, dtd1: $dtd, dtd2: $dtd2\n";
+    $dtd = $dtd2;
+  }
 
-  #
-  #  Run sgmlsasp, with an optional style if specified.
-  #
   #  Search order:
   #  - datadir/site/<dtd>/<format>
   #  - datadir/dist/<dtd>/<format>
-  #  So we need to fetch the doctype from the intermediate.
-  #
-  #  Note: this is a very simplistic check - but as far as I know,
-  #  it is correct. Am I right?
-  #
-  my $tmp = new FileHandle "<$tmpbase.2";
-  my $dtd;
-  while ( ($dtd = <$tmp>) && ! ( $dtd =~ /^\(/) ) { };
-  $tmp->close;
-  $dtd =~ s/^\(//;
-  $dtd =~ tr/A-Z/a-z/;
-  chop $dtd;
-  $global->{dtd} = $dtd;
-
-  my $style = "";
-  if ($global->{style})
-    {
-      $style = "$main::DataDir/site/$dtd/$global->{format}/$global->{style}mapping";
-      -r $style or
-         $style = "$main::DataDir/dist/$dtd/$global->{format}/$global->{style}mapping";
-    }
-  my $mapping = "$main::DataDir/site/$dtd/$global->{format}/mapping";
-  -r $mapping or $mapping = "$main::DataDir/dist/$dtd/$global->{format}/mapping";
+
+  my $style = ($global->{style}) ?
+    &ldt_searchfile(["$main::DataDir/site/$dtd/$global->{format}/$global->{style}mapping",
+		     "$main::DataDir/dist/$dtd/$global->{format}/$global->{style}mapping"])
+    :
+    '';
+
+  my $mapping = &ldt_searchfile(["$main::DataDir/site/$dtd/$global->{format}/mapping",
+				 "$main::DataDir/dist/$dtd/$global->{format}/mapping"])
+    or die "Could not find mapping file for $dtd/$global->{format}\n";
+
+  $mapping = "$style $mapping" if $style;
 
   $global->{charset} = "nippon" if ($global->{language} eq "ja");
-  #
-  # we don't have Korean groff so charset should be latin1.
-  #
-  if ($global->{language} eq "ko")
-    {
-      if ($global->{format} eq "groff")
-        {
-          $global->{charset} = "latin1";
-        }
-      else
-        {
-          $global->{charset} = "euc-kr";
-        }
-    }
-  
-  if ($global->{format} eq "groff" or $global->{format} eq "latex2e")
-    {
-      if ($dtd eq "linuxdoctr")
-        {
-          $mapping = "$main::DataDir/dist/$dtd/$global->{format}/tr-mapping";
-        }
+
+  # We don't have Korean groff so charset should be latin1.
+  if ($global->{language} eq "ko") {
+    if ($global->{format} eq "groff") {
+      $global->{charset} = "latin1";
+    } else {
+      $global->{charset} = "euc-kr";
     }
+  }
 
-  create_temp("$tmpbase.3");
-  {
-      my $mycommand = "$main::progs->{SGMLSASP} $style $mapping <\"$tmpbase.2\" |
-      expand -t $global->{tabsize} >\"$tmpbase.3\"";
-      system ($mycommand) == 0
-	  or die "Error running $mycommand\n";
+  if ($global->{format} eq "groff" or $global->{format} eq "latex2e"){
+    if ($dtd eq "linuxdoctr") {
+      $mapping = "$main::DataDir/dist/$dtd/$global->{format}/tr-mapping";
+    }
   }
-  ! -e "$tmpbase.3" and die "can't create file - exiting";
 
+  my $sgmlsasp_command = "$main::progs->{SGMLSASP} $mapping < $preaspout |
+      expand -t $global->{tabsize} > $aspout";
+  system ($sgmlsasp_command) == 0
+    or die "Error running $sgmlsasp_command\n";
 
-  if ( $global->{debug} )
-    {
-      print "ASP stage finished.\n";
-    }
+  die "Can't create $aspout file - exiting\n" unless -e "$aspout";
+
+  print "- ASP stage finished.\n" if ( $global->{debug} );
 
-  #
   #  If a postASP stage is defined, let the format handle it.
-  #  It should leave whatever it thinks is right based on $file.
-  #
-  #  postASP ($inhandle)
-  #
+  # ----------------------------------------------------------------
   umask $saved_umask;
-  my $inpostasp = new FileHandle "<$tmpbase.3";
-  if (defined $Formats{$global->{format}}{postASP})
-    {
-      &{$Formats{$global->{format}}{postASP}}($inpostasp) == 0 or
-	die "error post-processing $global->{format}.\n";
-    }
+  my $inpostasp = new FileHandle "<$aspout";
+  if (defined $Formats{$global->{format}}{postASP}) {
+    # postASP ($INHANDLE)
+    # Should leave whatever it thinks is right based on $INHANDLE.
+    &{$Formats{$global->{format}}{postASP}}($inpostasp) == 0
+      or die "error post-processing $global->{format}.\n";
+  }
   $inpostasp->close;
 
-  if ( $global->{debug} )
-    {
-      print "postASP stage finished.\n";
-    }
+  print "- postASP stage finished.\n" if ( $global->{debug} );
 
-  #
   #  All done, remove the temporaries.
-  #
-  if( !$global->{debug} ) {
-      remove_tmpfiles($tmpbase);
-  }
+  &remove_tmpfiles($tmpbase) unless ( $global->{debug} );
 }
 
 =pod
@@ -658,7 +660,7 @@ sub process_file
 Documentation for various sub-packages of LinuxDocTools.
 
 =head1 AUTHOR
-SGMLTools are written by Cees de Groot, C<E<lt>cg at cdegroot.comE<gt>>, 
+SGMLTools are written by Cees de Groot, C<E<lt>cg at cdegroot.comE<gt>>,
 and various SGML-Tools contributors as listed in C<CONTRIBUTORS>.
 Taketoshi Sano C<E<lt>sano at debian.org<gt>> rename to LinuxDocTools.
 

-- 
linuxdoc-tools package for Debian.



More information about the debian-xml-sgml-commit mailing list