$|=1;
-my ($userid, $sourceid, $rec_id, $entry_file, $map_file) = (1, 2, 1, 'record_entry.sql','record_id_map.pl');
+my ($userid,$sourceid,$rec_id,$entry_file,$map_file,$id_tag) = (1,2,1,'record_entry.sql','record_id_map.pl','/*/*/*[@tag="035"][1]');
GetOptions (
"sourceid" => \$sourceid,
- "entry_file=s" => \$entry_file,
- "tcn_map_file=s" => \$map_file,
+ "sql_output=s" => \$entry_file,
+ "tcn_output=s" => \$map_file,
"userid=i" => \$userid,
"first=i" => \$rec_id,
+ "id_tag_xpath=s" => \$id_tag,
);
my $tcn_map;
chomp $xml;
next unless $xml;
- my $tcn;
+ my $tcn = '';
my $success = 0;
try {
my $doc = $parser->parse_string($xml);;
- $tcn = $doc->documentElement->findvalue( '/*/*[@tag="035"][1]' );
+ my @nodes = $doc->documentElement->findnodes( $id_tag );
+ for my $n (@nodes) {
+ $tcn .= $n->textContent;
+ }
+ $tcn =~ s/^\s*(\.+)\s*/$1/o;
+ $tcn =~ s/\s+/_/go;
$success = 1;
} catch Error with {
my $e = shift;
use Getopt::Long;
use Data::Dumper;
use Error qw/:try/;
+use DBI;
use open qw/:utf8/;
+#-------------------------------------------------------------------------------
+# The keys of this hash should be the string values stored in your legacy
+# system that map to the copy statuses in Open-ILS. If you don't see a
+# legacy status here that you need to carry over to your new Open-ILS install
+# you can use the "Copy Statuses" bootstrapping CGI to create an entry for it.
+# Then simply a key for the legacy status that points to the SysID of the new
+# Open-ILS Copy Status.
+#-------------------------------------------------------------------------------
+my %status_map = (
+ '' => 0,
+ CHECKEDOUT => 1,
+ BINDERY => 2,
+ LOST => 3,
+ MISSING => 4,
+ INPROCESS => 5,
+ INTRANSIT => 6,
+ RESHELVING => 7,
+ 'ON HOLDS SHELF'=> 8,
+ 'ON-ORDER' => 9,
+ ILL => 10,
+ CATALOGING => 11,
+ RESERVES => 12,
+ DISCARD => 13,
+);
+
+
$|=1;
-my ($userid, $sourceid, $cn_id, $cp_id, $cp_file, $cn_file, $map_file, $lib_map_file) =
- (1, 2, 1, 1, 'asset_copy.sql','asset_volume.sql','record_id_map.pl','lib-map.pl');
+my ($userid,$cn_id,$cp_id,$cp_file,$cn_file,$map_file,$lib_map_field,$id_tag) =
+ (1, 1, 1, 'asset_copy.sql','asset_volume.sql','record_id_map.pl','shortname','/*/*/*[@tag="035"][1]');
+
+my ($holding_tag,$bc,$lbl,$own,$pr,$cpn,$avail) =
+ ('/*/*/*[@tag="999"]','i','a','m','p','c','k');
+
+my ($db_driver,$db_host,$db_name,$db_user,$db_pw) =
+ ('Pg','localhost','demo-dev','postgres','postgres');
GetOptions (
- "sourceid" => \$sourceid,
"copy_file=s" => \$cp_file,
"volume_file=s" => \$cn_file,
"tcn_map_file=s" => \$map_file,
- "lib_map_file=s" => \$lib_map_file,
"userid=i" => \$userid,
"first_volume=i" => \$cn_id,
"first_copy=i" => \$cp_id,
+ "db_driver=s" => \$db_driver,
+ "db_host=s" => \$db_host,
+ "db_name=s" => \$db_name,
+ "db_user=s" => \$db_user,
+ "db_pw=s" => \$db_pw,
+ "lib_map_field=s" => \$lib_map_field,
+ "id_tag_xpath=s" => \$id_tag,
+ "holding_tag_xpath=s" => \$holding_tag,
+ "item_barcode=s" => \$bc,
+ "item_call_number=s" => \$lbl,
+ "item_owning_lib=s" => \$own,
+ "item_price=s" => \$pr,
+ "item_copy_number=s" => \$cpn,
+ "item_copy_status=s" => \$avail,
+
);
-my $tcn_map;
-my $lib_map;
+my $dsn = "dbi:$db_driver:host=$db_host;dbname=$db_name";
+my $dbh = DBI->connect($dsn,$db_user,$db_pw);
+my $t = 'actor_org_unit';
+if ($db_driver eq 'Pg') {
+ $t = 'actor.org_unit';
+}
+my $sth = $dbh->prepare("SELECT $lib_map_field,id FROM $t");
+$sth->execute;
+
+my $lib_map = {};
+while (my $lib = $sth->fetchrow_arrayref) {
+ $$lib_map{$$lib[0]} = $$lib[1];
+}
+
+my $tcn_map;
eval `cat $map_file`;
-eval `cat $lib_map_file`;
open CP, ">$cp_file" or die "Can't open $cp_file! $!\n";
open CN, ">$cn_file" or die "Can't open $cn_file! $!\n";
-my %status_map = (
- '' => 0,
- CHECKEDOUT => 1,
- BINDERY => 2,
- LOST => 3,
- MISSING => 4,
- INPROCESS => 5,
- INTRANSIT => 6,
- RESHELVING => 7,
- 'ON HOLDS SHELF' => 8,
- 'ON-ORDER' => 9,
- ILL => 10,
- CATALOGING => 11,
- RESERVES => 12,
- DISCARD => 13,
-);
-
print CP <<SQL;
SET CLIENT_ENCODING TO 'UNICODE';
my $rec_id = $$tcn_map{$tcn};
- for my $node ($doc->documentElement->findnodes('/*/*[@tag="999"]')) {
- my $barcode = $node->findvalue( '*[@code="i"]' );
- my $label = $node->findvalue( '*[@code="a"]' );
- my $owning_lib = $$lib_map{ $node->findvalue( '*[@code="m"]' ) };
- my $price = $node->findvalue( '*[@code="p"]' );
- my $copy_number = $node->findvalue( '*[@code="c"]' );
- my $available = $node->findvalue( '*[@code="k"]' ) || '';
+ for my $node ($doc->documentElement->findnodes($holding_tag)) {
+ my $barcode = $node->findvalue( "*[\@code=\"$bc\"]" );
+ my $label = $node->findvalue( "*[\@code=\"$lbl\"]" );
+ my $owning_lib = $$lib_map{ $node->findvalue( "*[\@code=\"$own\"]" ) };
+ my $price = $node->findvalue( "*[\@code=\"$pr\"]" );
+ my $copy_number = $node->findvalue( "*[\@code=\"$cpn\"]" ) || 0;
+ my $available = $node->findvalue( "*[\@code=\"$avail\"]" ) || '';
my $status = $status_map{$available} || 0;
--- /dev/null
+#!/usr/bin/perl -w
+use strict;
+use Error qw/:try/;
+use MARC::Batch;
+use MARC::File::XML;
+use XML::LibXML;
+use Getopt::Long;
+use encoding 'utf8';
+
+my ($out_enc, $in_enc, $filter) = ('UTF8','MARC8');
+GetOptions('r=s' => \$filter, 'f=s' => \$in_enc, 't=s' => \$out_enc);
+die("Please specify a filter with -r!\n") unless ($filter);
+
+my $batch = MARC::Batch->new( 'USMARC', @ARGV );
+$batch->strict_off;
+
+my $parser = new XML::LibXML;
+
+my $counter = 1;
+my $current_file = $ARGV[0];
+
+print STDERR "\nWorking on file $current_file ";
+
+my $marc = $batch->next;
+while ($marc) {
+
+ my ($next,$xml,$doc,@nodes);
+
+ try {
+ $xml = $marc->as_xml($out_enc);
+ } otherwise {
+ print STDERR "\n ARG! I couldn't parse the MARC record (number $counter): $@\n";
+ $marc = $batch->next;
+ $next++;
+ };
+ next if ($next);
+
+ try {
+ $doc = $parser->parse_string($xml);
+ } otherwise {
+ print STDERR "\n ARG! I couldn't turn the MARC record into MARCXML (number $counter): $@\n";
+ $marc = $batch->next;
+ $next++;
+ };
+ next if ($next);
+
+ try {
+ @nodes = $doc->documentElement->findnodes($filter);
+ } otherwise {
+ print STDERR "\n ARG! I couldn't prune the MARCXML record (number $counter): $@\n";
+ $marc = $batch->next;
+ $next++;
+ };
+ next if ($next);
+
+ for my $n (@nodes) {
+ $n->parentNode->removeChild($n);
+ }
+
+ my $string = $doc->toStringC14N;
+ $string =~ s/>\n\s*</></gso;
+ $string =~ s/\n/\\n /gso;
+ $string =~ s/\t/\\t/gso;
+
+ print "$string\n";
+
+ unless ($counter % 1000) {
+ if ($current_file ne $batch->filename) {
+ $current_file = $batch->filename;
+ print STDERR "\nWorking on file $current_file ";
+ }
+ print STDERR '.'
+ }
+ $counter++;
+ try {
+ $marc = $batch->next;
+ } otherwise {
+ print STDERR "\n ARG! I couldn't parse the MARC record (number $counter): $@\n";
+ $marc = $batch->next;
+ }
+}