# Generated by LaTeX DogWagger Version 4.0.4 from file <Dogwagger404.tex>
# Date: [2012-5-16 15:19:57] 
# Do NOT edit this file. Edit the LaTeX source!!

# Header (Section 1)
#!/usr/local/bin/perl -w
use strict;

  ###################################################################
  # This program is distributed under the Gnu Public Licence (GPL).
  # You should have received a copy of the GNU General Public License
  # along with this program; if not, write to the Free Software
  # Foundation, Inc., 59 Temple Place - Suite 330, 
  # Boston, MA  02111-1307, USA.
  ###################################################################

my $ERRCOUNT=0;        # global. Ugh.
my $LINECOUNT=0;       # likewise
my $OPTN=0;            # global that supports +OPTIONAL 
my $MAJORVERSION = 4;  # * REMEMBER TO CHANGE FROM VERSION 4.0.4
my $MINORVERSION = 0;  # * REMEMBER TO CHANGE FROM VERSION 4.0.4
my $TV  = 4;           # * version 4.0.4 (TV = tinyversion)

# Initialisation (Section 2)
my $TODAY = &GetLocalTime();
my @CHILDREN;
my @DEPENDENCIES;
my @PENDINGNAME;
my $DEFAULTNEWLINE = "\n";
my $NEWLINE = $DEFAULTNEWLINE;

# Initialisation (Section 3)
my %APPENDTOFILE = (); # v4.0.4 (tme)

# Startup (Section 4)
my ($HelpMessage) = "\n      perl Dogwagger"
 . " $MAJORVERSION$MINORVERSION$TV.pl SOURCENAME.tex [log=WAGLOG.LOG]\n"
 . "         See: http://www.anaesthetist.com/mnm/dogwagger/\n"
 . "==================================================================\n"
 . "  *Picks out program code from within LaTeX verbatim statements*\n"
 . "        Within the .tex file, a DOGWAGGER LINE starts with \n"
 . "% Dogwagger \n"
 . "           ... followed on that line by one or more of:\n"
 . "   Option (example)                      Meaning\n"
 . " --------------------     ---------------------------------------\n"
 . " version=`4.0.4'      ... state optimal Dogwagger version to use\n"
 . " fileTarget=`FOO.BAR' ... the name of the very FIRST target file\n"
 . " [newLine=`\\n\\r']     ... replace newline characters with these.\n"
 . "       <<ONLY use the above 3 in the first DOGWAGGER LINE>>\n"
 . " newTarget=`NEW.BAR'  ... end off preceding file, start new file\n"
 . "     <<on starting a new file, all of the following options \n"
 . "       are reset, apart from startComment and endComment>>\n"
 . " startFile=`<?php\\n'  ... very first text in file, default is ''\n"
 . " endFile=`\\n?>'       ... final text in file, default is also ''\n"
 . " noHeader=`yes'       ... Dogwagger will now  not write a header\n"
 . " noTail=`yes'         ... omit all Dogwagger code at end of file\n"
 . " startComment=`<!--'  ... define how a Dogwagger comment starts;\n"
 . " endComment=`-->'     ... how comment ends, (default is nothing)\n"
 . " noWarn=`yes'         ... do NOT warn before overwriting a file.\n"
 . "    <<the above 7 can only be used on starting a new file>>\n"
 . " dogsAllowed=`no'     ... do NOT include following verbatim text\n"
 . " sectionTitle=`BLAH'  ... force use of this as new section title\n"
 . " noSections=`yes'     ... turn section titles on  (or off: `no')\n"
 . " oneLine=`yes'        ... in this block alone, concatenate lines\n"
 . "                          (with suppression of leading spaces)\n"
 . " dependsOn=`ALPHA'    ... defer writing text  until name defined\n"
 . " dependsOn=`A,B,C'    ... defer  until multiple blocks are named\n"
 . " myName=`ALPHA'       ... name a block  (this is case sensitive)\n"
 . " newTarget=`uudecode' ... just extract a single uuencoded file.\n"
 . "    <<See the documentation for +OPTIONAL code inclusions>>\n"
 . " *--------------------------------------------------------------*\n"
 . " Your LaTeX code must include, in its first 40 lines, a DOGWAGGER\n"
 . " LINE that describes  both the version and the first target file.\n"
 . " All subsequent LaTeX verbatim sections are appended, by default.\n"
 . " To modify behaviour, put a DOGWAGGER LINE immediately preceding\n"
 . " the first line of a verbatim statement, using the above options.\n"
 . " *--------------------------------------------------------------*\n"
 . "   Dogwagger 4.0.4 is Copyright (C) J van Schalkwyk, 2005--2012\n"
 . "      Made available under the GNU General Public Licence v2.\n"         
 . "=================================================================\n";

# write header (Section 5)
my ($fido) = "";  # file name
print "\n\n                     =======================\n"
        .    "                     Dogwagger Version "
        .                  "$MAJORVERSION.$MINORVERSION.$TV \n"
        . "                     =======================\n";
print ("                       $TODAY\n");
$fido = $ARGV[0]; # command line
if ( $fido =~ /--help/i )
   { print $HelpMessage;
     exit;
   } else
   { print "                      (Try --help for help)\n"; };
if ( !(defined $fido) || ((length $fido) < 5))
   {  die "Error. Bad file name. "
          . "Please submit a valid name e.g. foo.tex";  };

# Open log file (Section 6)
my $filelog = $ARGV[1];   # format is: log=filename.xxx
if ($filelog =~ /log=(\w+\.\w+)/i )
   { $filelog = $1;       # pull out name
   } else
   { $filelog="WAGLOG.LOG";  
   };
open FILELOG, ">$filelog" or 
     die "*CRASH* Could not open LOG <$filelog> :$!\n"; 
print FILELOG "LaTeX DogWagger, Version "
      . "$MAJORVERSION.$MINORVERSION.$TV [$TODAY]";
&Caution ("INPUT file: <$fido>");
my $cSECTIONS= 0;         # 4 globals: count verbatim sections,
my $cFILES   = 1;         #   generated files (must be >=1),
my $cSKIP = 0;            #   sections skipped,
my $cOUST = 0;            #   and files overwritten. 
if ( (my $fail = WagTheDog($fido))
   ||($ERRCOUNT > 0)
   ) { print "\n*Problems: $fail, Errors=$ERRCOUNT\n"; };
$TODAY = &GetLocalTime();
&Caution( "Done [$TODAY]. Sections:$cSECTIONS($cSKIP skipped), "
      . "files:$cFILES ($cOUST overwritten).\n\n" );
exit;

# WagTheDog (Section 7)
sub WagTheDog
{ my($fido);
  ($fido)=@_;
  my(@CHILDREN, @DEPENDENCIES, @PENDINGNAME);
  my $RETAINTARGETLINE = ''; # used for new file parameters

# WagTheDog:preliminaries (Section 8)
  @CHILDREN = ();
  @DEPENDENCIES = ();
  @PENDINGNAME = ();
    $CHILDREN[0]='';
    $DEPENDENCIES[0]='';
    $PENDINGNAME[0]='';
  my($myNam);   

# WagTheDog:open source (Section 9)
  $LINECOUNT = 0;
  my ($E1) = 0; 
    open FIDO, $fido 
         or $E1 = &GlobalError("Could not open source <$fido> :$!");
if ($E1)
   { return ($E1);  
   };

# WagTheDog:header line (Section 10)
  my($i) = 100;
while ($i > 0)
   { $_ = <FIDO>;
     $LINECOUNT ++;
   if ( /\%.* Dogwagger/i )
      { $i = 0; }; # force end
        $i --; 
   };
if (! $i)  # if DogWagger found, $i should be -1.
   { &Caution("DogWagger data not found in <$fido>");
      close FIDO;  
      return ('No data');
   };
  my($hotline) = $_;  # redundant  
  $NEWLINE = &GetNewLine($hotline); # determine newline code    

# WagTheDog: check version (Section 11)
  my ($version, $DOGFILE, $startComment, $nowarn, $sft,
      $eft, $endComment, $nohead, $nosections, $notail); 
  # amended 2011-12-18
  my($majorVersion, $minorVersion);

# WagTheDog: ReadHeader (Section 12)
  my($MANDATORY); 

  ($version, $DOGFILE, $startComment, $nowarn, $MANDATORY,
   $sft, $eft, $endComment, $nohead, 
   $nosections, $notail) = &ReadHeader($hotline); 
   # nohead.. added 2011-12-18

if ($version == 0) # error
   { return ('Bad header');
   };

  $_ = $version;
  /(.+)\.(.+)\.(.+)/;  # pull out major and minor version numbers:
  $majorVersion = $1;
  $minorVersion = $2;  # ignore trivial version number = $3  

# WagTheDog:confirm version (Section 13)
if ($majorVersion > $MAJORVERSION)
   { &Caution( 
     "Warning: DogWag(V$MAJORVERSION.$MINORVERSION) "
    ."won't support all features of V$majorVersion.$minorVersion");
   } else
   { 
   if (  ($majorVersion == $MAJORVERSION)
       &&($minorVersion > $MINORVERSION)
      )
      { &Caution( "Caution: minor version switch. "
                 ."Problems may abound!");
      };
   };

# WagTheDog: open target (Section 14)
  my ($ok, $wagline);
if (! OpenTargetFile($DOGFILE, $startComment, $fido, 
                     $nowarn, $sft, $endComment, $nohead))  
                     # nohead.. added 2011-12-18
   { return ("Could not open target <$DOGFILE>"); 
   };  #fail

# WagTheDog: read source (Section 15)
  my($ishot, $hotdata, $chomper, $chomped, $hotline); 
  my($nodogs);
  my($SECTION) = 1;
  my ($SECTIONTITLE) = ''; # default is empty
 
  $ishot   = 0;
  $chomper = 0;  # default is OFF
  $chomped = 0;
  $nodogs  = 0; # default

# WagTheDog: main WHILE (Section 16)
while (1)            #         an enormous while statement ****
   { $_ = <FIDO>;
   if (! defined)    # exit. 
      { close FIDO;
        print FILELOG "\n  Line $LINECOUNT: "; # preliminary to closing
        &CloseDogFile($startComment, $eft, $endComment, $notail);     
        return(0); 
      }; 

     $_ = &ChompLine($_);
     $LINECOUNT ++;
   if (! $ishot) # if not writing

# WagTheDog: not hot (Section 17)
      { 
      if ( /(.*)\\begin\{verbatim\}(.*)/ ) # if "begin verbatim":
         { $cSECTIONS ++;    # bump verbatim section count
         if (! $nodogs)
            { $hotdata = $2;   # amended 2011-12-19
            if ($1 !~ /\%/ ) # if verbatim not commented out
               { $ishot = 1; # turn on
                 $SECTION = &PrintSectionHeader($startComment, 
                    $SECTION, $endComment, $nosections,
                    $SECTIONTITLE);
                 print DOGFILE $hotdata;   # clumsy but explicit
               };
            };

# WagTheDog: instruction? (Section 18)
         } else                               # NOT "begin verbatim":
         { my($depOn);                 
           $myNam = '';
           $depOn = '';
           $nodogs = 0;

         if (/^\s*\%\s*DogWagger/i)           # if IS DogWagger ***
            { &PrintLogLine ( "{wag} ");
            if ( /dogsAllowed=\`no\'/)        # dogs NOT allowed
               { $nodogs = 1;
                 $cSKIP ++;
                 print FILELOG "__skip__";
               } else                         # dogs are allowed

# WagTheDog:other commands (Section 19)
               { $wagline = $_;             # dogs are allowed **
               if ( ! /^(.*)newTarget=\`(.+?)\'(.*)$/ ) # revised 4.0.3
                  { 
                  if (/^(.*)dependsOn=\`(.+?)\'(.*)$/)
                     { $depOn = $2;
                       $_ = "$1$3";
                       print FILELOG "dependencies <$depOn>; ";
                     };

                  if (/^(.*)myName=\`(.+?)\'(.*)$/)
                     { $myNam = $2;
                       $_ = "$1$3";
                       print FILELOG "name=$myNam; ";
                     };

                  if (/^(.*)oneLine=\`yes\'(.*)$/) 
                     { $chomper = 1;        # turn on!
                       $_ = "$1$2";
                       print FILELOG "(chomp) ";
                     };

                  if (/^(.*)sectionTitle=\`(.+?)\'(.*)$/) 
                     { $SECTIONTITLE = $2;
                       $_ = "$1$3";
                       print FILELOG "title<$SECTIONTITLE> ";
                     };

                  if ( /^(.*)noSections=\`(.+?)\'(.*)$/ )
                     { print FILELOG "nosections=$2 ";
                     if ($2 eq 'yes')
                        { $nosections=1;
                          $_ = "$1$3"; 
                        }
                     elsif ($2 eq 'no')
                        { $nosections=0;
                          $_ = "$1$3"; 
                        };             # if neither yes nor no, ignore!
                     };     
                  if ( /(\w+\s*=\s*\`.+\')/ )  # implies unknown command
                     { &Caution("*Warning* LINE $LINECOUNT " 
                              . "Unknown/duplicated "
                              . "Dogwagger command(s) <$1>");
                     };

# WagTheDog: a new file (Section 20)
                  } else # IS newTarget
                  { 
##################deeply indented section#######################
$RETAINTARGETLINE = "$1$3";      # keep all other specifications
$DOGFILE = $2;                   # get name of new file
# the following line bumps file count _unless_ previously opened 
$cFILES++ unless exists $APPENDTOFILE{ $DOGFILE }; # v4.0.4 (tme)
if ($DOGFILE =~ /^uudecode$/) 
     # if uudecoding do NOT terminate current file!
   { my ($ufile, $umode, $uout) = Uudecode();
     if (length $ufile > 0)
        { &PrintLogLine ("uudecoding <$ufile> mode $umode");
          my ($E2) = 0;
          if (-e $ufile) { $cOUST++; }; # bump overwrite count!
          open UFILE, ">$ufile" 
               or $E2 = &GlobalError("Uudecode failed <$ufile>");
          if (! $E2)
             { binmode UFILE;     # NB otherwise MSDOS stuffup!
               print UFILE $uout; # IGNORE UNIX mode in $umode.
               close UFILE;
        };   
   };

# WagTheDog: close file (Section 21)
    } else                        # close current, open new!
    { &CloseDogFile($startComment, $eft, $endComment, $notail);
      # close with old parameters; next, read new...
      ($startComment, $nowarn, $MANDATORY, $sft, $eft, 
       $endComment, $nohead, $nosections, $notail) =
      &ReadTargetParams($RETAINTARGETLINE, $startComment, 
                        $endComment);
      print FILELOG ("\n  Comment format now \"$startComment"
                     . "foo$endComment\"");
      if (! OpenTargetFile($DOGFILE, $startComment, $fido, 
            $nowarn, $sft, $endComment, $nohead)) 
              # nohead.. added 2011-12-18
         { return ("Could not open target: <$DOGFILE>");  #fail
         }; 
    }; 
#################end deeply indented section####################

# WagTheDog: bad command (Section 22)
                  }; # END of else (is newTarget)
               };    # end of "dogs are allowed"
            };         # end of IS DogWagger ***

# WagTheDog: store child (Section 23)
         if (length $depOn > 0)  # if dependency
            { 
            if (! &StoreChild ($myNam, $depOn, $chomper)) # keep whole
               { &Caution("WARNING: \
                 Input file <$fido> terminated unexpectedly!");
                 close FIDO;
                 close DOGFILE;
                 return ('Sudden INPUT failure'); #fail!
               };
              $myNam = ''; # cannot YET resolve (is a dependency).
            }; 
         };  # end else ... not begin verbatim. 

# WagTheDog: hot code (Section 24)
      } else # ARE HOT (ARE WRITING):
      { 
      if ( /(.*)\\end\{verbatim\}/ ) # end verbatim?
         { 
         if ($OPTN) # OPTION still on?
            { &Alert ( "Optional text not closed. See log!");
              &GlobalError("\n ERROR line $LINECOUNT: "
                         . "+OPTIONAL not closed");
              $OPTN = 0;
            };
 
           $hotdata = $1;
           print DOGFILE $hotdata; # last chunk.
           print FILELOG " ... $LINECOUNT.";
         if (length $myNam > 0)  # if name defined
            { $SECTION = &FixName($myNam, $startComment, 
                                  $SECTION, $endComment, 
                                  $nosections, $SECTIONTITLE); 
            };
           $ishot = 0;             # turn off.
           $chomper = 0;           # back to default
           $chomped = 0;           # redundant.
           $SECTIONTITLE = ''; 
         } else  # NOT end verbatim.. 

# WagTheDog: chomping? (Section 25)
         { 
         if ($chomped)           # Already chomped?
            { / *(.*)/;          # remove leading spaces
              $_ = $1;           # (even allow null line)
            };
         if ($chomper)           # IF line must be chomped
            { print FILELOG '+'; # Amended 2011-12-18
              $chomped = 1;      # signal we've just chomped.
            } else               # UNLESS chomping,
            { $_ = "$_$NEWLINE"; # restore a default newline!
            };  

# WagTheDog: OPTIONAL? (Section 26)
         if ( /^\s*\+OPTIONAL(.*)$/)
            { $OPTN = 1;
              $_ = "";
            if (length $1 > 0)
               { &Caution("Warning LINE $LINECOUNT. "
                        . "Extra +OPTIONAL text");
               };
            };
         if ( /^\s*-OPTIONAL(.+)$/)
            { $OPTN = 0;
              $_ = "";
            if (length $1 > 0)
               { &Caution("Warning LINE $LINECOUNT. "
                        . "Extra-OPTIONAL text");
               };
            }; 

         if ($MANDATORY || ! $OPTN) # unless optional is active
            { print DOGFILE $_; # write to output
            };

         }; # end else not end verbatim
      };   # end else are hot

# WagTheDog: done (Section 27)
  }; # end of enormous while stmt.

}  # end of WagTheDog

# Read a header (Section 28)
sub ReadHeader
{ my ($hotline);
     ($hotline) = @_;
  my ($ver, $target, $comment, $nowarn, $mandatory,
      $sft, $eft, $endComment,
      $nohead, $nosections, $notail);      # $nohead 2011-12-18
  $ver = 0;
  $target = '';
  $comment = '#';                          # aka startComment
  $nowarn = 0;
  $mandatory = 0;
  $sft = '';
  $eft = '';
  $endComment = '';
  $nohead = 0;                              # default write head
  $nosections = 0;                          # and section 
  $notail = 0;
  if ( $hotline !~ /^(.*)version=\`(\d+\.\d+\.\d+)\'(.*)$/ ) 
     { &Caution ("Missing/defective version number");
       return (0,0,0,0, 0,0,0,0, 0,0,0);    #fail
     };
  $ver = $2;
  $hotline = "$1$3";    
  if ( $hotline !~ /^(.*)fileTarget=\`(.+?)\'(.*)$/ )
     { &Caution ("Missing/defective target filename");
       return (0,0,0,0, 0,0,0,0, 0,0,0);    #fail
     };
  $target = $2;
  $hotline = "$1$3";    
  if ($hotline =~ /^(.*)newLine=\`(.+?)\'(.*)$/ )
     { $NEWLINE = $2;                         
       $hotline = "$1$3";    
       $NEWLINE =~ s/\\n/\n/g;              #
       $NEWLINE =~ s/\\r/\r/g;              # replace \n =r
     };
  ($comment, $nowarn, $mandatory, $sft, $eft,
   $endComment, $nohead, $nosections, $notail) =
       &ReadTargetParams($hotline, $comment, $endComment);
  return ($ver, $target, $comment, $nowarn, $mandatory,
          $sft, $eft, $endComment,
          $nohead, $nosections, $notail);  }

# Read target parameters (Section 29)
sub ReadTargetParams
{ my ($topline, $comment, $endComment);
     ($topline, $comment, $endComment) = @_;
  my ($nowarn, $mandatory, $sft, $eft, 
      $nohead, $nosections, $notail);  # $nohead.. added 2011-12-18
  my ($alterSC, $alterEC);
  $nowarn    = 0;
  $mandatory = 0;
  $sft       = '';
  $eft       = '';
  $nohead    = 0;           # default write head
  $nosections= 0;           # and section 
  $notail    = 0;
  $alterSC   = 0;           # ON if alter startComment
  $alterEC   = 0;           # on if alter endComment

  if ($topline =~ /^(.*)include=\`everything\'(.*)$/)
     { $mandatory = 1; 
       $topline = "$1$2";
       print FILELOG "include ALL "; };

  if ($topline =~ /^(.*)startComment=\`(.+?)\'(.*)$/) 
     { $comment = $2;       # new startComment
       $topline = "$1$3";
       print FILELOG "comment '$comment'";
       $alterSC = 1;
     };
  if ($topline =~ /^(.*)newComment=\`(.+?)\'(.*)$/) # obsolete.
     { &Caution(  "Minor warning: newComment is deprecated "
                . "(LINE $LINECOUNT). Use startComment." );
       $comment = $2;
       $topline = "$1$3";
       print FILELOG "comment '$comment'";
       $alterSC = 1;
     };
  if ($topline =~ /^(.*)endComment=\`(.*?)\'(.*)$/)
     { $endComment = $2;
       $topline = "$1$3"; 
       print FILELOG "endComment '$endComment'";
       $alterEC = 1;
     };

# start v end comment (Section 30)
  if ($alterSC && ! $alterEC) # if only alter startComment
     { $endComment = '';      # force endComment to default.
     };

# headline options (Section 31)
  if ($topline =~ /^(.*)noWarn=\`yes\'(.*)$/)
     { $nowarn = 1; 
       $topline = "$1$2";
       print FILELOG "warn is OFF; "  };
  if ($topline =~ /^(.*)startFile=\`(.*?)\'(.*)$/) # ver 2.1
     { $sft = $2;
       $topline = "$1$3";
       print FILELOG "start code {$sft}; ";
       $sft =~ s/\\n/$NEWLINE/mg; # CR's !!
     };
  if ($topline =~ /^(.*)endFile=\`(.*?)\'(.*)$/)   # ver 2.1
     { $eft = $2;
       $topline = "$1$3";
       print FILELOG "end code {$eft}; ";
       $eft =~ s/\\n/$NEWLINE/mg; # CR's !!
     };
  if ($topline =~ /^(.*)noHeader=\`yes\'(.*)$/ )   # 2011-12-18
     { $nohead=1;
       $topline = "$1$2";
       print FILELOG "NO header; " };
  if ($topline =~ /^(.*)noSections=\`yes\'(.*)$/ )
     { $nosections=1;
       $topline = "$1$2";
       print FILELOG "NO sections; "  };
  if ($topline =~ /^(.*)noTail=\`yes\'(.*)$/ )
     { $notail=1;
       $topline = "$1$2";
       print FILELOG "NO tail; "  };

  if ($topline =~ /(\w+\s*=\s*\`.+\')/ )  # v 4.0.3
     { &Caution("*Warning* LINE $LINECOUNT Unknown/duplicated "
                . "Dogwagger NEWFILE command(s) <$1>");
     };

  return ($comment, $nowarn, $mandatory, $sft, $eft, 
          $endComment, $nohead, $nosections, $notail);  }

# Confirm (Section 32)
sub Confirm
{ my ($msg);
     ($msg) = @_;    

     print "\n$msg";
     my($ans);
     $ans = <STDIN>; # get stdin
     if ($ans =~ /^y/i )
        { return(1);
        };
    return (0);  }

# Alert (Section 33)
sub Alert
{ my ($msg);
     ($msg) = @_;     
     print "$msg";  }

# Chomp line (Section 34)
sub ChompLine
{ my ($line);
     ($line) = @_;
  if ( $line =~ /([^\n\r]*)/ms )
                { $line = $1;
                };
  return($line);  }

# Get newline characters (Section 35)
sub GetNewLine
{ my ($line);
     ($line) = @_;
  if ( $line =~ /[^\n\r]*([\n\r]+)$/ms )
                { my($nl) = $1;
                  $_ = &Unescape($1);
                  print FILELOG "\n  newline is <$_> ";
                  return($nl);
                };
  print FILELOG "\n  Resorting to newline default.";
  return($DEFAULTNEWLINE); }

# Caution (Section 36)
sub Caution 
{ my ($msg);
     ($msg) = @_;
  print FILELOG "\n$msg";  # must prepend newline.
  &Alert("\n$msg"); }

# Get local time (Section 37)
sub GetLocalTime
{  my ($sec, $min, $hour, $mday, $mon, 
       $year, $wday, $yday, $isdst);
($sec, $min, $hour, $mday, $mon, 
       $year, $wday, $yday, $isdst) = localtime(time);

  $year += 1900;      #fix y2k.
  $mon ++;            #january is zero!
  return ("$year-$mon-$mday $hour:$min:$sec"); }

# global error (Section 38)
sub GlobalError
{ my ($msg);
     ($msg) = @_;
  print FILELOG "\n$msg";     
  $ERRCOUNT ++; # bump error count
  return($msg);
}

# Unescape (Section 39)
sub Unescape
{ my ($t);
     ($t) = @_;
  $t =~ s/\n/\\n/ms;
  $t =~ s/\r/\\r/ms;
  return($t);
}

# Store child (Section 40)
sub StoreChild 
{  my ($pendingName, $dependencies, $chomper);
      ($pendingName, $dependencies, $chomper) = @_;
   my ($idx, $child);
   $idx = 1+$#CHILDREN;
   print FILELOG "Keeping child[$idx].";
   
   $_ = <FIDO>; # first line *must* be begin verbatim
                # what if this is not defined?? (check me)
   $LINECOUNT ++;
   $_ = &ChompLine($_); 
   if ($chomper)           # IF line must be chomped
      { print FILELOG '/'; # 
      } else               # UNLESS chomping,
      { $_ = "$_$NEWLINE"; # restore a default newline!
      };  

# ensure verbatim (Section 41)
   if ( /\\begin\{verbatim\}(.*)/ )
      { $child = $1;  # keep rest of line
      } else
      { print FILELOG "\n*ERROR at line $LINECOUNT:"
         . " no verbatim stmt on 1st child line!";
        $ERRCOUNT ++; # bump error 
        print FILELOG "<$ERRCOUNT!>";
        print FILELOG "<$_>";
        return 1; # not fatal, per se. 
      };

# dependencies (Section 42)
    $DEPENDENCIES[$idx] = ",$dependencies,"; 
   $PENDINGNAME[$idx] = $pendingName;
   $CHILDREN[$idx] = ''; # default nothing
   my($ok) =1;

# sequential read (Section 43)
    while($ok)
     { $_ = <FIDO>;
       if (! defined)
          { return 0; # fail
          } else
          { $_ = &ChompLine($_); 
            $LINECOUNT ++;
            if ($chomper)             # IF line must be chomped
               { print FILELOG '/';   
               } else                 # UNLESS chomping,
               { $_ = "$_$NEWLINE";   # restore a default newline!
               };  
           if ( /(.*)\\end\{verbatim\}/ )
              { $ok = 0;
                $child = "$child$1";  # append last section
              } else
              { $child = "$child$_";  # concatenate.
              };  
          };
     };
  $CHILDREN[$idx] = $child; # store away lines to be printed   
  return 1; 
} # success!

# Fix name (Section 44)

sub FixName
{ my ($fname, $c, $SECTION, $ec, $nosections, $SECTIONTITLE); 
     ($fname, $c, $SECTION, $ec, $nosections, $SECTIONTITLE) = @_; 
     # nosections added 2011-12-18
  my ($morenames) = ",$fname,"; 
  my ($idx);

# fixname while loop (Section 45)
  while ( $morenames =~ /^(.*,)(.+),$/ ) # split off last name
    { $fname = $2;
      $morenames = $1; 
      $idx = $#CHILDREN;                         
      while ($idx > -1 )                 # for each child entry
        { if ($DEPENDENCIES[$idx] =~ /(.*,)$fname,(.*)/ ) 
             { $_ = "$1$2";              # if name in list, clip
               print FILELOG " (child[$idx] now has <$fname>) ";
               $DEPENDENCIES[$idx] = $_; # rewrite
               if ( /^,$/ )              # if all resolved 
                  {  print FILELOG "WRITING child[$idx] ";
                     $SECTION = &PrintSectionHeader($c, $SECTION,
                                         $ec, $nosections,
                                         $SECTIONTITLE);
                     print DOGFILE $CHILDREN[$idx];
                     $CHILDREN[$idx] = ''; 

# and repeat (Section 46)
                     # ....WAIT! this child may have dependencies!
                     if (length $PENDINGNAME[$idx] > 0) # if so ...
                        { $morenames = 
                             "$morenames$PENDINGNAME[$idx],";
                             # add name of resolved child!
                          $PENDINGNAME[$idx] = '';# clear me!
             };   };    };
          $idx --;                       # move to preceding child
        };                               # all children done.
    };
  return $SECTION; }

# Check unresolved dependencies (Section 47)
sub CheckUnresolved
{ my($idx);
  $idx = $#CHILDREN;
  my ($errcnt);
  $errcnt = 0;  
  while ($idx > -1)
    {
      if (length $CHILDREN[$idx] > 0)
         { print FILELOG "\n\n *** ERROR *** "
                         . "\n\n Unresolved code: \n ";
           print FILELOG "Dependencies: <$DEPENDENCIES[$idx]> \n";
           print FILELOG "Name: <$PENDINGNAME[$idx]> \n"
                         . " <Code: <---\n ";
           print FILELOG $CHILDREN[$idx];
           print FILELOG "$\n ---> Code ends> \n\n";
           $errcnt++;
         };
      $idx --;
    };
  return $errcnt; } # number of errors, 0=ok.

# open target file (Section 48)
sub OpenTargetFile
{ my ($DOGFILE, $c, $fido, $nowarn, $sft, $ec, 
      $nohead);  # nohead added 2011-12-18
     ($DOGFILE, $c, $fido, $nowarn, $sft, $ec,
      $nohead) = @_;
     my($ok);
  $TODAY = &GetLocalTime();

# decide to overwrite or append (Section 49)
  my $prefix = ">";  #  start amendment for v4.0.4 (tme)
  $prefix = ">>" if exists $APPENDTOFILE{ $DOGFILE };
  $APPENDTOFILE{ $DOGFILE } = 1;  # end amendment v4.0.4 (tme)

# warn if overwriting (Section 50)
  if ($prefix eq ">" and -e $DOGFILE) # if prefix condition added v4.0.4 (tme)
     { if (! $nowarn)  # and warning enabled
          { if (! &Confirm ( 
                     "Overwrite <$DOGFILE>? Are you sure?"))
               { &Caution( "[NOT overwriting $DOGFILE]");
                 $DOGFILE = 'JUNK.JUNK'; # write to junk file.
               } else
               { print FILELOG "[Overwriting $DOGFILE]";
                 $cOUST++;  # increase overwrite count.
               };
           } else
           { $cOUST++;  # increase overwrite count.
     };    };
  my ($E3) = 0;

# discard file (Section 51)
  open DOGFILE, $prefix."$DOGFILE" or  # ">" changed to $prefix v4.0.4 (tme)
        $E3 = &GlobalError(
                "Could not open target <$DOGFILE> :$!");
     if ($E3)
        { return 0; 
        }; #fail
  print FILELOG "\n\n==Opened target file <$DOGFILE> ";

# write headlines (Section 52)
  print DOGFILE $sft; # very first text eg. for PHP.
                      # print EVEN IF noHead=`yes'.
  if (! $nohead)      # added 2011-12-18
  { print DOGFILE 
      "$c Generated by LaTeX DogWagger Version " . 
      "$MAJORVERSION.$MINORVERSION.$TV "
      . "from file <$fido>$ec$NEWLINE";
    print DOGFILE "$c Date: [$TODAY] $ec$NEWLINE";
    print DOGFILE "$c Do NOT edit this file. "
            . "Edit the LaTeX source!!$ec$NEWLINE"; 
                      # \n appended 2011-12-18. Is this wise?
  };
  return 1; # success
}

# Close target file (Section 53)
sub CloseDogFile
{ my ($c, $eft, $ec, $notail);
     ($c, $eft, $ec, $notail) = @_;
  my ($EC) = &CheckUnresolved();
  $ERRCOUNT += $EC;      # global
  if ($EC > 0)
     { print FILELOG "\nUnresolved errors <$EC>";
       if (! $notail)
          { print DOGFILE  
              "$NEWLINE$NEWLINE$c -- WARNING:"
              . " $EC errors. See log!$ec$NEWLINE";
     };   };    

# write tail (Section 54)
  if (! $notail)
     { print DOGFILE "$c -END OF FILE- $ec$NEWLINE";
     };
     print DOGFILE $eft; # Print EVEN if noTail=`yes'
     close DOGFILE;      
     print FILELOG " FILE CLOSED== ";  
}

# Print section header (Section 55)
sub PrintSectionHeader
{ my($c, $SECTION, $ec, $nosections, $SECTIONTITLE); 
     # $nosections 2011-12-18
    ($c, $SECTION, $ec, $nosections, $SECTIONTITLE) = @_;
  if (! $nosections)
  { if (length $SECTIONTITLE > 0)
       { $_ = $SECTIONTITLE;
         if (/\$\[SECTION\]/) # if contains section count
            { s/\$\[SECTION\]/$SECTION/;
            };
            print DOGFILE "$NEWLINE$c$_$ec$NEWLINE";
       } else
       { print DOGFILE "$NEWLINE$c - <Section $SECTION>"
                             . " - $ec$NEWLINE";
  };   };
  &PrintLogLine ("writing section [$SECTION]");
  $SECTION ++;
  return $SECTION;  
}

# Print log line (Section 56)
sub PrintLogLine
{ my($t); 
   ($t) = @_;
   print FILELOG "\n  line $LINECOUNT: $t"; 
}

# Uudecode (Section 57)
sub Uudecode  
{ my ($filename, $mode, @rslt);
  my ($line, $decoded, $err);
  $filename = "";
  $line = <FIDO>; # this should be \begin{verbatim} line:
  $LINECOUNT ++;
  if ($line !~ /\\begin\{verbatim\}/ )
     { &Alert ("Uudecode: no verbatim <$line>");
       return ("", "", "");
     };

  $line = <FIDO>; # MUST be header!
  $LINECOUNT ++;
  $line = &ChompLine($line); 
  $line =~ /begin\s+(\d{3})\s+(.+)/; 
  if (! defined $1)
     { # here write error!
       &Alert ("Uudecode: bad first UU line <$line>");
       return ("", "", "");
     };
  $mode = $1;
  $filename=$2;
  $err = 1; # -ve will signal failure
  
  while ( $line = <FIDO> ) 
    { # hmm what if extra 0xD ?
      last if (! defined $line); # ??
      $LINECOUNT ++;
      $line = &ChompLine($line); 
      last if ($line =~ /^end/);
      if (! $err) # bad if err zero
         { &Alert ("Uudecode: end stmt not seen!<$line>");
           last;
         };
      ($decoded, $err) = UudecodeLine($line);
      # nb if $err is zero, next line must be /^end/!
      if ($err < 0)
         { # here could write error!
           if ($err == -1)
              { $err = "Bad line";
              } 
           elsif ($err == -2)
              { $err = "silly length($decoded)";
              }
           elsif ($err == -3)
              { $err = "lengths don't match($decoded)";
              };
              
           &Alert ("Uudecode: error $err in <$line>");
           last; # terminate
         };
      push @rslt, $decoded;
    };
  return ($filename, $mode, join("",@rslt));
}

# Uudecode line (Section 58)
sub UudecodeLine
{ my ($line) = @_;
  my ($charlen);
  my ($decoded, $ld);
  
  $line =~ /(.).*\`*$/; # remove terminal backticks too!
  if (! defined $1)
     { return ("", -1); # dud line!
     };
   $charlen = (ord($1) - 32) & 077;
  if ($charlen == 0)
     { # ie terminal line with single backtick:
       # no error, but END!
       return ("", 0);
     };
  if (($charlen > 45) || ($charlen <0))
     { return ("$charlen($1)", -2); # bad length
     };

 # convert to number, then count of characters encoded;
  $decoded = unpack("u", $line); #uudecode!
  $ld = length $decoded;
  if ($ld != $charlen)
     { return ("$ld:$charlen:$decoded", -3); # length doesn't match!
     };
  return ($decoded, 1); # success!
}
# -END OF FILE-