#!/usr/bin/perl

# @(#)@ unpack	1.4 - unpack.pl
#
# unpack a set of files sent by "dorequest"
# with a bit of error detection
#
# Usage: save all the parts in one big file (in the correct order), 
# say "foo", and then execute:
#
#   perl unpack.pl foo
#
# Note: if the filename contains a path, all subdirectories should 
# exist!
# Multiple files in one input stream are allowed: e.g:
#
#------ begin of INDEX -- ascii -- complete ------
#------ end of INDEX -- ascii -- complete ------
#------ begin of zoo.TZ -- btoa encoded -- part 1 of 2 ------
#------ end of zoo.TZ -- btoa encoded -- part 1 of 2 ------
#------ begin of zoo.TZ -- btoa encoded -- part 2 of 2 ------
#------ end of zoo.TZ -- btoa encoded -- part 2 of 2 ------
#
#

$uudecode = "/usr/bin/uudecode";
$btoa = "/usr/local/bin/btoa";

do init ();

while ( $line = <> ) {

  if ( $line =~ /^------ begin of (.+) -- (.+) -- (.+) ------/ ) {
    print stderr $line;

    # if a filename is known, it must be the same
    if ( $file ) {
      if ( $file != $1 ) {
	do errmsg ("filename mismatch");
      }
    }
    else { $file = $1; }

    # if an encoding is known, it must be the same
    if ( $encoding ) {
      if ( $encoding != $2 ) {
	do errmsg ("encoding mismatch");
      }
    }
    else {
      # determine encoding and build command
      $encoding = $2;
      if ( $encoding eq "uuencoded" ) {
	$cmd = "|" . "$uudecode";
      }
      elsif ( $encoding eq "btoa encoded" ) {
	$cmd = "|" . "$atob > $file";
      }
      else {
	$cmd = ">$file";
      }
    }

    # if a 'parts' section is known, it must match
    # a bit more complex ...
    $tparts = $3;
    if ( $parts ) {
      if ( $tparts =~ /part (\d+) of (\d+)/ ) {

	$thispart++;	# increment part number and check
	if ( $thispart != $1 ) {
	  do errmsg ("sequence mismatch");
	}

	# total number must match also
	if ( $numparts ) {
	  if ( $numparts != $2 ) {
	    do errmsg ("numparts mismatch");
	  }
	}
	else {
	  $numparts = $2;
	}
      }
      elsif ( $parts ne $tparts ) {
	do errmsg ("parts mismatch");
      }
    }
    else {

      # no 'parts' known yet
      $parts = $tparts;
      if ( $tparts =~ /part (\d+) of (\d+)/ ) {
	$thispart = $1;
	# should be first part
	if ( $thispart != 1 ) {
	  do errmsg ("sequence mismatch");
	}
	$numparts = $2;
      }
      else {
	$numparts = $thispart = 1;
      }
    }

    # if we have a file open, enable copying
    if ( $fileok ) {
      $copy = 1;
    }
    elsif ( open (outfile, $cmd) ) {
      $fileok = 1;
      $copy = 1;
    }
    else {
      do errmsg ("cannot create $cmd");
    }
    
    # matching end header to look for
    $trailer = "------ end " . substr ($line, 13, length($line)-13);

  }
  elsif ( $line =~ /^------ end of (.+) -- (.+) -- (.+) ------/ ) {
    print stderr $line;

    # check that the header matches
    if ( $line ne $trailer ) {
      do errmsg ("header/trailer mismatch");
    }

    # wrap up if this was the last part
    do wrapup () if $thispart == $numparts;

    # stop copying
    $copy = 0;
  }
  else {
    print outfile $line if $copy;
  }
}

if ( $numparts && ( $thispart != $numparts )) {
  do errmsg ("only $thispart of $numparts parts found");
}

if ( $fileok) {
  do errmsg ("unterminated section") if $?;
}

sub init {
  $encoding = "";
  $parts = "";
  $numparts = "";
  $file = "";
  $copy = 0;
  $thispart = 0;
  $fileok = "";
}

sub wrapup {
  close (outfile);
  do errmsg ("output close error") if $?;
  do init ();
}

sub errmsg {
  print stderr pop(@_), " at input line $..\n";
  exit 1;
}

sub source {
    local($file) = @_;
    local($return) = 0;

    $return = do $file;
    die "couldn't parse $file: $@" if $@;
    die "couldn't do $file: $!" unless defined $return;
    die "couldn't run $file" unless $return;
    $return;
}