#!/usr/bin/perl
#Split out a SOURCE dump of an UPDATE library
#made with SCOPY to individual files.
#unlike MODIFY we don't have EORs separating decks
#instead the next source deck begins at the next
#*DECK  or  *COMDECK directive
#we also need to identify the file names by these directives.
#a file name may be any number of spaces from the end of the directive
#must be no more than 9 chars long upper case alphanumeric (but may contain other symbols like = or $)
#we filter for / and flag it as an invalid file name.
#a filename can also begin without a space separated from  the directive by a comma.
#
my $masterchar = '\*';
$_ = <>; # get first line
my	$file = $_;
        if(check_file($file)) {	
		exit 0 if($file =~ /^--EOF--/);
		exit 0 if($file =~ /^--EOR--/); 
		print "This does not look like a program library dump\n";
		print "we got $_ as the first line instead of a *deck or *comdeck directive\n";
		exit 1;
        } else {
		mkdir("UPLRC");
		write_files($_)
	}


#Make sure we hit a file
#a file should be all uppercase,
#not exceed 7 chars and
#contain no chars other than
#A-Z0-9
#we return a 0 for success and
#a 1 for fail. 
sub check_file {
     	my $directive = $_;
        my $file = "";
	if ($directive =~ /^($masterchar)COMDECK/) {
		$file = get_fname($directive);
	}
	if ($directive =~ /^($masterchar)DECK/) {
		$file = get_fname($directive);
	}
	if (length($file) <= 9) {
		if(length($file) >0 ) {
			if($file eq uc $file) {
				if($file =~ /\//)
				{
					return 1;
			        }
				return 0;
			}
		}
	}
	return 1;
}

#extract filename from
#*comdeck or *deck directive
sub get_fname {
	chomp;
        my $file = $_;
        if($file =~ /^($masterchar)COMDECK/) {
                $file =~ s/^($masterchar)COMDECK//;
        }
        if($file =~ /^($masterchar)DECK/ ) {
                $file =~ s/^($masterchar)DECK//;
        }
        #if a deck directive was used with a , as a separator we now have
        #a comma in front of our file name, remove it.
        if($file =~ /^,.*/) {
            $file =~ s/^,//;
        }
        $file =~ s/,.*//g;   #remove everything after first comma. 
        $file =~ s/\..*//g; #remove everything after first dot.
        $file =~ s/^\s+//; #left trim spaces
        $file =~ s/ .*//;  #remove first space and all after it
        $file =~ s/\///g;  #remove / globally.
	
        return "$file";
}

#extract update source files until we hit
#an --EOR-- or --EOF-- marker
#unlike splitmodify the main while loop is here
#because of the need to not swallow the directive line.
sub write_files {
	my $fh;
	my $file;
	my $line = $_;
	while(1) {
		$file = get_fname($line);
		if(check_file($line)) {
			print "invalid file name '$file'\n";
			exit 1;
		}
		if($line =~ /^($masterchar)COMDECK/) {
			open($fh,">","UPLRC/$file");
			print "extracting UPLRC/$file\n";
		} else {
			open($fh,">","$file");
			print "extracting $file\n";
		}
		print $fh $line;
		while(<>) {
			$line = $_;
			if($line =~ /^($masterchar)DECK/) {
				close($fh);
				last;
			}	
			if($line =~ /^($masterchar)COMDECK/) {
				close($fh);
				last;
			}
			if($line =~ /^--EOR--/) {
				close($fh);
				exit 0;
			}
			if($line =~ /^--EOF--/) {
				close($fh);
				exit 0;
			}
			print $fh $_;
		}
	}
}
