#!/usr/bin/perl
# nudecode -- New uudecode
#	Brian Katzung	20 August 1994
#
#	Copyright 1994 by Brian Katzung
#
# This software is provided on an as-is basis.  Use it at your own risk.
# This software may be distributed for free.  It may not be sold, either
# separately, or as part of a package, without written permission from
# the author.
#
# usage:  nudecode [-c#] [-owhat] [-rold new] [-denwsv] [--] [file...]
#	-c#	Set number of contiguous lines to recognize continuation
#	-owhat	Only extract some files (by name or number)
#	-rold new	Rename to new name on extraction
#	-d	Debug mode
#	-e	Allow extended character set (default auto)
#	-n	Disallow extended character set (default auto)
#	-w	Allow overwrite of existing files
#	-s	Allow slashes (directory components) in file names
#	-v	Verbose

$NO = 0;
$YES = 1;
$MAYBE = 2;

######################################################################
# Decode one file
sub decode
{
	local($file) = $_[0];
	local($myExtended);
	local($inData);
	local($valid);
	local($line);
	local($mLength);
	local(*FILE);
	local(@full);
	local(@partial);

	unless ($debug == $YES || open(FILE, ">$file"))
	{
		print STDERR "nudecode (error): $!: $file\n";
		return '';
	}

	$myExtended = $extended;
	$mLength = 60;
	$inData = $YES;
	while (<>)
	{
		last if /^end|^begin [0-7]{3,4} /;

		# Determine how much of the line contains valid data.
		$valid = $_;
		if ($myExtended == $NO)
		{
			$valid =~ s/[^ -`].*//;
		}
		else
		{
			$valid =~ s/[^ -~].*//;
		}

		if (($myExtended == $NO? /^[^ -M`]/: /^[^ -M`-~]/) ||
		  (length($valid) - 1) * 6 < (((ord() - 32) & 077) * 8))
		{
			# This line has an invalid byte count or is
			# too short for the specified byte count.
			if ($debug == $YES)
			{
				foreach $line (@full, @partial)
				{
					# Lines we considered
					print "? $line";
				}
				# The invalid line
				print "- $_";
			}
			@full = ();
			@partial = ();
			$inData = $NO;
			$myExtended = $NO if $myExtended == $MAYBE;
			next;
		}

		if (($inData != $YES)? /^M.{60,$mLength}() *$/:
		  /^M.{60,$mLength}(.*[^ \n])? *$/)
		{
			# This is a full length line.

			# Adapt to extraneous slop.
			$mLength += length($1);

			if ($#partial >= 0)
			{
				if ($debug == $YES)
				{
					# Lines we considered
					print "? $line"
					  while $line = pop(@full);
				}
				@full = ();
			}
			push(@full, $_);
			if ($debug == $YES)
			{
				# Lines we considered
				print "? $line" while $line = pop(@partial);
			}
			@partial = ();
			$inData = $YES if $#full >= $context;
			unless ($inData == $NO)
			{
				$myExtended = $YES
				  if $myExtended == $MAYBE && /[a-~]/;
				if ($debug == $YES)
				{
					# The data we would actually use
					print "* $_" while $_ = shift(@full);
				}
				else
				{
					print FILE unpack('u', $_)
					  while $_ = shift(@full);
				}
			}
		}

		else
		{
			# This is either one of the last (short)
			# lines or junk.
			if ($#partial == 1)
			{
				if ($debug == $YES)
				{
					# Lines we considered
					print "? $line"
					  while $line = pop(@full);
					print "? $partial[0]";
				}
				@full = ();
				$inData = $NO;
				$myExtended = $NO if $myExtended == $MAYBE;
				shift(@partial);
			}
			push(@partial, $_);
		}
	}

	$line = $_;
	if (eof() || /^end/)
	{
		foreach (@full, @partial)
		{
			$myExtended = $YES if $myExtended == $MAYBE && /[a-z]/;
			if ($debug == $YES)
			{
				# Data we would actually use
				print "* $_";
			}
			else
			{
				substr($_, 0, 1) =~ tr/a-z/!-:/;
				print FILE unpack('u', $_);
			}
		}
	}
	elsif ($debug == $YES)
	{
		foreach (@full, @partial)
		{
			# Lines we considered
			print "? $_";
		}
	}
	close(FILE);

	print "nudecode (warning): Decoded extended character set: $file\n"
	  if $extended == $MAYBE && $myExtended == $YES;
	print "nudecode (warning): Lines have extraneous characters (",
	  $mLength - 60, "): $file\n" unless $mLength == 60;
	if ($line =~ /^end/)
	{
		print "@ end\n" if $debug == $YES;
		'';
	}
	else
	{
		print "nudecode (error): No end line: $file\n";
		$line;
	}
}

######################################################################
# Main program

$context = 3;			# Good context -1 required for confidence
$debug = $NO;
$extended = $MAYBE;		# Use extended character set
%only = ();			# Select some from several in stream
$overwrite = $NO;		# Overwrite existing files
%rename = ();			# Rename on extraction
$slash = $NO;			# Allow slashes in names
$verbose = $NO;

while ($ARGV[0] =~ /^-/)
{
	$context = $1 - 1 if $ARGV[0] =~ /-c(\d+)/;
	$debug = $YES if $ARGV[0] eq '-d';
	$extended = $YES if $ARGV[0] eq '-e';
	$extended = $NO if $ARGV[0] eq '-n';
	$only{$1} = 1 if $ARGV[0] =~ /-o(.+)/;
	$overwrite = $YES if $ARGV[0] eq '-w';
	if ($ARGV[0] =~ /^-r(.*)/)
	{
		$rename{$1} = $ARGV[1];
		splice(@ARGV, 0, 2);
		next;
	}
	$slash = $YES if $ARGV[0] eq '-s';
	$verbose = $YES if $ARGV[0] eq '-v';
	last if shift(@ARGV) eq '--';
}

$item = 0;
while (<>)
{
	# Ignore everything up to a "begin" line
	unless (/^begin ([0-7]{3,4}) ([^\r\n]*)/)
	{
		# Lines skipped during "begin" scan
		print "/ $_" if $debug == $YES;
		next;
	}

	# A begin line
	print "@ $_" if $debug == $YES;

	# Skip this file if we're only supposed to extract some files
	# from the input stream and neither the item number nor any
	# flavor of the file name appears in the "only" list.
	# Renaming also occurs here.
	++$item;
	($f1 = $2) =~ s/[\000-\037\200-\377]/_/g;	# No invisibles
	$f2 = $f1;
	$f2 =~ s/\//_/g unless $slash == $YES;		# No slashes
	$file = $rename{$f2} || $f2;
	next if scalar(%only) &&
	  !($only{$item} || $only{$f1} || $only{$f2} || $only{$file});

	if ($overwrite == $NO && -e $file)
	{
		print "nudecode (note): Skipping existing file: $file\n";
		next unless $debug == $YES;
	}

	if ($verbose == $YES || $debug == $YES)
	{
		print "nudecode (status): Decoding file: ";
		print "$f1 -> " if $f1 ne $file;
		print "$file\n";
	}
	$_ = &decode($file);
	chmod(oct($1), $file) unless $debug == $YES;
	redo if $_ ne '';
	last if eof();
}

0;