#!/usr/athena/bin/perl

require "getopts.pl";

&Getopts('hvf:');

if ($opt_h) {
	print " h   Print this help information\n";
	print " v   Be extra verbose\n";
	print " f <name>   File, use this file for input\n";
	exit;
}

#### CONSTANTS ####

$leadersize = 24;
$tagsize = 3;
$indicatorsize = 2;
$eor = "\035";	# end of record marc
$eot = "\036";	# end of tag (field) mark
$sfd = "\037";	# subfield delimiter
%transaction = (
	'01', 'PRODUCE . . . . . . .',
	'02', 'UPDATE. . . . . . . .',
	'03', 'CANCEL. . . . . . . .',
	'11', 'REPLACE . . . . . . .',
	'50', 'ALL PRODUCE . . . . .',
	'90', 'OFFLINE RETRIEVE. . .',
	'92', 'OFFLINE UPDATE. . . .',
	'93', 'OFFLINE CANCEL UPDATE',
	'94', 'MICROCON UPDATE . . .',
	'78', 'Exported CD or ME . .',
	'65', 'Exported via PRISM. .',
);

#### PARAMETERS ####

#### SUBROUTINES ####

sub getline {
	$thisline = defined($lookahead) ? $lookahead : <IN>;
	line: while ($lookahead = <IN>) {
		if ($lookahead =~ /^[ \t]/) {
			$lookahead =~ s/^[ \t]+/ /;
			$thisline =~ s/\n//g;
			$thisline .= $lookahead;
			$thisline =~ s/\s$//;
		} else {
			last line;
		}
	} # end of the line
	$thisline;
} # end getline

sub writemarc {
	defined($leader) || return;
	
	$data = "";
	$directory = "";
	$total = 0;
	
	foreach $line (@tag) {
		($entry, $x, $indicators, $content) = unpack("a3 a1 a2 a*", $line);
		$content =~ s/\s*($sfd.)\s*/$1/g;
		$content = $indicators . $content . $eot;
		$length = length($content);
		$entry .= sprintf("%04d%05d",$length,$total);
		$directory .= $entry;
		$total += $length;
		$data .= $content;
		$opt_v && print "tag: $entry $content\n";
	} # end of tags
	undef @tag; # so that we don't get extra data the next time around
	
	$data .= $eor; $total++;
	
	$directory .= $eot;
	$length = length($directory) + 24;
	$total += $length;
	
	($x, $reclen, $lead1, $baseaddr, $lead2, $tcode, $lead3)
		= unpack("a4 a5 a7 a5 a5 a1 a1", $leader);
	TCODE: {
		if ($tcode == "P") {
			($tcode = "\001");
			last TCODE;
		}
		if ($tcode == "U") {
			($tcode = "\002");
			last TCODE;
		}
		if ($tcode == "C") {
			($tcode = "\003");	
			last TCODE;
		}
		if ($tcode == "R") {
			($tcode = "\021");	
			last TCODE;
		}
	}
	$leader = sprintf("%05d%s%05d%s%s%s", 
		$total, $lead1, $length, $lead2, $tcode, $lead3
	);
	
	$opt_v && print "\n";
	print "$leader$directory$data";
	$opt_v && print "\n";
	
} # end writemarc

#### MAIN PROGRAM ####

if ($opt_f) {
	open(IN, "< $opt_f");
} else {
	open(IN, "-");
}
#open(OUT, "> $output");

while ($_ = &getline()) {
	s/\n//g;
	CASE: {
		if (/^LDR /) {
			&writemarc();
			$seq = 0;
			$leader = $_;
			last CASE;
		}
		if (/^\d\d\d /) {
			s/\|/$sfd/g;
			s/$sfd$sfd/\|/g;
			$tag[$seq++] = $_;
			last CASE;
		}
		$opt_v && print "ignoring: $_\n";
	}
}
&writemarc();
