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