Open-ILS/src/perlmods/OpenILS/WWW/Exporter.pm

   1 package OpenILS::WWW::Exporter;
   2 use strict;
   3 use warnings;
   4 use bytes;
   5
   6 use Apache2::Log;
   7 use Apache2::Const -compile => qw(OK REDIRECT DECLINED NOT_FOUND :log);
   8 use APR::Const    -compile => qw(:error SUCCESS);
   9 use Apache2::RequestRec ();
  10 use Apache2::RequestIO ();
  11 use Apache2::RequestUtil;
  12 use CGI;
  13 use Data::Dumper;
  14
  15 use OpenSRF::EX qw(:try);
  16 use OpenSRF::Utils qw/:datetime/;
  17 use OpenSRF::Utils::Cache;
  18 use OpenSRF::System;
  19 use OpenSRF::AppSession;
  20 use XML::LibXML;
  21 use XML::LibXSLT;
  22
  23 use Encode;
  24 use Unicode::Normalize;
  25 use OpenILS::Utils::Fieldmapper;
  26 use OpenSRF::Utils::Logger qw/$logger/;
  27
  28 use MARC::Record;
  29 use MARC::File::XML;
  30
  31 use UNIVERSAL::require;
  32
  33 our @formats = qw/USMARC UNIMARC XML BRE/;
  34
  35 # set the bootstrap config and template include directory when
  36 # this module is loaded
  37 my $bootstrap;
  38
  39 sub import {
  40         my $self = shift;
  41         $bootstrap = shift;
  42 }
  43
  44
  45 sub child_init {
  46         OpenSRF::System->bootstrap_client( config_file => $bootstrap );
  47 }
  48
  49 sub handler {
  50         my $r = shift;
  51         my $cgi = new CGI;
  52
  53         my @records = $cgi->param('id');
  54
  55         return 200 unless (@records);
  56
  57         my $holdings = $cgi->param('holdings');
  58         my $location = $cgi->param('location') || 'gaaagpl'; # just because...
  59
  60         my $format = $cgi->param('format') || 'USMARC';
  61         $format = uc($format);
  62
  63         my $encoding = $cgi->param('encoding') || 'UTF-8';
  64         $encoding = uc($encoding);
  65
  66         binmode(STDOUT, ':raw') if ($encoding ne 'UTF-8');
  67         binmode(STDOUT, ':utf8') if ($encoding eq 'UTF-8');
  68
  69         if (!grep { uc($format) eq $_ } @formats) {
  70                 die     "Please select a supported format.  ".
  71                         "Right now that means one of [".
  72                         join('|',@formats). "]\n";
  73         }
  74
  75         if ($format ne 'XML') {
  76                 my $type = 'MARC::File::' . $format;
  77                 $type->require;
  78         }
  79
  80         my $ses = OpenSRF::AppSession->create('open-ils.cstore');
  81
  82         print "Content-type: application/octet-stream\n\n" if (uc($format) ne 'XML');
  83         print <<"       HEADER" if (uc($format) eq 'XML');
  84 Content-type: application/xml
  85
  86 <?xml version="1.0" encoding="$encoding"?>
  87 <collection xmlns='http://www.loc.gov/MARC21/slim'>
  88         HEADER
  89
  90         my %orgs;
  91         my %shelves;
  92
  93         my $flesh = {};
  94         if ($holdings) {
  95
  96                 print STDERR "Retrieving Org Units ... ";
  97                 my $r = $ses->request( 'open-ils.cstore.direct.actor.org_unit.search', { id => { '!=' => undef } } );
  98
  99                 while (my $o = $r->recv) {
 100                         die $r->failed->stringify if ($r->failed);
 101                         $o = $o->content;
 102                         last unless ($o);
 103                         $orgs{$o->id} = $o;
 104                 }
 105                 $r->finish;
 106                 print STDERR "OK\n";
 107
 108                 print STDERR "Retrieving Shelving locations ... ";
 109                 $r = $ses->request( 'open-ils.cstore.direct.asset.copy_location.search', { id => { '!=' => undef } } );
 110
 111                 while (my $s = $r->recv) {
 112                         die $r->failed->stringify if ($r->failed);
 113                         $s = $s->content;
 114                         last unless ($s);
 115                         $shelves{$s->id} = $s;
 116                 }
 117                 $r->finish;
 118                 print STDERR "OK\n";
 119
 120                 $flesh = { flesh => 2, flesh_fields => { bre => [ 'call_numbers' ], acn => [ 'copies' ] } };
 121         }
 122
 123         for my $i ( @records ) {
 124                 my $bib;
 125                 try {
 126                         local $SIG{ALRM} = sub { die "TIMEOUT\n" };
 127                         alarm(1);
 128                         $bib = $ses->request( 'open-ils.cstore.direct.biblio.record_entry.retrieve', $i, $flesh )->gather(1);
 129                         alarm(0);
 130                 } otherwise {
 131                         warn "\n!!!!!! Timed out trying to read record $i\n";
 132                 };
 133                 alarm(0);
 134
 135                 next unless $bib;
 136
 137                 if (uc($format) eq 'BRE') {
 138                         print OpenSRF::Utils::JSON->perl2JSON($bib);
 139                         next;
 140                 }
 141
 142                 try {
 143
 144                         my $r = MARC::Record->new_from_xml( $bib->marc, $encoding, $format );
 145                         $r->delete_field( $_ ) for ($r->field(901));
 146
 147                         $r->append_fields(
 148                                 MARC::Field->new(
 149                                         901, '', '',
 150                                         a => $bib->tcn_value,
 151                                         b => $bib->tcn_source,
 152                                         c => $bib->id
 153                                 )
 154                         );
 155
 156
 157                         my $cn_list = $bib->call_numbers;
 158                         if ($cn_list && @$cn_list) {
 159
 160                                 my $cp_list = [ map { @{ $_->copies } } @$cn_list ];
 161                                 if ($cp_list && @$cp_list) {
 162
 163                                         my %cn_map;
 164                                         push @{$cn_map{$_->call_number}}, $_ for (@$cp_list);
 165
 166                                         for my $cn ( @$cn_list ) {
 167                                                 my $cn_map_list = $cn_map{$cn->id};
 168
 169                                                 for my $cp ( @$cn_map_list ) {
 170
 171                                                         $r->append_fields(
 172                                                                 MARC::Field->new(
 173                                                                         852, '4', '',
 174                                                                         a => $location,
 175                                                                         b => $orgs{$cn->owning_lib}->shortname,
 176                                                                         b => $orgs{$cp->circ_lib}->shortname,
 177                                                                         c => $shelves{$cp->location}->name,
 178                                                                         j => $cn->label,
 179                                                                         ($cp->circ_modifier ? ( g => $cp->circ_modifier ) : ()),
 180                                                                         p => $cp->barcode,
 181                                                                         ($cp->price ? ( y => $cp->price ) : ()),
 182                                                                         ($cp->copy_number ? ( t => $cp->copy_number ) : ()),
 183                                                                         ($cp->ref eq 't' ? ( x => 'reference' ) : ()),
 184                                                                         ($cp->holdable eq 'f' ? ( x => 'unholdable' ) : ()),
 185                                                                         ($cp->circulate eq 'f' ? ( x => 'noncirculating' ) : ()),
 186                                                                         ($cp->opac_visible eq 'f' ? ( x => 'hidden' ) : ()),
 187                                                                 )
 188                                                         );
 189
 190                                                 }
 191                                         }
 192                                 }
 193                         }
 194
 195                         if (uc($format) eq 'XML') {
 196                                 my $x = $r->as_xml_record;
 197                                 $x =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
 198                                 print $x;
 199                         } elsif (uc($format) eq 'UNIMARC') {
 200                                 print $r->as_unimarc
 201                         } elsif (uc($format) eq 'USMARC') {
 202                                 print $r->as_usmarc
 203                         }
 204
 205                 } otherwise {
 206                         my $e = shift;
 207                         warn "\n$e\n";
 208                 };
 209
 210         }
 211
 212         print "</collection>\n" if ($format eq 'XML');
 213
 214 }
 215
 216 1;