#!/opt/perl5/bin/perl -w
# change this to point to perl on your machine

##########################################################
#
#   btorder.pl will read a file of MARC records created by the 
#   BT Title Source II web application and create Sirsi flat 
#   file order records and modified MARC bib records for import 
#   into a Sirsi Unicorn database.
#
#   Steve Hunt, hunt_steve@smc.edu
#   Initial release, Feb. 2002
#
##########################################################

use MARC;
use Date::Manip;
use Getopt::Std;
use vars qw($opt_h $opt_v $opt_l);
use File::Basename;
use strict;
use diagnostics;

my ($holding_code, $mult, $order_library, $fund_id, $price, $vendor,
$dist_seg, $subfield, $aflag, $bflag, $flag, $fs_count, $ds_count, 
$f_copies, $d_copies, @line_notes, @order_data, @btnumber, 
@order_id, @price, @total_copies, @comment);

# Set the following variables for your site
# These must be as defined in your Sirsi policy files
my $fiscal_yr = '20102';
# Order Library is library placing order not destination library
my $default_order_library = 'MAIN'; 
# Holding code names indicate dest. libraries
# (Workflows: Cat Config, Holding Code)
# Use holding code policy names not codes
my $default_holding_code = 'MAIN-STACK';
my $default_vendor = 'BAKERTAYLOR';
my $order_type = 'FIRM';

# process command line
getopts('hl:v:') || &USAGE;
if (@ARGV < 1) {&USAGE;}
if ($opt_h) {&USAGE;}
if ($opt_v) {$vendor = uc($opt_v);} else {$vendor = $default_vendor;}
if ($opt_l) {$order_library = uc($opt_l);}
	else {$order_library = $default_order_library;}
(my $inputfile, my $datapath) = fileparse($ARGV[0]);
sub USAGE {die "USAGE $0 [-l order_library] [-v vendor] inputfile\n\n";}

# Change these dates for your site
my $dateready = &UnixDate("today","%Y%m%d");  # ready today
my $dateclaim = &DateCalc("$dateready","+ 90 days"); # claim in 90 days
my $datecancel = &DateCalc("$dateready","+ 180 days"); # cancel in 180 days

$dateclaim = &UnixDate("$dateclaim","%Y%m%d");
$datecancel = &UnixDate("$datecancel","%Y%m%d");

my $record_count = my $record_error_count = my $warnings = my $records_written = 0;

# Output for new orders file
my $neworderfile = $inputfile . "-neworder";

# Output for modified MARC records
# change this for your site
# bibload looks in Unicorn/Marcimport
my $newmarc = "/opt/sirsi/Unicorn/Marcimport/" . $inputfile . "-newmarc";

# Optional ASCII output of original MARC records
# this option is off by default
my $asciimarc = $inputfile . "-ascii";

# Optional ASCII output of modified MARC records
# uncomment further down in script to turn on
my $newasciimarc = $inputfile . "-newascii";


# Should not need to change anything below this point
# But please keep reading...

# Dont want to append to files if script is rerun with same inputfile
if (-r $neworderfile)	{unlink ($neworderfile);} 
if (-r $newmarc)	{unlink ($newmarc);}
if (-r $asciimarc)	{unlink ($asciimarc);} 
if (-r $newasciimarc)	{unlink ($newasciimarc);} 


my $x = new MARC;
$x->openmarc({file=>"$datapath$inputfile",'format'=>"usmarc"}) 
	or die "Couldn't open $datapath$inputfile: $!\n";

open (FH, ">>$neworderfile") or die "Couldn't open $neworderfile: $!\n";

# look at records one at a time rather than all at once
while ($x->nextmarc(1)) {

	++$record_count;

#	uncomment the following line for ASCII output of MARC input file
#	$x->output({file=>">>$asciimarc",'format'=>"ascii"});

#	extract and test data from input file
	@btnumber = $x->getvalue({record=>'1',field=>'001'}); 
	unless ($btnumber[0]) {&skip_record ("001", "record"); next;}

	@order_id = $x->getvalue({record=>'1',field=>'901',subfield=>'x'}); 
	unless ($order_id[0]) {&skip_record ("order id", $btnumber[0]); next;}

	@price = $x->getvalue({record=>'1',field=>'901',subfield=>'y'}); 
	unless ($price[0]) {&skip_record ("price", $btnumber[0]); next;}

	@total_copies = $x->getvalue({record=>'1',field=>'901',subfield=>'z'});
	unless ($total_copies[0]) {&skip_record ("copies", $btnumber[0]); next;}

	@line_notes = $x->getvalue({record=>'1',field=>'901',subfield=>'a'}); 
	unless ($line_notes[0]) {&skip_record ("line notes", $btnumber[0]); next;}


	$btnumber[0] = uc($btnumber[0]); 
 	$btnumber[0] =~ s/\s+//g;

#	Add 099 call number, delete 901, output MARC record
#	The 099 is what links the the order record to the bib record
	$x->addfield({record=>"1", field=>"099",value=> [a=>"XX(ORDER-$btnumber[0].1\)"]});
	$x->deletemarc({record=>'1',field=>'901'});
	$x->rebuild_map_all(1);
	$x->output({file=>">>$newmarc",'format'=>"usmarc"});

#	uncomment for ASCII output of modified records
#	$x->output({file=>">>$newasciimarc",'format'=>"ascii"});

#	empty the object for reading in another record
	$x->deletemarc(); 

#	now we work on the order records
#	order_id began as our cart name and will be used for PO number 
	$order_id[0] = uc ($order_id[0]); 
	substr($order_id[0], 20) = '' if length($order_id[0]) > 20;

#	split on the $
#	not using marc.pm anymore (they look like subfields but they're not!)
	@order_data = split /\$/, $line_notes[0]; 

# 	remove any null element and leading whitespace
	if ($order_data[0] =~ /^\s*$/) {shift @order_data;}
	$order_data[0] =~ s/^\s+//;

# 	if first entry does not begin with an a then add it
	unless ($order_data[0] =~ /^a/) {$order_data[0] =~ s/^/a /;}

#	stop at the end, end at the stop
	push (@order_data, "stop");		

	$dist_seg = $fs_count = $ds_count = $aflag = $bflag = $flag = 0;

	&print_orderline_begin;

	foreach (@order_data) {
		s/^\s+//;

		CASE:	{	
		/^a/ and do 
		{ s/^a//; $fund_id = uc($_); $aflag = 1; last CASE; };

		/^b/ and do 
		{ s/^b//; $holding_code = uc($_); $bflag = 1; last CASE; };

		/^c/ and do 
		{ s/^c//; $f_copies = $_; $flag = 1; last CASE; };

		/^d/ and do 
		{ s/^d//; $d_copies = $_; $flag = 1; last CASE; };

		/^e/ and do 
		{ s/^e//; $mult = int(length()/80); # chop into 80 char pieces 
			  $mult +=1 if (length()%80);
    			  @comment = unpack ("a80" x $mult, $_);
			  $flag = 1; &print_line_comment; last CASE; };

		/^stop/ and do 
		{ $flag = 1; last CASE; };

		# else...
		print STDERR "Warning: in $btnumber[0] subfield: $_ is not recognised \n";
		++$warnings;
		} # esac

		if ($aflag and ($bflag or $flag)) {
			if (! $f_copies) {$f_copies = $total_copies[0];}
			&print_fund_seg;
			$fs_count += $f_copies;
			$aflag = $flag = $f_copies = 0;
			}

		if ($bflag and ($aflag or $flag)) {
			if (! $d_copies) {$d_copies = $total_copies[0];}
			&print_dist_seg;
			$ds_count += $d_copies;
			$dist_seg = 1;
			$bflag = $flag = $d_copies = 0;
			}

		}	# go get more data for this orderline


#	generate single dist segment if not supplied from data
	if (! $dist_seg) {
		$holding_code = $default_holding_code;
		$d_copies=$total_copies[0];
		$ds_count += $d_copies;
		&print_dist_seg;
		}

	if (($ds_count != $fs_count) or ($ds_count != $total_copies[0])) {
		print STDERR "Warning: in $btnumber[0] line copies, fund copies and dist copies are not equal!\n";
		print STDERR "line copies: $total_copies[0] fund copies: $fs_count dist copies: $ds_count\n";
		++$warnings;
		}

	&print_orderline_end;

	++$records_written;

 }	# go get the next bib record


print STDERR "$record_count records read\n";
print STDERR "$record_error_count records had errors\n";
print STDERR "$records_written records written\n";
print STDERR "$warnings records had warnings\n";


$x->closemarc();
close (FH);
exit 0;

sub skip_record {
	print STDERR "Error: $_[0] not found in $_[1], skipping\n";
	++$record_error_count;
	$x->deletemarc();
}

sub print_orderline_begin {
	printf FH ("*** DOCUMENT BOUNDARY ***\n");
	printf FH ("FORM=LDORDER\n");
	printf FH (".ORDR_ID.  %s\n", $order_id[0]);
	printf FH (".ORDR_LIBR.   %s\n", $order_library);
	printf FH (".FISCAL_CYCLE.   %s\n", $fiscal_yr);
	printf FH (".VEND_ID.   %s\n", $vendor);
	printf FH (".ORDR_TYPE.   %s\n", $order_type);
	printf FH (".ORDR_DATE_READY.   %s\n", $dateready);
	printf FH (".ORDR_DATE_CLAIM.   %s\n", $dateclaim);
	printf FH (".ORDR_DATE_CANCEL.   %s\n", $datecancel);
	printf FH (".LINE_ITEM_BEGIN.\n");
	printf FH (".LINE_CALLNUM.   XX(ORDER\-%s.1)\n", $btnumber[0]);
	printf FH (".LINE_UNIT_PRICE.   \$%s\n", $price[0]);
	printf FH (".LINE_COPIES.   %s\n", $total_copies[0]);
	printf FH (".LINE_DISCOUNT.   TABLE\n");
}

sub print_fund_seg {
	printf FH (".FUND_SEGMENT_BEGIN.\n");
	printf FH (".LINE_FUND_ID.   %s\n", $fund_id);
	printf FH (".LINE_FUND_COPIES.   %s\n", $f_copies);
	printf FH (".FUND_SEGMENT_END.\n");
}

sub print_dist_seg {
	printf FH (".DIST_SEGMENT_BEGIN.\n");
	printf FH (".HOLDING_CODE.   %s\n", $holding_code);
	printf FH (".LINE_DIST_COPIES. %s\n", $d_copies);
	printf FH (".DIST_SEGMENT_END.\n");
}

sub print_line_comment {
	printf FH (".LINE_XINFO_BEGIN.\n");
	foreach (@comment) {
		printf FH (".COMMENT.   %s\n", $_);
		}
	printf FH (".LINE_XINFO_END.\n");
}

sub print_orderline_end {
	printf FH (".LINE_ITEM_END.\n");
}