#!/usr/bin/perl


# Copyright 2010 Ian Walls
#
# This script is a supplemental tool to Koha to aid libraries in the migration 
# from Innovative Interfaces, Inc.'s Millennium ILS.  
#
# This is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any later
# version.
#
# This script is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along with
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA  02111-1307 USA

# Special thanks to Cody Hennesy of California College of the Arts for beta
# testing

# The script requires a comma-delimited text file, generated by Millennium, as 
# input. Each line should contain a single bibliographic record number, followed
# by all its attached item record numbers (and optionally checkin records).  The
# script will pull the XML record for each of these, and bundle them into a 
# FULLRECORD tag.  The full structure of the generated XML is as follows:
#
# <RECORDBATCH @time @batch>
#   <FULLRECORD>
#    +<recordtype @number> <-- which is either BIB, ITEM, CHECKIN or AUTHORITY.  
#       <IIIRECORD> <-- with all attendant child tags
#     </recordtype>
#   </FULLRECORD>
# </RECORDBATCH>
#
# In order to keep the IIIXML files a reasonable size, the script batches the 
# input. This can be set with the -l flag, or the default (300) can be used.
# The IIIXML files are grouped in a directory, and given numerical filenames
#  (example:  /myimport/004.xml)
# The directory can be specified with -dir, otherwise the current Unix time will
# be used; this ensures that running the script multiple times will not 
# overwrite data by accident.  Similarly, the directory for the MARCXML can 
# either be specified, or it will default to the IIIXML directory name (as
# defined by either -dir or the default created) with  'MARC-' as a prefix.
#
# This script can handle authority record import as well.  There is no need to 
# set the $auth flag if you start at stage 1 (authority records can be detected 
# automagically), but if you resume at stage 2 or 3, -a will need to be used to 
# hard-set $auth



# Modules to use for this script
use LWP::Simple;
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Response;
use Getopt::Long;

# Global parameters
my $IIIserver = '';  # your institution's Millennium URL (no http:// required)
my $bibXSLT = 'iii_to_marcxml.xsl';
my $authXSLT = 'iii_auth_to_marcxml.xsl';
my $sourcetag = '999';
my $sourcefield = 'c';

# Optional parameters per invocation
my ($inputfile, $batchname) = ('', time());
my ($batchsizelimit, $batchnumber) =  (300, 1);
my $stage = 1;
my ($marcbatchname, $verbose, $auth, $help);
GetOptions(
  'f|file:s'	=> \$inputfile,
  'dir:s'	=> \$batchname,
  'mdir:s'	=> \$marcbatchname,
  'l:f'		=> \$batchsizelimit,
  'v'		=> \$verbose,
  'a'		=> \$auth,
  's|stage:f'	=> \$stage,
  'h|help'	=> \$help
);
$marcbatchname = "MARC-$batchname" unless (defined $marcbatchname);


if (defined $help || $stage > 3) {
    print <<EOF
Small script to import bibliographic records into Koha.  Before using the import
stage, be sure to (in Millennium Administration), go to Web options > XRECTYPE 
and make sure all of the following letters are included: bica

Parameters:
  f|file  /path/to/file: the file to import
  dir     name for IIIXML directory (defaults to Unix time)
  mdir    name for MARCXML directory (defaults to 'MARC-' + IIIXML directory name)
  l       batch size (default 300)
  v       verbose mode
  s|stage where in the process to start
            1. pull records from III server (default)
            2. convert records to MARCXML with Xalan
            3. import records into Koha
  a       hardset authority flag (only necessary if resuming at stage 2 or 3)
  h|help  this screen 
  
For more help, view the code.      

EOF
;#'
exit;
}


# create a browser for pulling III XML.  Used by sub getIIIXML().
my $browser = LWP::UserAgent->new();
$browser->timeout(15);

if ($stage == 1) {
	my $starttime = time();

unless (defined $IIIserver)
  PROMPT: print STDOUT "Please enter the URL for your Millennium OPAC (no http:// required)";
	$IIIserver = chomp(<STDIN>);
	unless (defined $IIIserver) { goto PROMPT} ;
}

	# open input argument file
	open(IN, $inputfile) || die "Can't open input file...\n";

	print STDOUT "Batch size limit = $batchsizelimit.  Starting with batch $batchnumber\n " if (defined $verbose);

	pullrecordsfromIII();

	my $timetaken = time() - $starttime;
	print STDOUT "Records pulled into $batchnumber files in (/$batchname directory)\n" if (defined $verbose);
	print STDOUT "Time taken: $timetaken\n" if (defined $verbose);

	# Prompt to continue to stage 2
	print STDOUT "Do you wish to transform the IIIXML into MARCXML using Xalan? (y/n) ";
	PROMPT: chomp($continue = <STDIN>);
	if ($continue =~ /^y/i) {
		$stage++;		
	} elsif ($continue =~ /^n/i) {
		print STDOUT "Script ended at stage 1\n";
		print STDOUT "Run this script with flag '-s 2' to resume with transformation, or transform to MARCXML yourself and use '-s 3' to go directly to stage 3\n" if (defined $verbose);
	} else {
		print STDOUT "Sorry, didn't understand that... please type 'y' or 'n': ";
		goto PROMPT;
	}
}

# Stage 2: XSLT transformation
# This script uses Xalan to do the transformation.  If you do not have or do not
# wish to use Xalan, you may transform the IIIXML on your own, and run this 
# script again at stage 3.

# TODO: Increase the number of XSLT transformation options

if ($stage == 2) {
	my $starttime = time();
	applyXSLT();
	my $timetaken = time() - $starttime;
	print STDOUT "XSLT applied to all IIIXML files in /$batchname\nMARCXML can be found in $marcbatchname with same batch number\n" if (defined $verbose);
	print STDOUT "Time taken: $timetaken\n" if (defined $verbose);

	# Prompt to continue to stage 3
	print STDOUT "Do you wish to import the MARCXML into Koha now? (y/n) ";
	PROMPT: chomp($continue = <STDIN>);
	if ($continue =~ /^y/i) {
		$stage++;
	} elsif ($continue =~ /^n/i) {
		print STDOUT "Script ended at stage 2\n";
		print STDOUT "You can pickup at stage 3 with the flag '-s 3' to perform the import into Koha\n" if (defined $verbose);
	} else {
		print STDOUT "Sorry, didn't understand that... please type 'y' or 'n': ";
		goto PROMPT;
	}
}

# Stage 3: Import MARCXML into Koha

if ($stage == 3) {
	importintoKoha();
	print STDOUT "All MARCXML in /$marcbatchname imported\n" if (defined $verbose);	
	print STDOUT "Script complete\n";
	print STDOUT "If you use Zebra indexing, remember to run rebuild_zebra.pl!\n" if (defined $verbose);
}




# ----------------------------Stage 1 functions --------------------------------

# Fetches the Xrecord from III, writes it to file using the IIIXML structure
sub pullrecordsfromIII {
	# This line lets you can see the processing count in realtime
	$|++;
	my $linecounter = 1;
	
	# Loop through the input, wrapping each line in <FULLRECORD> and sending each 
  # recordnumber to sub getIIIXML()
	#
	# Break the output into files of $batchsizelimit number of bibs in order to 
  # keep the size of the IIIXML files reasonable
	
	openBatch();
	
	while (<IN>){
	  print STDOUT "\rProcessing line: $linecounter    Batch #$batchnumber";
	  # this conditional closes the current file once the $batchsizelimit number 
    # of bibs has been reached.  Opens a new file with the next batch number.  
    # The RECORDBATCH tag has its time and batch attributes recalculated.
	  if ($linecounter % $batchsizelimit == 0) {
		closeBatch();
		$batchnumber++;
		openBatch();
	  }
	  chomp();
	  # Skip the Create Lists 'header' line if it exists
	  if (/RECORD/) { next;}
	  print OUT "<FULLRECORD>\n";
	  @recordnumbers = split(/,/);
	  foreach $recordnumber (@recordnumbers) {
	    if ($recordnumber =~ /^\s+$/) { next;}
	    # strips the quotes and check digit
	    $recordnumber =~ s/^"(\w\d+)[\dx]"/$1/;
	    print OUT &getIIIXML($recordnumber);
	  }
	  print OUT "</FULLRECORD>\n";
	  $linecounter++;
	}
	closeBatch();
	print STDOUT "\rProcessing Complete!                                  \n";
	close(IN);
}

sub openBatch {
	# pads the batch number to preserve numerical order on import.  
  # TODO: currently hardcoded to 3 digits; set to automagically detect the right
  #  number of places to pad
	my $paddedbatchnumber = sprintf("%03d",$batchnumber);
	# creates directory for IIIXML unless it already exists
	mkdir "$batchname", 0777 unless -d "$batchname";
	open(OUT, ">$batchname/$paddedbatchnumber.xml") || die "Can't open file for writing...\n";
	print OUT "<?xml version='1.0' encoding='UTF-8'?>\n";
	print OUT "<RECORDBATCH time='".time()."' batch='$batchnumber'>\n";
}

sub closeBatch {
	print OUT "</RECORDBATCH>\n";
	close(OUT) || die "Cannot close batch #$batchnumber...dying\n";
}

# Takes in record number, and gets /xrecord from catalog and wraps <IIIRECORD> 
# in either <BIB>,<ITEM>,<CHECKIN> or <AUTHORITY>
sub getIIIXML {
  if ($recordnumber =~ /^b[0-9]*/) {$type = "BIB";}
  elsif ($recordnumber =~ /^i[0-9]*/) {$type = "ITEM";}
  elsif ($recordnumber =~ /^c[0-9]*/) {$type = "CHECKIN";}
  elsif ($recordnumber =~ /^a[0-9]*/) {$type = "AUTHORITY"; $auth = '';}
  elsif ($recordnumber =~ /\w*/) {return;}
  else {
    print STDOUT "\n$recordnumber not a valid III recordnumber.  Skipping...\n";
    return;
  }  
  # used to normalize the recordnumbers here, but since Koha will not take them,
  # this was removed to clarify and simplify the numbering
  my $output = "<$type number='$recordnumber'>\n";
  
  $xrecordURL = "http://$IIIserver/xrecord=$recordnumber"; 
  my $request = HTTP::Request->new(GET => $xrecordURL);
  my $response = $browser->request($request);
  if ($response->is_error()) {printf "%s\n", $response->status_line;}
  my $xrecord = $response->content();
  # Strip out record declarations
  $xrecord =~ s/<\?xml.*>\s*<!DOCTYPE.*>//;
  # Cleans up proprietary III brace codes (used instead of UTF-8 standard)
  $xrecord = scrubbracecodes($xrecord);  
  $output .= $xrecord;
  $output .= "</$type>\n";
}


sub scrubbracecodes {
  my $text = shift;

  # Defines which III brace codes match which UTF-8 characters
  # Comment out any codes you know you won't need to improves scrub speed
  # Similarly, new codes can be added if you encourter unscrubbed results
  my %diacritics = (
     '{160}'  => "¡",
     '{161}'  => "Ł",
     '{162}'  => "Ø",
     '{163}'  => "Ð",
     '{164}'  => "Þ",
     '{165}'  => "Æ",
     '{166}'  => "Œ",
     '{167}' => "",
     '{168}' => "·",
     '{169}' => "♭",
     '{170}'  => "®",
     '{171}'  => "±",
     '{174}' => "",
     '{176}'  => "ʿ",
     '{177}'  => "ł",
     '{178}'  => "ø",
     '{180}'  => "þ",
     '{181}'  => "æ",
     '{182}'  => "œ",
     '{184}' => "i",
     '{185}'  => "£",
     '{186}'  => "ð",
     '{187}'  => "¬",
     '{190}'  => "l",
     '{191}'  => "",
     '{192}'  => "⁰",
     '{193}'  => "¹",
     '{194}'  => "²",
     '{195}'  => "³",
     '{196}'  => "⁴",
     '{197}'  => "⁵",
     '{198}'  => "⁶",
     '{199}'  => "⁷",
     '{200}'  => "⁸",
     '{201}'  => "⁹",
     '{219}'  => "_",
     '{221}'  => "ß",
     '{223}'  => "¿",
     '{225}A' => "À", 
     '{225}E' => "È", 
     '{225}I' => "Ì", 
     '{225}O' => "Ò", 
     '{225}U' => "Ù", 
     '{225}a' => "à", 
     '{225}e' => "è", 
     '{225}i' => "ì",
     '{225}l' => "l", 
     '{225}o' => "ò", 
     '{225}u' => "ù",
    '{226}A' => "Á",
    '{226}a' => "á",
    '{226}C' => "Ć",
    '{226}c' => "ć",
    '{226}E' => "É",
    '{226}e' => "é",
    'E{226}' => "É",
    '{226}G' => "Ǵ",
    '{226}g' => "ǵ",
    '{226}I' => "Í",
    '{226}i' => "í",
    '{226}K' => "Ḱ",
    '{226}k' => "ḱ",
    '{226}L' => "Ĺ",
    '{226}l' => "ĺ",
    '{226}M' => "Ḿ",
    '{226}m' => "ḿ",
    '{226}N' => "Ń",
    '{226}n' => "ń",
    '{226}O' => "Ó",
    '{226}o' => "ó",
    '{226}P' => "Ṕ",
    '{226}p' => "ṕ",
    '{226}R' => "Ŕ",
    '{226}r' => "ŕ",
    '{226}S' => "Ś",
    '{226}s' => "ś",
    '{226}U' => "Ú",
    '{226}u' => "ú",
    '{226}W' => "Ẃ",
    '{226}w' => "ẃ",
    '{226}Y' => "Ý",
    '{226}y' => "ý",
    '{226}Z' => "Ź",
    '{226}z' => "ź",
     '{227}A' => "Â", 
     '{227}E' => "Ê",
     '{227}I' => "Î", 
     '{227}O' => "Ô", 
     '{227}U' => "Û", 
     '{227}a' => "â", 
     '{227}c' => "ĉ",
     '{227}C' => "Ĉ",
     '{227}e' => "ê",
     '{228}{227}e' => "ễ", 
     '{227}i' => "î", 
     '{227}o' => "ô", 
     '{227}u' => "û", 
     '{228}A' => "Ã",
     '{228}O' => "Õ", 
     '{228}N' => "Ñ", 
     '{228}a' => "ã", 
     '{228}o' => "õ", 
     '{228}n' => "ñ",
     '{229}a' => "ā",
     '{229}A' => "Ā",
     '{229}b' => "ḇ",
     '{229}B' => "Ḇ",
     '{229}c' => "c̄",
     '{229}C' => "C̄",
     '{229}d' => "ḏ",
     '{229}D' => "Ḏ",
     '{229}e' => "ē",
     '{229}E' => "Ē",
     '{229}g' => "ḡ",
     '{229}G' => "Ḡ",
     '{229}h' => "ẖ",
     '{229}H' => "H̱",
     '{229}i' => "ī",
     '{229}I' => "Ī",
     '{229}k' => "ḵ",
     '{229}K' => "Ḵ",
     '{229}l' => "ḻ",
     '{229}L' => "Ḻ",
     '{229}n' => "ṉ",
     '{229}N' => "Ṉ", 
     '{229}o' => "ō",
     '{229}O' => "Ō",
     '{229}r' => "ṟ",
     '{229}R' => "Ṟ", 
     '{229}t' => "ṯ",
     '{229}T' => "Ṯ",
     '{229}u' => "ū",
     '{229}U' => "Ū",
     '{229}y' => "ȳ",
     '{229}Y' => "Ȳ",
     '{229}z' => "ẕ",
     '{229}Z' => "Ẕ",
     '{230}a' => "ă",
     '{230}A' => "Ă",
     '{230}c' => "č", 
     '{230}C' => "Č",
     '{230}e' => "ĕ",
     '{230}E' => "Ĕ",
     '{230}i' => "ĭ",
     '{230}I' => "Ĭ",
     '{230}o' => "ŏ",
     '{230}O' => "Ŏ",
     '{230}u' => "ŭ",
     '{230}U' => "Ŭ",
     '{230}s' => "š", 
     '{230}S' => "Š",
     '{230}z' => "ž", 
     '{230}Z' => "Ž",
     '{231}A' => "Ȧ",
     '{231}a' => "ȧ",
     '{231}B' => "Ḃ",
     '{231}b' => "ḃ",
     '{231}C' => "Ċ",
     '{231}c' => "ċ",
     '{231}D' => "Ḋ",
     '{231}d' => "ḋ",
     '{231}E' => "Ė",
     '{231}e' => "ė",
     '{231}F' => "Ḟ",
     '{231}f' => "ḟ",
     '{231}G' => "Ġ",
     '{231}g' => "ġ",
     '{231}H' => "Ḣ",
     '{231}h' => "ḣ",
     '{231}I' => "İ",
     '{231}M' => "Ṁ",
     '{231}m' => "ṁ",
     '{231}N' => "Ṅ",
     '{231}n' => "ṅ",
     '{231}O' => "Ȯ",
     '{231}o' => "ȯ",
     '{231}P' => "Ṗ",
     '{231}p' => "ṗ",
     '{231}R' => "Ṙ",
     '{231}r' => "ṙ",
     '{231}S' => "Ṡ",
     '{231}s' => "ṡ",
     '{231}T' => "Ṫ",
     '{231}t' => "ṫ",
     '{231}W' => "Ẇ",
     '{231}w' => "ẇ",
     '{231}X' => "Ẋ",
     '{231}x' => "ẋ",
     '{231}Y' => "Ẏ",
     '{231}y' => "ẏ",
     '{231}Z' => "Ż",
     '{231}z' => "ż",
     '{232}A' => "Ä",
     '{232}E' => "Ë", 
     '{232}I' => "Ï", 
     '{232}O' => "Ö",
     '{232}U' => "Ü",
     '{232}Y' => "Ÿ",
     '{232}a' => "ä",
     '{232}e' => "ë", 
     '{232}i' => "ï", 
     '{232}o' => "ö",
     '{232}u' => "ü", 
     '{232}y' => "ÿ",
     '{233}a' => "ǎ", 
     '{233}A' => "Ǎ",
     '{233}c' => "č", 
     '{233}C' => "Č",
     '{233}d' => "ď", 
     '{233}D' => "Ď",
     '{233}e' => "ě", 
     '{233}E' => "Ě",
     '{233}g' => "ǧ", 
     '{233}G' => "Ǧ",
     '{233}h' => "ȟ", 
     '{233}H' => "Ȟ",
     '{233}i' => "ǐ", 
     '{233}I' => "Ǐ",
     '{233}j' => "ǰ", 
     '{233}J' => "J̌",
     '{233}k' => "ǩ", 
     '{233}K' => "Ǩ",
     '{233}l' => "ľ", 
     '{233}L' => "Ľ",
     '{233}n' => "ň", 
     '{233}N' => "Ň",
     '{233}o' => "ǒ", 
     '{233}O' => "Ǒ",
     '{233}r' => "ř", 
     '{233}R' => "Ř",
     '{233}t' => "ť", 
     '{233}T' => "Ť",
     '{233}u' => "ǔ", 
     '{233}U' => "Ǔ",
     '{233}s' => "š", 
     '{233}S' => "Š",
     '{233}z' => "ž", 
     '{233}Z' => "Ž",
     '{234}A' => "Å",
     '{234}a' => "å",
     '{234}U' => "Ů",
     '{234}u' => "ů",
     '{234}' => "°",
     '{235}' => "",
     '{236}' => "",
     '{237}' => "ʻ",
     '{238}O' => "Ő",
     '{238}o' => "ő",
     '{238}U' => "Ű",
     '{238}u' => "ű",
     '{239}C' => "C",
     '{239}c' => "c",
     '{240}C' => "Ç",
     '{240}c' => "ç",
     '{241}' => "",
     '{242}A' => "Ạ",
     '{242}a' => "ạ",
     '{242}B' => "Ḅ",
     '{242}b' => "ḅ",
     '{242}D' => "Ḍ",
     '{242}d' => "ḍ",
     '{242}E' => "Ẹ",
     '{242}e' => "ẹ",
     '{242}H' => "Ḥ",
     '{242}h' => "ḥ",
     '{242}I' => "Ị",
     '{242}i' => "ị",
     '{242}K' => "Ḳ",
     '{242}k' => "ḳ",
     '{242}L' => "Ḷ",
     '{242}l' => "ḷ",
     '{242}M' => "Ṃ",
     '{242}m' => "ṃ",
     '{242}N' => "Ṇ",
     '{242}n' => "ṇ",
     '{242}O' => "Ọ",
     '{242}o' => "ọ",
     '{242}R' => "Ṛ",
     '{242}r' => "ṛ",
     '{242}S' => "Ṣ",
     '{242}s' => "ṣ",
     '{242}T' => "Ṭ",
     '{242}t' => "ṭ",
     '{242}U' => "Ụ",
     '{242}u' => "ụ",
     '{242}V' => "Ṿ",
     '{242}v' => "ṿ",
     '{242}W' => "Ẉ",
     '{242}w' => "ẉ",
     '{242}Y' => "Ỵ",
     '{242}y' => "ỵ",
     '{242}Z' => "Ẓ",
     '{242}z' => "ẓ",
     '{246}' => "_",
     '{247}' => "",
     '{248}' => "",
     '{7f2019}' => "'",
     '{251}i' => "'í",
     '{254}' => "ʻ",
     '{496}' => "©"
  );
  
  foreach $key (keys %diacritics) {
     $replace = $diacritics{$key};
     $text=~s/\Q$key\E/$replace/g;
  } 
  return $text; 
}


# ----------------------------Stage 2 functions --------------------------------

# converts IIIXML structure into MARCXML using Xalan
sub applyXSLT {
	# creates directory for MARCXML unless it already exists
	mkdir "$marcbatchname", 0777 unless -d "$marcbatchname";
	# if $auth is set, use that stylesheet, otherwise use the bib XSLT
	if (defined $auth) {$stylesheet = $authXSLT;} else {$stylesheet = $bibXSLT;}
	print STDOUT "Using stylesheet: $stylesheet\n" if (defined $verbose);
	my @iiixmlfiles = <$batchname/*.xml>;
	foreach $iiixml (@iiixmlfiles) {
		print STDOUT "\rTransforming file: $iiixml";
		$marcxml = $iiixml;
		$marcxml =~ s/$batchname\/(\d*\.xml)/$marcbatchname\/$1/;
		# this probably needs to be made more generic....
		system("xalan -in $iiixml -xsl $stylesheet -out $marcxml") == 0 || system("java org.apache.xalan.xslt.Process -in $iiixml -xsl $stylesheet -out $marcxml") == 0 || die "xalan failed: $?";
	}
	print STDOUT "\rTransformation Complete!                       \n";
}


# ----------------------------Stage 3 functions --------------------------------

# Imports MARCXML into Koha.  You can specify a different $importtool here, if 
# need be, provided it recognizes the standard flags.  

sub importintoKoha {
  # TODO: submit patch to Koha for logging
	$importtool = '/usr/share/koha/bin/migration_tools/bulkmarcimport.pl';
	if (defined $auth) {$importtool = '/usr/share/koha/bin/migration_tools/bulkauthimport.pl';}	

	print "Delete existing data? (y/n) ";
	PROMPT: chomp($continue = <STDIN>);
	if ($continue =~ /^y/i) {
		$delflag = '-d';	
	} elsif ($continue =~ /^n/i) {
		$delflag = '';
	} else {
		print STDOUT "Sorry, didn't understand that... please type 'y' or 'n': ";
		goto PROMPT;
	}
			
	print "Any additional script flags for $importtool? (just hit <enter> if not) ";
	chomp($addflags = <STDIN>);
	unless (defined $auth) {$addflags .= " -x $sourcetag -y $sourcefield";}
	if (defined $verbose) {$addflags .= " -v";}
	
	my @marcxmlfiles = <$marcbatchname/*.xml>;
	@marcxmlfiles = sort @marcxmlfiles;
	foreach $marcxml (@marcxmlfiles){
		print "Importing file: $marcxml\n";
		system("perl -I /usr/share/koha/lib $importtool -m MARCXML -file $marcxml $delflag $addflags");
		$delflag = '';
	}
}

