# Generated by LaTeX DogWagger Version 2.0.0 from file <dogwagger21.tex>
# Date: 2008-8-9 18:13:36
# Do NOT edit this file. Edit the LaTeX source!!


# Dwag v2.1.0 (Section 1)
#!/usr/local/bin/perl -w

use strict;
use Tk;
require Tk::Dialog;
require Tk::Toplevel;
# require Tk::Font;

  # 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 $ERR;               # ugly global error;
my $ERRCOUNT;          # similarly nasty;
my $LINECOUNT;         # this is also a nasty global;
my $SECTIONTITLE;      # me too.

my $MAJORVERSION = 2;
my $MINORVERSION = 1;
my $TINYVERSION  = 1;   # version 2.1.1
my $BUG = 0;            # are we debugging (0=no)

# Dwag v2.1.0 (Section 2)
my $filelog;
$filelog="WAGLOG.LOG"; 
open FILELOG, ">$filelog" or 
     die "*CRASH* Could not open LOG $filelog :$!\n"; 
print FILELOG "LaTeX DogWagger, Version \
  $MAJORVERSION.$MINORVERSION.$TINYVERSION\n";

my $TODAY = &GetLocalTime();
print ("\n TODAY: $TODAY\n");
my @CHILDREN;
my @DEPENDENCIES;
my @PENDINGNAME;

# Dwag v2.1.0 (Section 3)
my $fred;  # file name
$fred = "";

my $MAINW = new MainWindow;
   $MAINW->geometry('300x200');  # dimensions
   $MAINW->geometry('+80+30');   # screen offset!
   $MAINW->title(
     "DogWagger Version $MAJORVERSION.$MINORVERSION.$TINYVERSION");
   $MAINW->focusFollowsMouse;    # change focus mode

my $FIRSTARG;
$FIRSTARG = $ARGV[0]; # allow command line for simple stuff!
if ((defined $FIRSTARG) && ((length $FIRSTARG) > 0))
   {  # &Alert ($MAINW, "First argument is $FIRSTARG");
     $fred = $FIRSTARG;
   }

# Dwag v2.1.0 (Section 4)
my $bottomFrame = $MAINW->Frame();
   $MAINW->Label( -text => 'Enter source file name')->pack();
my $txt = $MAINW->Entry( -textvariable => \$fred)->pack(-padx => 50, 
                                                    -pady => 15, 
                                                    -ipadx => 5);
   $txt->configure (-validatecommand => [ \&CheckFred, $MAINW],
                                -validate => 'focusout');
my $goBut = $MAINW->Button( -text => 'Wag',
                            -command => [ \&WagTheDog, $MAINW ] );
   $goBut->configure(-background => 'green');
   $goBut->configure(-width => 20);
my $quitBut = $bottomFrame->Button(-text => 'Quit', 
              -command => [ \&ByeForNow, $MAINW ] );
   $quitBut->configure(-background => 'red');
   $quitBut->configure(-width => 20);
$quitBut->pack();
$goBut->pack();
$goBut->focus(); # version 2.1
$bottomFrame->pack(-side => 'bottom', -fill => 'both', 
                   -pady => 20);
MainLoop;

# Dwag v2.1.0 (Section 5)
sub WagTheDog
{
  my($thisW);
    ($thisW)=@_;
  my ($MANDATORY, $OPTN);
  $OPTN = 0; # default is capture
  print FILELOG "\n ------------------------";
  &Debug($thisW, "\n\n You specified <$fred>\n"); 
  if (length $fred < 1)
     { &Alert($thisW, "First enter file name, e.g. PerlPgm.tex");
       return;
     };
  my($FRED, $hotline, $i);
  $FRED = $fred;
  $ERRCOUNT = 0; 

# Dwag v2.1.0 (Section 6)
  @CHILDREN = ();
  @DEPENDENCIES = ();
  @PENDINGNAME = ();
    $CHILDREN[0]='';
    $DEPENDENCIES[0]='';
    $PENDINGNAME[0]='';
  my($myNam);   

# Dwag v2.1.0 (Section 7)
   $LINECOUNT = 0;
   $ERR = 0; #hideous
     open FRED, $FRED 
          or &GlobalError("Could not open source $FRED :$!");
     if ($ERR)
        { $ERRCOUNT ++; # bump error count
          &Alert($thisW, $ERR);
          return;
        };

# Dwag v2.1.0 (Section 8)
     $i = 4;
     while ($i > 0)
       { $_ = <FRED>;
         $LINECOUNT ++;
         &Debug($thisW, "$_");
         if ( /\%.*LaTeX DogWagger/ )
            { $i = 0;  # force end
            };
         $i --;
       };
  if (! $i)  # if DogWagger found, $i should be -1.
     { &Caution($thisW, "DogWagger data not found in <$fred>");
       close FRED;  
       return;
     };
  $hotline = $_;  # redundant      

# Dwag v2.1.0 (Section 9)
  my ($version, $DOGFILE, $startComment, $nowarn, 
      $startFileTxt, $endFileTxt, $sft, $eft,
      $endComment);
  my($majorVersion, $minorVersion);
  $startFileTxt = '';
  $endFileTxt = '';

# Dwag v2.1.0 (Section 10)
  ($version, $DOGFILE, $startComment, $nowarn, $MANDATORY,
   $sft, $eft, $endComment) = &ReadHeader($hotline);
  if (! $MANDATORY)
     { &Debug($thisW, "\n Optional text NOT included");
     };
  $_ = $version;
  /(.+)\.(.+)\.(.+)/;  # pull out major and minor version numbers:
  $majorVersion = $1;
  $minorVersion = $2;  # ignore trivial version number = $3  

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

# Dwag v2.1.0 (Section 11)
  my ($c, $ok, $wagline, $ec);
  $c  = $startComment; # shorter. hmm. clumsy. 
  $ec = $endComment;   # version 2.1
  if (! OpenTargetFile($thisW, $DOGFILE, $c, $FRED, 
                       $nowarn, $sft, $ec))
       { return;  #fail
       }; 

# Dwag v2.1.0 (Section 12)
     my($ishot, $hotdata, $chomper, $chomped);
     my($nodogs);
     my($SECTION);
     $SECTION = 1;
     
     $ishot = 0;
     $chomper = 0;  # default is OFF
     $chomped = 0;
     $SECTIONTITLE = ''; # default is empty
     $ok=1;
     $nodogs=0; # default

while($ok)
  { $_ = <FRED>;
    $LINECOUNT ++;

    if (! defined)
       { $ok = 0;
       } else
       { if (! $ishot) # if not writing
            { if ( /\\begin\{verbatim\}(.*)/ )
                 { if (! $nodogs)
                      { $ishot = 1; # turn on
                        $hotdata = $1;
                        $SECTION = &PrintSectionHeader($c, $SECTION, $ec);
                        print DOGFILE $hotdata; # clumsy but explicit
                      };
                 } else
# see comment [1] below
{   my($depOn);
    $myNam = '';
    $depOn = '';
    $nodogs = 0;
    if (/^\%.*DogWagger/)
       { if ( /dogsAllowed=\`no\'/)
            { $nodogs = 1;
            } else
            { $wagline = $_;
              if (/dependsOn=\`(.+?)\'/)
                 { $depOn = $1;
                   print FILELOG "\n Section dependencies <$depOn>";
                 };
              if (/myName=\`(.+?)\'/)
                 { $myNam = $1;
                   print FILELOG "\n Section name: >$myNam";
                 };
              if (/noWarn=\`(.+)\'/)
                  { if ($1 eq 'yes')
                       { $nowarn = 1;
                       } else
                       { $nowarn = 0; # default (safer)
                       };
                  };
              if (/oneLine=\`yes\'/)
                 { $chomper = 1; # turn on!
                   print FILELOG " (chomp)";
                 };
              if (/sectionTitle=\`(.+?)\'/) # self-explanatory
                 { $SECTIONTITLE = $1;
                 };
              if (/newComment=\`(.+?)\'/) # new comment string!
                 { $startComment = $1; # note usage!
                 };
              if (/endComment=\`(.*?)\'/)
                 { $endComment = $1;
                 };
              if (/startFile=\`(.*?)\'/) # new file start, can be null!
                 { $startFileTxt = $1;   # ver 2.1
                   $startFileTxt =~ s/\\n/\n/mg; # CR's !!
                 };
              if (/endFile=\`(.*?)\'/)   # similar, end file
                 { $endFileTxt = $1;   # ver 2.1
                   $endFileTxt =~ s/\\n/\n/mg; # CR's !!
                 };
              if (/newTarget=\`(.+?)\'/) 
                 { $_ = $1;
                   if (/uudecode/) # if uudecoding ?!...
                    { my ($ufile, $umode, $uout) = Uudecode($MAINW);
                      if (length $ufile > 0)
                         { 
                           print FILELOG ("\n Uudecoding <$ufile> mode $umode");
                           open UFILE, ">$ufile" or &GlobalError("UU");
                           binmode UFILE; # NB otherwise DOS stuffup!
                           print UFILE $uout;
                           # hmm what about the unix mode (opening?)
                           close UFILE;
                         }; # ??? also print to FILELOG?
                    } else  # close current, open new!
                    { $DOGFILE = $_; # retain new name
                      &CloseDogFile($thisW, $c, $eft, $ec); # close previous 
                      $sft = $startFileTxt;
                      $eft = $endFileTxt;
                      $startFileTxt = ''; #
                      $endFileTxt = '';   # reset for next.
                      $c = $startComment; # only now alter comment!
                      $ec = $endComment;  # v2.1 likewise
                      $endComment = '';   # reset!!
                      print FILELOG ("\n Comment format is <$c" . "COMMENT" . "$ec>");
                      if (! OpenTargetFile($thisW, $DOGFILE, $c, $FRED, 
                             $nowarn, $sft, $ec))
                         { return;  #fail
                         }; 
                    };
                 };
              # ------------------------------------------
              # here if more tests, use $wagline, not $_ !
              # ------------------------------------------
            };
       };
    if (length $depOn > 0)  # if dependency
       { if (! &StoreChild ($myNam, $depOn)) # keep whole
            { &Caution($thisW, "WARNING: \
            Input file <$FRED> terminated unexpectedly!");
              close FRED;
              close DOGFILE;
              return; #fail!
            };
         $myNam = ''; # cannot YET resolve (stored not printed)!
       };
# END AMENDMENT V2.0 9/9/2005.
                      };

# Dwag v2.1.0 (Section 13)
 } else # are hot!
 { if ( /(.*)\\end\{verbatim\}/ ) # end verbatim?
      { if ($OPTN) # OPTION still on?
           { &Alert ($MAINW, 
              "Optional text not closed. See log!");
             &GlobalError(
              "\n ERROR: NO option closure, line $LINECOUNT");
             $OPTN = 0;
           };
        $hotdata = $1;
        print DOGFILE $hotdata; #last chunk
        if (length $myNam > 0) # if name defined
                  { $SECTION = FixName($myNam, $c, $SECTION, $ec); 
                  };
        $ishot = 0;   # turn off.
        $chomper = 0; # back to default
        $chomped = 0; # redundant.
        $SECTIONTITLE = ''; 
      } else
      # see Comment[2] below
      { if ($chomped)
           { / *(.*)/;  # even allow null line ??
             $_ = $1;   # remove leading spaces!
           };
        if ($chomper)  # v2.0 (23/8/2005): chomp line feed if indicated!
           { chomp;
             $chomped = 1; # signal we've just chomped
           };
        if ( /^\s*\+OPTIONAL/)
           { $OPTN = 1;
             $_ = "";
           };
        if ( /^\s*-OPTIONAL/)
           { $OPTN = 0;
             $_ = "";
           }; 
        if ($MANDATORY || ! $OPTN)
           { print DOGFILE $_; # write to output
           };
      };
 };
            };
       }; # end of biig while stmt.
  close FRED;
  &CloseDogFile($thisW, $c, $eft, $ec);     
  &Caution($thisW, "Done!");
  return;
}

# Dwag v2.1.0 (Section 14)
sub ReadHeader
{
  my ($hotline);
     ($hotline) = @_;
  my ($ver, $target, $comment, $nowarn, $mandatory,
      $sft, $eft, $endComment);

  $ver = 0;
  $target = '';
  $comment = '#';
  $nowarn = 0;
  $mandatory = 0;
  $sft = '';
  $eft = '';
  $endComment = '';
  
  $hotline =~ /version=\`(\d+\.\d+\.\d+)\'/;  # version
  $ver = $1;    
  
  $hotline =~ /fileTarget=\`(.+?)\'/;         # file name
  $target = $1;
  
  $hotline =~ /startComment=\`(.+?)\'/;       # comment
  $comment = $1;
  
  if ($hotline =~ /include=\`everything\'/)
     { $mandatory = 1;
     };  
  
  if ($hotline =~ /noWarn=\`yes\'/)
     { $nowarn = 1;
     };
  if ($hotline =~ /endComment=\`(.*?)\'/)
     { $endComment = $1;
     };
  if ($hotline =~ /startFile=\`(.*?)\'/)      # ver 2.1
     { $sft = $1;
       $sft =~ s/\\n/\n/mg; # CR's !!
     };
  if ($hotline =~ /endFile=\`(.*?)\'/)      # ver 2.1
     { $eft = $1;
       $eft =~ s/\\n/\n/mg; # CR's !!
     };

  return ($ver, $target, $comment, $nowarn, $mandatory,
          $sft, $eft, $endComment);  
}

# Dwag v2.1.0 (Section 15)
sub Confirm
{ my ($thisW, $msg);
     ($thisW, $msg) = @_;
     
    my $D = $thisW->Dialog(
                 -title => "Confirm your choice",
                 -text  => "$msg",
                 -default_button => 'No',
                 -buttons        => ['No','Yes'],
                       );
    $_ = $D->Show();  # use Show for Tk-b9.01
    if ($_ eq 'Yes')
       { return 1;
       };
    return (0);
}

# Dwag v2.1.0 (Section 16)
sub Alert
{ my ($thisW, $msg);
     ($thisW, $msg) = @_;
     
    my $D = $thisW->Dialog(
                 -title => $msg,
                 -text  => "$msg",
                 -default_button => 'OK',
                 -buttons        => ['OK'],
                       );
    $D->title('Note..');
    $D->Show;
}

# Dwag v2.1.0 (Section 17)
sub Caution 
{ my ($thisW, $msg);
     ($thisW, $msg) = @_;
  print FILELOG "\n$msg";
  &Alert($thisW, $msg);
}

# Dwag v2.1.0 (Section 18)
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");
}

# Dwag v2.1.0 (Section 19)
sub ByeForNow
{ my ($thisW);
     ($thisW) = @_; # unused at present. 

close FILELOG;
exit;
}

# Dwag v2.1.0 (Section 20)
sub GlobalError
{ my ($msg);
     ($msg) = @_;
  print FILELOG "$msg";     
  $ERR = $msg; #ugly global ?!
}

# Dwag v2.1.0 (Section 21)
sub Debug
{ my ($thisW, $msg);
     ($thisW, $msg) = @_;

  print FILELOG "$msg";
     
     if (! $BUG)
        { return;
        };
  &Alert($thisW, $msg);
}


# Dwag v2.1.0 (Section 22)
sub CheckFred
{
  my ($thisW);
     ($thisW) = @_;
#  &Alert($thisW, "Value is <$fred>");
}

# Dwag v2.1.0 (Section 23)
sub Ask
{ my ($win, $title, $default);
     ($win, $title, $default) = @_;

  my ($db, $fred);
  my ($e);
  $fred = $default;
  
  $db = $win->DialogBox( -title => $title,  
                         -buttons => ["OK", "Cancel"]
                         );
  $e = $db->add('Entry', 
                -textvariable => \$fred)->pack(-padx => 50, 
                                               -pady => 15, 
                                               -ipadx => 5);

  my $choice = $db->Show; 
  if ($choice eq "Cancel")
     { return ("");
     };
  return ($fred);
}  

# Dwag v2.1.0 (Section 24)
sub StoreChild 
{  my ($pendingName, $dependencies);
      ($pendingName, $dependencies) = @_;
   my ($idx, $child);
   $idx = 1+$#CHILDREN;
   print FILELOG "\n Line $LINECOUNT: Storing child[$idx]";
   
   $_ = <FRED>; # first line *must* be begin verbatim
   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[$idx] = ",$dependencies,"; 
   $PENDINGNAME[$idx] = $pendingName;
   $CHILDREN[$idx] = ''; # default nothing
   
     my($ishot, $hotdata);
     my($nodogs, $ok);
     my($SECTION);
     $SECTION = 1;
     
     $ishot = 0;
     $ok=1;
     $nodogs=0; # default
     
     while($ok)
       { $_ = <FRED>;
         $LINECOUNT ++;
         
         if (! defined)
            { return 0; # fail
            } else
            { if ( /(.*)\\end\{verbatim\}/ )
                 { $ok = 0;
                 } else
                 { $child = "$child$_";  # concatenate, unchomped
                 };
            };
       };
  $CHILDREN[$idx] = $child; # store away lines to be printed   
  return 1; # success!
}

# Dwag v2.1.0 (Section 25)
sub FixName
{ my ($fname, $morenames, $c, $SECTION, $ec);
  ($fname, $c, $SECTION, $ec) = @_; # get name argument
  $morenames = ",$fname,"; 

  my ($idx);
  while ( $morenames =~ /^(.*,)(.+),$/ ) # split off last name
    { $fname = $2;
      $morenames = $1; 
      $idx = $#CHILDREN;
      while ($idx > -1)
        { if ($DEPENDENCIES[$idx] =~ /(.*,)$fname,(.*)/ ) 
             { $_ = "$1$2";  # if name in list, clip out
               print FILELOG " (dependency <$fname> resolved for child $idx)";
               $DEPENDENCIES[$idx] = $_;
               if ( /^,$/ ) # if all resolved 
                  {  print FILELOG "\n Writing child[$idx] ";
                     $SECTION = &PrintSectionHeader($c, $SECTION, $ec);
                     print DOGFILE $CHILDREN[$idx];
                     $CHILDREN[$idx] = ''; # (might even remove)
                     # ....WAIT! HERE MUST RESOLVE THIS ONE:
                     if (length $PENDINGNAME[$idx] > 0)
                        { $morenames = "$morenames$PENDINGNAME[$idx],";
                          $PENDINGNAME[$idx] = '';  # clear me!
                        };
                  };
             };
          $idx --; # move down to next
        };
    };
  return $SECTION;
}

# Dwag v2.1.0 (Section 26)
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.
}

# Dwag v2.1.0 (Section 27)
sub OpenTargetFile
{
  my ($thisW, $DOGFILE, $c, $FRED, $nowarn, $sft, $ec);
     ($thisW, $DOGFILE, $c, $FRED, $nowarn, $sft, $ec) = @_;
     my($ok);

  $TODAY = &GetLocalTime();
  $ERR = 0; # clumsy test for existence of file
     open DOGFILE, $DOGFILE or &GlobalError("OK");
     if (! $ERR)  # if file exists...
        { close DOGFILE;
          if ($nowarn)
             { $ok = 1;
             } else
             { $ok = &Confirm ($thisW, 
                 "Overwrite <$DOGFILE>? Are you sure?");
             };
          if (! $ok)
             { &Caution($thisW, "File $DOGFILE NOT overwritten!");
               # amendment v2.1.1 (2008-08-09): write to junk file:
               $DOGFILE = 'JUNK.JUNK';
             }; 
        };
    
     $ERR = 0;
     open DOGFILE, ">$DOGFILE" or 
        &GlobalError("Could not open target $DOGFILE :$!");
     if ($ERR)
        { $ERRCOUNT ++; # bump error count
          &Alert($thisW, $ERR);
          return 0; #fail
        };

  print FILELOG "\n\n Opened target file: <$DOGFILE>";
  print DOGFILE $sft; # very first text eg. for PHP.
  print DOGFILE 
    "$c Generated by LaTeX DogWagger Version " . 
    "$MAJORVERSION.$MINORVERSION.$TINYVERSION from file <$FRED>$ec\n";
  print DOGFILE "$c Date: $TODAY $ec\n";
  print DOGFILE "$c Do NOT edit this file. Edit the LaTeX source!!$ec\n";     

  return 1; # success
}

# Dwag v2.1.0 (Section 28)
sub CloseDogFile
{ my ($thisW, $c, $eft, $ec);
     ($thisW, $c, $eft, $ec) = @_;

  $ERRCOUNT += &CheckUnresolved();
  if ($ERRCOUNT > 0)
     { print FILELOG "<$ERRCOUNT!>";
       &Caution($thisW, 
         "WARNING: Error count $ERRCOUNT. See WAGLOG.LOG!");
       print DOGFILE 
         "\n\n$c -- WARNING: $ERRCOUNT ERROR(S). See log!$ec\n";
       $ERRCOUNT = 0; # clear me. 
     };  
     
     print DOGFILE "\n$c ---END OF FILE---$ec\n";
     print DOGFILE $eft; # version 2.1
     close DOGFILE;      #
     print FILELOG "\n <END OF FILE>";
}

# Dwag v2.1.0 (Section 29)
sub PrintSectionHeader
{ my($c, $SECTION, $ec);
    ($c, $SECTION, $ec) = @_;

  if (length $SECTIONTITLE > 0)
     { $_ = $SECTIONTITLE;
       if (/\$\[SECTION\]/) # if contains section count
          { s/\$\[SECTION\]/$SECTION/;
          };
          print DOGFILE "\n$c$_$ec\n";
     } else
     { print DOGFILE "\n$c --- <Section $SECTION> --- $ec\n";
     };
  #  if (($SECTION % 10) == 1) # removed in ver 2.1
  #     { print FILELOG "\n";
  #     };
  print FILELOG "\n" . "line $LINECOUNT: written as section [$SECTION]";
  $SECTION ++;
  return $SECTION;  
}

# Dwag v2.1.0 (Section 30)
sub Uudecode  
{ my ($MAINW) = @_;
  
  my ($filename, $mode, @rslt);
  my ($line, $decoded, $err);
  $filename = "";
  $line = <FRED>; # this should be \begin{verbatim} line:
  if ($line !~ /\\begin\{verbatim\}/ )
     { &Alert ($MAINW, "Uudecode: no verbatim <$line>");
       return ("", "", "");
     };

  $line = <FRED>; # MUST be header!
  chomp($line);
  $line =~ /begin\s+(\d{3})\s+(.+)/; 
  if (! defined $1)
     { # here write error!
       &Alert ($MAINW, "Uudecode: bad first UU line <$line>");
       return ("", "", "");
     };
  $mode = $1;
  $filename=$2;
  $err = 1; # -ve will signal failure
  
  while ( $line = <FRED> ) 
    { # hmm what if extra 0xD ?
      last if (! defined $line); # ??
      chomp($line);
      last if ($line =~ /^end/);
      if (! $err) # bad if err zero
         { &Alert ($MAINW, "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 ($MAINW, "Uudecode: error $err in <$line>");
           last; # terminate
         };
      push @rslt, $decoded;
    };
  return ($filename, $mode, join("",@rslt));
}

# Dwag v2.1.0 (Section 31)
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!
    # MUST CHECK ON HOW ROBUST unpack IS???
  $ld = length $decoded;
  if ($ld != $charlen)
     { return ("$ld:$charlen:$decoded", -3); # length doesn't match!
     };
  return ($decoded, 1); # success!
}
=thelastpage

# ---END OF FILE---