Open-ILS/src/support-scripts/marc_export

   1 #!/usr/bin/perl
   2 # vim:et:sw=4:ts=4:
   3 use strict;
   4 use warnings;
   5 use bytes;
   6
   7 use OpenSRF::System;
   8 use OpenSRF::EX qw/:try/;
   9 use OpenSRF::AppSession;
  10 use OpenSRF::Utils::JSON;
  11 use OpenSRF::Utils::SettingsClient;
  12 use OpenILS::Application::AppUtils;
  13 use OpenILS::Utils::Fieldmapper;
  14 use OpenILS::Utils::CStoreEditor;
  15
  16 use MARC::Record;
  17 use MARC::File::XML;
  18 use UNIVERSAL::require;
  19
  20 use Time::HiRes qw/time/;
  21 use Getopt::Long;
  22
  23
  24 my @formats = qw/USMARC UNIMARC XML BRE ARE/;
  25
  26 my ($config,$format,$encoding,$location,$dollarsign,$idl,$help,$holdings,$timeout,$export_mfhd,$type) = ('/openils/conf/opensrf_core.xml','USMARC','MARC8','','$',0,undef,undef,0,undef,'biblio');
  27
  28 GetOptions(
  29         'help'       => \$help,
  30         'items'      => \$holdings,
  31         'mfhd'       => \$export_mfhd,
  32         'location=s' => \$location,
  33         'money=s'    => \$dollarsign,
  34         'config=s'   => \$config,
  35         'format=s'   => \$format,
  36         'type=s'     => \$type,
  37         'xml-idl=s'  => \$idl,
  38         'encoding=s' => \$encoding,
  39         'timeout=i'  => \$timeout,
  40 );
  41
  42 if ($help) {
  43 print <<"HELP";
  44 This script exports MARC authority, bibliographic, and serial holdings
  45 records from an Evergreen database. Input to this script consists of
  46 a list of record IDs, with one record ID per line, corresponding to
  47 the record ID in the Evergreen database table of your requested record
  48 type.
  49
  50 Usage: $0 [options]
  51  --help or -h       This screen.
  52  --config or -c     Configuration file [/openils/conf/opensrf_core.xml]
  53  --format or -f     Output format (USMARC, UNIMARC, XML, BRE, ARE) [USMARC]
  54  --encoding or -e   Output encoding (UTF-8, ISO-8859-?, MARC8) [MARC8]
  55  --xml-idl or -x    Location of the IDL XML
  56  --timeout          Timeout for exporting a single record; increase if you
  57                     are using --holdings and are exporting records that
  58                     have a lot of items attached to them.
  59  --type or -t       Record type (BIBLIO, AUTHORITY) [BIBLIO]
  60
  61  Additional options for type = 'BIBLIO':
  62  --items or -i      Include items (holdings) in the output
  63  --money            Currency symbol to use in item price field [\$]
  64  --mfhd             Export serial MFHD records for associated bib records
  65                     Not compatible with --format=BRE
  66  --location or -l   MARC Location Code for holdings from
  67                     http://www.loc.gov/marc/organizations/orgshome.html
  68
  69 Example:
  70
  71   cat list_of_ids | $0 > output_file
  72
  73 HELP
  74     exit;
  75 }
  76
  77 $type = lc($type);
  78 $format = uc($format);
  79 $encoding = uc($encoding);
  80
  81 binmode(STDOUT, ':raw') if ($encoding ne 'UTF-8');
  82 binmode(STDOUT, ':utf8') if ($encoding eq 'UTF-8');
  83
  84 if (!grep { $format eq $_ } @formats) {
  85     die "Please select a supported format.  ".
  86         "Right now that means one of [".
  87         join('|',@formats). "]\n";
  88 }
  89
  90 if ($format ne 'XML') {
  91     my $type = 'MARC::File::' . $format;
  92     $type->require;
  93 }
  94
  95 if ($timeout <= 0) {
  96     # set default timeout and/or correct silly user who
  97     # supplied a negative timeout; default timeout of
  98     # 300 seconds if exporting items determined empirically.
  99     $timeout = $holdings ? 300 : 1;
 100 }
 101
 102 OpenSRF::System->bootstrap_client( config_file => $config );
 103
 104 if (!$idl) {
 105     $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
 106 }
 107
 108 Fieldmapper->import(IDL => $idl);
 109
 110 my $ses = OpenSRF::AppSession->create('open-ils.cstore');
 111 OpenILS::Utils::CStoreEditor::init();
 112 my $editor = OpenILS::Utils::CStoreEditor->new();
 113
 114 print <<HEADER if ($format eq 'XML');
 115 <?xml version="1.0" encoding="$encoding"?>
 116 <collection xmlns='http://www.loc.gov/MARC21/slim'>
 117 HEADER
 118
 119 my %orgs;
 120 my %shelves;
 121
 122 my $flesh = {};
 123
 124 if ($holdings) {
 125     get_bib_locations();
 126 }
 127
 128 my $start = time;
 129 my $last_time = time;
 130 my %count = ();
 131 my $speed = 0;
 132 while ( my $i = <> ) {
 133     my $bib;
 134
 135     my $r = $ses->request( "open-ils.cstore.direct.$type.record_entry.retrieve", $i, $flesh );
 136     my $s = $r->recv(timeout => $timeout);
 137     if (!$s) {
 138         warn "\n!!!!! Failed trying to read record $i\n";
 139         next;
 140     }
 141     if ($r->failed) {
 142         warn "\n!!!!!! Failed trying to read record $i: " . $r->failed->stringify . "\n";
 143         next;
 144     }
 145     if ($r->timed_out) {
 146         warn "\n!!!!!! Timed out trying to read record $i\n";
 147         next;
 148     }
 149     $bib = $s->content;
 150     $r->finish;
 151
 152     $count{bib}++;
 153     next unless $bib;
 154
 155     if ($format eq 'ARE' or $format eq 'BRE') {
 156         print OpenSRF::Utils::JSON->perl2JSON($bib);
 157         stats();
 158         $count{did}++;
 159         next;
 160     }
 161
 162     try {
 163
 164         my $r = MARC::Record->new_from_xml( $bib->marc, $encoding, $format );
 165         if ($type eq 'biblio') {
 166             add_bib_holdings($bib, $r);
 167         }
 168
 169         if ($format eq 'XML') {
 170             my $xml = $r->as_xml_record;
 171             $xml =~ s/^<\?.+?\?>$//mo;
 172             print $xml;
 173         } elsif ($format eq 'UNIMARC') {
 174             print $r->as_usmarc;
 175         } elsif ($format eq 'USMARC') {
 176             print $r->as_usmarc;
 177         }
 178
 179         $count{did}++;
 180
 181     } otherwise {
 182         my $e = shift;
 183         warn "\n$e\n";
 184         import MARC::File::XML; # reset SAX parser so that one bad record doesn't kill the entire export
 185     };
 186
 187     if ($export_mfhd and $type eq 'biblio') {
 188         my $mfhds = $editor->search_serial_record_entry({record => $i, deleted => 'f'});
 189         foreach my $mfhd (@$mfhds) {
 190             try {
 191                 my $r = MARC::Record->new_from_xml( $mfhd->marc, $encoding, $format );
 192
 193                 if ($format eq 'XML') {
 194                     my $xml = $r->as_xml_record;
 195                     $xml =~ s/^<\?.+?\?>$//mo;
 196                     print $xml;
 197                 } elsif ($format eq 'UNIMARC') {
 198                     print $r->as_usmarc;
 199                 } elsif ($format eq 'USMARC') {
 200                     print $r->as_usmarc;
 201                 }
 202             } otherwise {
 203                 my $e = shift;
 204                 warn "\n$e\n";
 205                 import MARC::File::XML; # reset SAX parser so that one bad record doesn't kill the entire export
 206             };
 207         }
 208     }
 209
 210     stats() if (! ($count{bib} % 50 ));
 211 }
 212
 213 print "</collection>\n" if ($format eq 'XML');
 214
 215 $speed = $count{did} / (time - $start);
 216 my $time = time - $start;
 217 print STDERR <<DONE;
 218
 219 Exports Attempted : $count{bib}
 220 Exports Completed : $count{did}
 221 Overall Speed     : $speed
 222 Total Time Elapsed: $time seconds
 223
 224 DONE
 225
 226
 227 sub stats {
 228     try {
 229         no warnings;
 230
 231         $speed = $count{did} / (time - $start);
 232
 233         my $speed_now = ($count{did} - $count{did_last}) / (time - $count{time_last});
 234         my $cn_speed = $count{cn} / (time - $start);
 235         my $cp_speed = $count{cp} / (time - $start);
 236
 237         printf STDERR "\r  $count{did} of $count{bib} @  \%0.4f/s ttl / \%0.4f/s rt ".
 238                 "($count{cn} CNs @ \%0.4f/s :: $count{cp} CPs @ \%0.4f/s)\r",
 239                 $speed,
 240                 $speed_now,
 241                 $cn_speed,
 242                 $cp_speed;
 243     } otherwise {};
 244     $count{did_last} = $count{did};
 245     $count{time_last} = time;
 246 }
 247
 248 sub get_bib_locations {
 249     print STDERR "Retrieving Org Units ... ";
 250     my $r = $ses->request( 'open-ils.cstore.direct.actor.org_unit.search', { id => { '!=' => undef } } );
 251
 252     while (my $o = $r->recv) {
 253         die $r->failed->stringify if ($r->failed);
 254         $o = $o->content;
 255         last unless ($o);
 256         $orgs{$o->id} = $o;
 257     }
 258     $r->finish;
 259     print STDERR "OK\n";
 260
 261     print STDERR "Retrieving Shelving locations ... ";
 262     $r = $ses->request( 'open-ils.cstore.direct.asset.copy_location.search', { id => { '!=' => undef } } );
 263
 264     while (my $s = $r->recv) {
 265         die $r->failed->stringify if ($r->failed);
 266         $s = $s->content;
 267         last unless ($s);
 268         $shelves{$s->id} = $s;
 269     }
 270     $r->finish;
 271     print STDERR "OK\n";
 272
 273     $flesh = { flesh => 2, flesh_fields => { bre => [ 'call_numbers' ], acn => [ 'copies' ] } };
 274 }
 275
 276 sub add_bib_holdings {
 277     my $bib = shift;
 278     my $r = shift;
 279
 280     my $cn_list = $bib->call_numbers;
 281     if ($cn_list && @$cn_list) {
 282
 283         $count{cn} += @$cn_list;
 284
 285         my $cp_list = [ map { @{ $_->copies } } @$cn_list ];
 286         if ($cp_list && @$cp_list) {
 287
 288             my %cn_map;
 289             push @{$cn_map{$_->call_number}}, $_ for (@$cp_list);
 290
 291             for my $cn ( @$cn_list ) {
 292                 my $cn_map_list = $cn_map{$cn->id};
 293
 294                 for my $cp ( @$cn_map_list ) {
 295                     $count{cp}++;
 296
 297                     $r->append_fields(
 298                         MARC::Field->new(
 299                             852, '4', '',
 300                             a => $location,
 301                             b => $orgs{$cn->owning_lib}->shortname,
 302                             b => $orgs{$cp->circ_lib}->shortname,
 303                             c => $shelves{$cp->location}->name,
 304                             j => $cn->label,
 305                             ($cp->circ_modifier ? ( g => $cp->circ_modifier ) : ()),
 306                             p => $cp->barcode,
 307                             ($cp->price ? ( y => $dollarsign.$cp->price ) : ()),
 308                             ($cp->copy_number ? ( t => $cp->copy_number ) : ()),
 309                             ($cp->ref eq 't' ? ( x => 'reference' ) : ()),
 310                             ($cp->holdable eq 'f' ? ( x => 'unholdable' ) : ()),
 311                             ($cp->circulate eq 'f' ? ( x => 'noncirculating' ) : ()),
 312                             ($cp->opac_visible eq 'f' ? ( x => 'hidden' ) : ()),
 313                         )
 314                     );
 315
 316                     stats() if (! ($count{cp} % 100 ));
 317                 }
 318             }
 319         }
 320     }
 321 }