Open-ILS/src/support-scripts/marc_export

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