Open-ILS/src/support-scripts/marc_export.in

   1 #!/usr/bin/perl
   2 # ---------------------------------------------------------------
   3 # Copyright © 2013 Merrimack Valley Library Consortium
   4 # Jason Stephenson <jstephenson@mvlc.org>
   5 #
   6 # This program is part of Evergreen; you can redistribute it and/or
   7 # modify it under the terms of the GNU General Public License as
   8 # published by the Free Software Foundation; either version 2 of the
   9 # License, or (at your option) any later version.
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 # ---------------------------------------------------------------
  16 use strict;
  17 use warnings;
  18 use OpenILS::Utils::Fieldmapper;
  19 use OpenILS::Application::AppUtils;
  20 use OpenSRF::Utils::JSON;
  21 use MARC::Field;
  22 use MARC::Record;
  23 use MARC::File::XML (BinaryEncoding => 'UTF-8');
  24 use Date::Manip::Date;
  25 use Encode;
  26 my $U = 'OpenILS::Application::AppUtils';
  27
  28 binmode(STDERR, ':utf8');
  29
  30 package Marque;
  31
  32 our $config = Marque::Config->new();
  33 Fieldmapper->import(IDL => $config->option_value('xml-idl'));
  34
  35 # Look for passed in ids:
  36 my @ids = ();
  37 if ($config->need_ids()) {
  38     print STDERR "Waiting for input\n" if (-t);
  39     while (my $i = <>) {
  40         push @ids, $i if ($i =~ /^\s*[0-9]+\s*$/);
  41     }
  42 }
  43
  44 my $exporter;
  45 if ($config->option_value('type') eq 'authority') {
  46     $exporter = Marque::Authority->new(\@ids);
  47 } else {
  48     $exporter = Marque::Biblio->new(\@ids);
  49 }
  50
  51 Marque::Output::output($exporter);
  52
  53 # ------------------------------------------------------------------
  54 package Marque::Config;
  55
  56 use Getopt::Long;
  57 use List::MoreUtils qw(none);
  58 use OpenSRF::System;
  59 use OpenSRF::Utils::SettingsClient;
  60
  61 use constant FORMATS => qw(USMARC UNIMARC XML BRE ARE);
  62 use constant STORES => qw(reporter cstore storage);
  63 use constant TYPES => qw(authority biblio);
  64
  65
  66 sub new {
  67     my $class = shift;
  68
  69     my $self = {};
  70
  71     # For command line options.
  72     my %opts;
  73
  74     # set some default values
  75     $opts{'format'} = 'USMARC';
  76     $opts{'encoding'} = 'MARC8';
  77     $opts{'type'} = 'biblio';
  78     $opts{'money'} = '$';
  79     $opts{'timeout'} = 0;
  80     $opts{'config'} = '@sysconfdir@/opensrf_core.xml';
  81     $opts{'store'} = 'reporter';
  82
  83     GetOptions(\%opts,
  84                'help',
  85                'items',
  86                'mfhd',
  87                'all',
  88                'replace_001',
  89                'location=s',
  90                'money=s',
  91                'config=s',
  92                'format=s',
  93                'type=s',
  94                'xml-idl=s',
  95                'encoding=s',
  96                'timeout=i',
  97                'library=s@',
  98                'descendants=s@',
  99                'since=s',
 100                'store=s',
 101                'debug');
 102
 103     if ($opts{help}) {
 104         print <<"HELP";
 105 This script exports MARC authority, bibliographic, and serial holdings
 106 records from an Evergreen database.
 107
 108 Input to this script can consist of a list of record IDs, with one record ID
 109 per line, corresponding to the record ID in the Evergreen database table of
 110 your requested record type.
 111
 112 Alternately, passing the --all option will attempt to export all records of
 113 the specified type from the Evergreen database. The --all option starts at
 114 record ID 1 and increments the ID by 1 until the largest ID in the database
 115 is retrieved. This may not be very efficient for databases with large gaps
 116 in their ID sequences.
 117
 118 Usage: $0 [options]
 119  --help or -h       This screen.
 120  --config or -c     Configuration file [@sysconfdir@/opensrf_core.xml]
 121  --format or -f     Output format (USMARC, UNIMARC, XML, BRE, ARE) [USMARC]
 122  --encoding or -e   Output encoding (UTF-8, ISO-8859-?, MARC8) [MARC8]
 123  --xml-idl or -x    Location of the IDL XML
 124  --timeout          Remains for backward compatibility. No longer used.
 125  --type or -t       Record type (BIBLIO, AUTHORITY) [BIBLIO]
 126  --all or -a        Export all records; ignores input list
 127  --replace_001      Replace the 001 field value with the record ID
 128  --store            Use the given storage backend to connect to the database.
 129                     Choices are (reporter, cstore, storage) [reporter]
 130  --since            Export records modified since a certain date and time.
 131
 132  Additional options for type = 'BIBLIO':
 133  --items or -i      Include items (holdings) in the output
 134  --money            Currency symbol to use in item price field [\$]
 135  --mfhd             Export serial MFHD records for associated bib records
 136                     Not compatible with --format=BRE
 137  --location or -l   MARC Location Code for holdings from
 138                     http://www.loc.gov/marc/organizations/orgshome.html
 139  --library          Export the bibliographic records that have attached
 140                     holdings for the listed library or libraries as
 141                     identified by shortname
 142  --descendants      Like the --library option, but org. tree aware. It
 143                     exports records that have attached holdings for the
 144                     specified org. unit and all of its descendants in
 145                     the tree.
 146
 147 Examples:
 148
 149 To export a set of USMARC records in a file named "output_file" based on the
 150 IDs contained in a file named "list_of_ids":
 151   cat list_of_ids | $0 > output_file
 152
 153 To export a set of MARC21XML authority records in a file named "output.xml"
 154 for all authority records in the database:
 155   $0 --format XML --type AUTHORITY --all > output.xml
 156
 157 To export a set of USMARC bibliographic records encoded in UTF-8 in a file
 158 named "sys1_bibs.mrc" based on records which have attached callnumbers for the
 159 libraries with the short names "BR1" and "BR2":
 160
 161   $0 --library BR1 --library BR2 --encoding UTF-8 > sys1_bibs.mrc
 162
 163 HELP
 164         exit;
 165     }
 166
 167     OpenSRF::System->bootstrap_client( config_file => $opts{config} );
 168     my $sclient = OpenSRF::Utils::SettingsClient->new();
 169     unless ($opts{'xml-idl'}) {
 170         $opts{'xml-idl'} = $sclient->config_value('IDL');
 171     }
 172
 173     # Validate some of the settings.
 174     if ($opts{all} && ($opts{library} || $opts{descendants})) {
 175         die('Incompatible arguments: you cannot combine a request for all ' .
 176                 'records with a request for records by library');
 177     }
 178     if ($opts{all} && $opts{since}) {
 179         die('Incompatible arguments: you cannot combine a request for all ' .
 180                 'records with a request for records added or changed since a certain date');
 181     }
 182     $opts{type} = lc($opts{type});
 183     if (none {$_ eq $opts{type}} (TYPES)) {
 184         die "Please select a supported type.  ".
 185             "Right now that means one of [".
 186                 join('|',(FORMATS)). "]\n";
 187     }
 188     $opts{format} = uc($opts{format});
 189     if (none {$_ eq $opts{format}} (FORMATS)) {
 190         die "Please select a supported format.  ".
 191             "Right now that means one of [".
 192                 join('|',(FORMATS)). "]\n";
 193     }
 194
 195     if ($opts{format} eq 'ARE' && $opts{type} ne 'authority') {
 196         die "Format ARE is not compatible with type " . $opts{type};
 197     }
 198     if ($opts{format} eq 'BRE' && $opts{type} ne 'biblio') {
 199         die "Format BRE is not compatible with type " . $opts{type};
 200     }
 201     if ($opts{format} eq 'BRE' && $opts{items}) {
 202         die "Format BRE is not compatible with exporting holdings."
 203     }
 204
 205     if ($opts{mfhd}) {
 206         if ($opts{type} ne 'biblio') {
 207             die "MFHD export only works with bibliographic records.";
 208         } elsif ($opts{format} eq 'BRE') {
 209             die "MFHD export incompatible with format BRE.";
 210         }
 211     }
 212
 213     $opts{store} = lc($opts{store});
 214     if (none {$_ eq $opts{store}} (STORES)) {
 215         die "Please select a supported store.  ".
 216             "Right now that means one of [".
 217                 join('|',(STORES)). "]\n";
 218     } else {
 219         my $app;
 220         if ($opts{store} eq 'reporter') {
 221             $app = 'open-ils.reporter-store';
 222         } else {
 223             $app = 'open-ils.' . $opts{store};
 224         }
 225         if ($app eq 'open-ils.storage') {
 226             $self->{dbsettings} = $sclient->config_value(
 227                 apps => $app => app_settings => databases => 'database');
 228         } else {
 229             $self->{dbsettings} = $sclient->config_value(
 230                 apps => $app => app_settings => 'database');
 231         }
 232     }
 233     $opts{encoding} = uc($opts{encoding});
 234
 235     $self->{'options'} = \%opts;
 236     bless $self, $class;
 237     return $self;
 238 }
 239
 240 sub option_value {
 241     my ($self, $option) = @_;
 242     return $self->{options}->{$option};
 243 }
 244
 245 sub database_settings {
 246     my $self = shift;
 247     return $self->{dbsettings};
 248 }
 249
 250 sub need_ids {
 251     my $self = shift;
 252     my $rv = 1;
 253
 254     $rv = 0 if ($self->{options}->{all});
 255     $rv = 0 if ($self->{options}->{since});
 256     $rv = 0 if ($self->{options}->{library});
 257     $rv = 0 if ($self->{options}->{descendants});
 258
 259     return $rv;
 260 }
 261
 262 # ------------------------------------------------------------------
 263 # This package exists to get a connection to the database.  Since
 264 # we'll need one for both biblio records and authorities, we've made a
 265 # single subpackage with a function so that we don't have to duplicate
 266 # code.
 267 package Marque::Connector;
 268
 269 use DBI;
 270
 271 # Pass a Marque::Config object's database_settings return value into
 272 # this to get a DBI connection.
 273 # ex:
 274 # my $db = Marque::Connector::connect($config->database_settings);
 275 sub connect {
 276     my $args = shift;
 277
 278     # Build a connect string from the args.
 279     my $connect_string = 'DBI:Pg:';
 280     $connect_string .= 'dbname=' . $args->{db} . ';';
 281     $connect_string .= 'host=' . $args->{host} . ';';
 282     $connect_string .= 'port=' . $args->{port};
 283
 284     my $db_handle = DBI->connect($connect_string,
 285                                  $args->{user}, $args->{pw});
 286     return $db_handle;
 287 }
 288
 289 # A function to get the date into a format better for PostgreSQL.
 290 sub db_date {
 291     my $input = shift;
 292     my $date;
 293     if (ref($input) eq 'Date::Manip::Date') {
 294         $date = $input;
 295     } else {
 296         $date = Date::Manip::Date->new();
 297         if ($date->parse($input)) {
 298             die "Can't parse date $input";
 299         }
 300     }
 301     return $date->printf("%Y-%m-%dT%H:%M:%S%z");
 302  }
 303
 304 # ------------------------------------------------------------------
 305 # You would typically have the next two packages inherit from a common
 306 # superclass, but ineritance doesn't seem to work when all packages
 307 # are in single file, so we have some duplicated code between these
 308 # two.
 309
 310 # Get bibliographic records from the database.
 311 package Marque::Biblio;
 312
 313 sub new {
 314     my $class = shift;
 315     my $idlist = shift;
 316     my $self = {idlist => $idlist};
 317     $self->{handle} = Marque::Connector::connect(
 318         $Marque::config->database_settings);
 319     $self->{since_date} = Date::Manip::Date->new;
 320     $self->{since_date}->parse($Marque::config->option_value('since'));
 321
 322     # We need multiple fieldmapper classes depending on our
 323     # options. We'll just get the information that we'll need for them
 324     # all right here instead of only fetching the information when
 325     # needed.
 326     $self->{breClass} = Fieldmapper::class_for_hint('bre');
 327     $self->{acnClass} = Fieldmapper::class_for_hint('acn');
 328     $self->{acpClass} = Fieldmapper::class_for_hint('acp');
 329     $self->{sreClass} = Fieldmapper::class_for_hint('sre');
 330
 331     # Make an arrayref of shortname ids if the library option was
 332     # specified:
 333     $self->{libs} = [];
 334     if ($Marque::config->option_value('library')) {
 335         # This is done not only for speed, but to prevent SQL injection.
 336         my $sth = $self->{handle}->prepare('select id from actor.org_unit where shortname=any(?::text[])');
 337         if ($sth->execute($Marque::config->option_value('library'))) {
 338             my $r = $sth->fetchall_arrayref();
 339             my @ids = map {$_->[0]} @{$r};
 340             $self->{libs} = \@ids;
 341             $sth->finish();
 342         }
 343     }
 344     # Ditto for descendants.  We don't worry about redundancy, the db can deal with it.
 345     if ($Marque::config->option_value('descendants')) {
 346         # Unlike the above, we're looping to make this simpler in the database.
 347         my $sth = $self->{handle}->prepare(
 348                 'select id from actor.org_unit_descendants((select id from actor.org_unit where shortname=?))');
 349         foreach my $shortname (@{$Marque::config->option_value('descendants')}) {
 350             if ($sth->execute($shortname)) {
 351                 my $r = $sth->fetchall_arrayref();
 352                 my @ids = map {$_->[0]} @{$r};
 353                 push(@{$self->{libs}}, @ids);
 354                 $sth->finish();
 355             }
 356         }
 357     }
 358
 359     bless $self, $class;
 360     return $self;
 361 }
 362
 363 sub build_query {
 364     my $self = shift;
 365
 366     # Get the field names and tables for our classes. We add the fully
 367     # qualified table names to the fields so that the joins will work.
 368     my $breTable = $self->{breClass}->Table();
 369     my @breFields = map {$breTable . '.' . $_} $self->{breClass}->real_fields();
 370     my $acnTable = $self->{acnClass}->Table();
 371     my $acpTable = $self->{acpClass}->Table();
 372
 373     # Now we build the query in pieces:
 374
 375     # We always select the bre fields:
 376     my $select = 'select distinct ' . join(',', @breFields);
 377     # We always use the bre table.
 378     my $from = "from $breTable";
 379
 380     # If have the libraries or items options, we need to join the
 381     # asset.call_number table. If we have both, this variable checks
 382     # that it has already been joined so we don't create an invalid
 383     # query.
 384     my $acn_joined = 0;
 385     # Join to the acn table as needed for the library option.
 386     if (@{$self->{libs}}) {
 387         $acn_joined = 1;
 388         $from .= <<ACN_JOIN;
 389
 390 join $acnTable on $acnTable.record = $breTable.id
 391 and $acnTable.owning_lib in (
 392 ACN_JOIN
 393         $from .= join(',', @{$self->{libs}}) . ")";
 394         $from .= "\nand $acnTable.deleted = 'f'" unless ($Marque::config->option_value('since'));
 395     }
 396
 397     if ($Marque::config->option_value('items')) {
 398         unless ($acn_joined) {
 399             $from .= "\njoin $acnTable on $acnTable.record = $breTable.id";
 400             $from .= "\nand $acnTable.deleted = 'f'" unless ($Marque::config->option_value('since'));
 401         }
 402         $from .= "\njoin $acpTable on $acpTable.call_number = $acnTable.id";
 403         $from .= "\nand $acpTable.deleted = 'f'" unless ($Marque::config->option_value('since'));
 404     }
 405
 406     # The where really depends on a few options:
 407     my $where = "where $breTable.id > 0 and ";
 408     # We fill in the where as necessary.
 409     if ($self->{idlist} && @{$self->{idlist}}) {
 410         $where .= "$breTable.id in (" . join(',', @{$self->{idlist}}) . ')';
 411     } elsif ($Marque::config->option_value('since')) {
 412         my $since_str = Marque::Connector::db_date($self->{since_date});
 413         $where .= "($breTable.edit_date > '$since_str'";
 414         $where .= " or $breTable.create_date > '$since_str')";
 415     } else {
 416         # We want all non-deleted records.
 417         $where .= "$breTable.deleted = 'f'";
 418     }
 419
 420     $self->{query} = $select . "\n" . $from . "\n" . $where;
 421 }
 422
 423 sub execute_query {
 424     my $self = shift;
 425     $self->build_query() unless ($self->{query});
 426     $self->{sth} = $self->{handle}->prepare($self->{query});
 427     return $self->{sth}->execute;
 428 }
 429
 430 sub next {
 431     my $self = shift;
 432     my $output;
 433
 434     # $r holds the record object, either sre or bre.  $marc holds the
 435     # current record's MARC, either sre.marc or bre.marc
 436     my ($r,$marc);
 437     # If we have the mfhd option and we've previously retrieved some
 438     # sres, then we output one of the retrieved sres for each call
 439     # until we run out.  These sres "go with" the previous bib record.
 440     if ($Marque::config->option_value('mfhd') && $self->{mfhds} && @{$self->{mfhds}}) {
 441         $r = shift(@{$self->{mfhds}});
 442         eval {
 443             local $SIG{__WARN__} = sub {
 444                 my $message = "Warning from serial record " . $r->id() . ": "
 445                     . shift;
 446                 warn($message);
 447             };
 448             $marc = MARC::Record->new_from_xml($r->marc(),
 449                                                $Marque::config->option_value('encoding'),
 450                                                $Marque::config->option_value('format'));
 451         };
 452         if ($@) {
 453             warn("Error in serial record " . $r->id() . ": $@");
 454             import MARC::File::XML; # Reset SAX Parser.
 455             return $self->next();
 456         }
 457     } else {
 458         my $data = $self->{sth}->fetchrow_hashref;
 459         if ($data) {
 460             $r = $self->{breClass}->from_bare_hash($data);
 461             if ($Marque::config->option_value('format') eq 'BRE') {
 462                 $output = OpenSRF::Utils::JSON->perl2JSON($r);
 463             } else {
 464                 eval {
 465                     local $SIG{__WARN__} = sub {
 466                         my $message = "Warning from bibliographic record " . $r->id() . ": "
 467                             . shift;
 468                         warn($message);
 469                     };
 470                     $marc = MARC::Record->new_from_xml($r->marc(),
 471                                                        $Marque::config->option_value('encoding'),
 472                                                        $Marque::config->option_value('format'));
 473                 };
 474                 if ($@) {
 475                     warn("Error in bibliographic record " . $r->id() . ": $@");
 476                     import MARC::File::XML; # Reset SAX Parser.
 477                     return $self->next();
 478                 }
 479                 if ($Marque::config->option_value('replace_001')) {
 480                     my $tcn = $marc->field('001');
 481                     if ($tcn) {
 482                         $tcn->update($r->id());
 483                     } else {
 484                         $tcn = MARC::Field->new('001', $r->id());
 485                         $marc->insert_fields_ordered($tcn);
 486                     }
 487                 }
 488                 if ($Marque::config->option_value('items')) {
 489                     my @acps = $self->acps_for_bre($r);
 490                     foreach my $acp (@acps) {
 491                         next unless ($acp);
 492                         my $location = $Marque::config->option_value('location');
 493                         my $price = ($acp->price() ? $Marque::config->option_value('money').$acp->price() : '');
 494                         eval {
 495                             local $SIG{__WARN__} = sub {
 496                                 my $message = "Warning from bibliographic record " . $r->id() . ": "
 497                                     . shift;
 498                                 warn($message);
 499                             };
 500                             $marc->insert_grouped_field(
 501                             MARC::Field->new(
 502                                 '852', '4', ' ',
 503                                 ($location ? ('a' => $location) : ()),
 504                                 b => Encode::decode_utf8($acp->call_number()->owning_lib()->shortname()),
 505                                 b => Encode::decode_utf8($acp->circ_lib()->shortname()),
 506                                 c => Encode::decode_utf8($acp->location()->name()),
 507                                 j => Encode::decode_utf8($acp->call_number()->label()),
 508                                 ($acp->circ_modifier() ? (g => Encode::decode_utf8($acp->circ_modifier())) : ()),
 509                                 p => Encode::decode_utf8($acp->barcode()),
 510                                 ($price ? (y => Encode::decode_utf8($price)) : ()),
 511                                 ($acp->copy_number() ? (t => $acp->copy_number()) : ()),
 512                                 ($U->is_true($acp->ref()) ? (x => 'reference') : ()),
 513                                 (!$U->is_true($acp->holdable()) ? (x => 'unholdable') : ()),
 514                                 (!$U->is_true($acp->circulate()) ? (x => 'noncirculating') : ()),
 515                                 (!$U->is_true($acp->opac_visible()) ? (x => 'hidden') : ())
 516                             ));
 517                         };
 518                         if ($@) {
 519                             warn("Error in bibliographic record " . $r->id() . ": $@");
 520                             import MARC::File::XML; # Reset SAX Parser.
 521                             return $self->next();
 522                         }
 523                     }
 524                 }
 525                 if ($Marque::config->option_value('mfhd')) {
 526                     $self->{mfhds} = [$self->sres_for_bre($r)];
 527                 }
 528             }
 529         }
 530     }
 531     # Common stuff that doesn't depend on record type.
 532     if ($marc) {
 533         if ($Marque::config->option_value('since')) {
 534             my $leader = $marc->leader();
 535             if ($U->is_true($r->deleted())) {
 536                 substr($leader, 5, 1) = 'd';
 537                 $marc->leader($leader);
 538             } else {
 539                 my $create_date = Date::Manip::Date->new;
 540                 $create_date->parse($r->create_date());
 541                 my $edit_date = Date::Manip::Date->new;
 542                 $edit_date->parse($r->edit_date());
 543                 if ($self->{since_date}->cmp($create_date) < 0) {
 544                     substr($leader, 5, 1) = 'n';
 545                     $marc->leader($leader);
 546                 } elsif ($self->{since_date}->cmp($edit_date) < 0) {
 547                     substr($leader, 5, 1) = 'c';
 548                     $marc->leader($leader);
 549                 }
 550             }
 551         }
 552         if ($Marque::config->option_value('format') eq 'XML') {
 553             eval {
 554                 local $SIG{__WARN__} = sub {
 555                     my $message = "Warning from bibliographic record " . $r->id() . ": "
 556                         . shift;
 557                     warn($message);
 558                 };
 559                 $output = $marc->as_xml_record;
 560                 $output =~ s/^<\?.+?\?>$//mo;
 561             };
 562             if ($@) {
 563                 warn("Error in bibliographic record " . $r->id() . ": $@");
 564                 return $self->next();
 565             }
 566         } else {
 567             eval {
 568                 local $SIG{__WARN__} = sub {
 569                     my $message = "Warning from bibliographic record " . $r->id() . ": "
 570                         . shift;
 571                     warn($message);
 572                 };
 573                 $output = $marc->as_usmarc;
 574             };
 575             if ($@) {
 576                 warn("Error in bibliographic record " . $r->id() . ": $@");
 577                 return $self->next();
 578             }
 579         }
 580     }
 581     return $output;
 582 }
 583
 584 # Returns a list of aou objects in an array.
 585 sub orgs {
 586     my $self = shift;
 587     unless ($self->{orgs} && @{$self->{orgs}}) {
 588         my $fmClass = Fieldmapper::class_for_hint('aou');
 589         my @classFields = $fmClass->real_fields();
 590         my $classTable = $fmClass->Table();
 591         my $query = 'select ' . join(',', @classFields);
 592         $query .= "\nfrom $classTable";
 593         my $sth = $self->{handle}->prepare($query);
 594         if ($sth->execute()) {
 595             my $result = $sth->fetchall_arrayref({});
 596             my @orgs = map {$fmClass->from_bare_hash($_)} @{$result};
 597             $self->{orgs} = \@orgs;
 598         } else {
 599             $self->{orgs} = [];
 600         }
 601     }
 602     return @{$self->{orgs}};
 603 }
 604
 605 # Returns an array of acpl objects.
 606 sub shelves {
 607     my $self = shift;
 608
 609     unless ($self->{shelves} && @{$self->{shelves}}) {
 610         my $fmClass = Fieldmapper::class_for_hint('acpl');
 611         my @classFields = $fmClass->real_fields();
 612         my $classTable = $fmClass->Table();
 613         my $query = 'select ' . join(',', @classFields);
 614         $query .= "\nfrom $classTable";
 615         my $result = $self->{handle}->selectall_arrayref($query, {Slice=>{}});
 616         my @shelves = map {$fmClass->from_bare_hash($_)} @{$result};
 617         $self->{shelves} = \@shelves;
 618     }
 619
 620     return @{$self->{shelves}};
 621 }
 622
 623 # Returns an array of acn objects for a given bre object or id.
 624 sub acns_for_bre {
 625     my $self = shift;
 626     my $bre = shift;
 627     $bre = $bre->id() if (ref($bre));
 628
 629     unless ($self->{acnHandle}) {
 630         my $query = "select " . join(',', $self->{acnClass}->real_fields());
 631         $query .= "\nfrom " . $self->{acnClass}->Table();
 632         $query .= "\nwhere record = ?";
 633         if (@{$self->{libs}}) {
 634             $query .= "\nand owning_lib in (";
 635             $query .= join(',', @{$self->{libs}}) . ")";
 636         }
 637         $query .= "\nand deleted = 'f'" unless($Marque::config->option_value('since'));
 638         $self->{acnHandle} = $self->{handle}->prepare($query);
 639     }
 640
 641     if ($self->{acnHandle}->execute($bre)) {
 642         my $result = $self->{acnHandle}->fetchall_arrayref({});
 643         return map {$self->{acnClass}->from_bare_hash($_)} @{$result};
 644     }
 645
 646     # If for some reason, we don't find anything.
 647     return undef;
 648 }
 649
 650 # Returns an array of acp objects for a given bre object or id.
 651 sub acps_for_bre {
 652     my $self = shift;
 653     my $bre = shift;
 654     $bre = $bre->id() if (ref($bre));
 655
 656     my @orgs = $self->orgs();
 657     my @locations = $self->shelves();
 658
 659     my @acns = $self->acns_for_bre($bre);
 660     if (@acns) {
 661         my $query = 'select ' . join(',', $self->{acpClass}->real_fields());
 662         $query .= "\nfrom " . $self->{acpClass}->Table();
 663         $query .= "\nwhere call_number in (";
 664         $query .= join(',', map {$_->id()} @acns);
 665         $query .= ")";
 666         $query .= "\nand deleted = 'f'" unless ($Marque::config->option_value('since'));
 667         my $result = $self->{handle}->selectall_arrayref($query, {Slice=>{}});
 668         if ($result && @{$result}) {
 669             my @acps = map {$self->{acpClass}->from_bare_hash($_)} @{$result};
 670             foreach (@acps) {
 671                 my $cn = $_->call_number();
 672                 my $clib = $_->circ_lib();
 673                 my $loc = $_->location();
 674                 my ($org) = grep {$_->id() == $clib} @orgs;
 675                 my ($acn) = grep {$_->id() == $cn} @acns;
 676                 my ($location) = grep {$_->id() == $loc} @locations;
 677                 my $olib = $acn->owning_lib();
 678                 my ($owner) = grep {$_->id() == $olib} @orgs;
 679                 $acn->owning_lib($owner);
 680                 $_->call_number($acn);
 681                 $_->circ_lib($org);
 682                 $_->location($location);
 683             }
 684             return @acps;
 685         }
 686     }
 687
 688     # If for some reason, we don't find anything.
 689     return undef;
 690 }
 691
 692 # Retreive an array for sre objects when the --mfhd option is used.
 693 sub sres_for_bre {
 694     my $self = shift;
 695     my $bre = shift;
 696     $bre = $bre->id() if (ref($bre));
 697     my @sres;
 698     # Build a query to retrieve SREs when the MFHD option is passed.
 699     if ($Marque::config->option_value('mfhd')) {
 700         # Create a persistent handle as needed.
 701         unless ($self->{sreSth}) {
 702             my $query = "select " . join(',', $self->{sreClass}->real_fields());
 703             $query .= "\nfrom " . $self->{sreClass}->Table();
 704             $query .= "\nwhere record = ?";
 705             $query .= "\nand deleted = 'f'" unless ($Marque::config->option_value('since'));
 706             $self->{sreSth} = $self->{handle}->prepare($query);
 707         }
 708         if ($self->{sreSth}->execute($bre)) {
 709             while (my $data = $self->{sreSth}->fetchrow_hashref) {
 710                 push @sres, $self->{sreClass}->from_bare_hash($data);
 711             }
 712             $self->{sreSth}->finish; # Sometimes DBI complains.
 713         }
 714     }
 715     # May be empty.
 716     return @sres;
 717 }
 718
 719 # Get authority records from the database.
 720 package Marque::Authority;
 721
 722 sub new {
 723     my $class = shift;
 724     my $idlist = shift;
 725     my $self = {idlist => $idlist};
 726     $self->{handle} = Marque::Connector::connect(
 727         $Marque::config->database_settings);
 728     $self->{fmClass} = Fieldmapper::class_for_hint('are');
 729     $self->{since_date} = Date::Manip::Date->new;
 730     $self->{since_date}->parse($Marque::config->option_value('since'));
 731     bless $self, $class;
 732     return $self;
 733 }
 734
 735 sub build_query {
 736     my $self = shift;
 737
 738     # Get the information for are object from the Fieldmapper:
 739     my @fields  = $self->{fmClass}->real_fields();
 740     my $table = $self->{fmClass}->Table();
 741
 742     # Build the actual query.
 743     my $select = "select " . join(',', @fields);
 744     my $from = "from $table";
 745     my $where = 'where ';
 746
 747     # If we have an idlist, we pretty much ignore anything else.
 748     if ($self->{idlist} && @{$self->{idlist}}) {
 749         $where .= 'id in (' . join(',', @{$self->{idlist}}) . ')';
 750     } elsif ($Marque::config->option_value('since')) {
 751         my $since_str = Marque::Connector::db_date($self->{since_date});
 752         $where .= "edit_date > '$since_str'";
 753         $where .= " or create_date > '$since_str'";
 754     } else {
 755         # We want all non-deleted records.
 756         $where .= "deleted = 'f'";
 757     }
 758
 759     $self->{query} = $select . "\n" . $from . "\n" . $where;
 760 }
 761
 762 sub execute_query {
 763     my $self = shift;
 764     $self->build_query() unless ($self->{query});
 765     $self->{sth} = $self->{handle}->prepare($self->{query});
 766     return $self->{sth}->execute;
 767 }
 768
 769 sub next {
 770     my $self = shift;
 771     my $output;
 772     my $data = $self->{sth}->fetchrow_hashref;
 773
 774     if ($data) {
 775         my $format = $Marque::config->option_value('format');
 776         my $r = $self->{fmClass}->from_bare_hash($data);
 777         if ($format eq 'ARE') {
 778             $output = OpenSRF::Utils::JSON->perl2JSON($r);
 779         } else {
 780             my $marc;
 781             eval {
 782                 local $SIG{__WARN__} = sub {
 783                     my $message = "Warning from authority record " . $r->id() . ": "
 784                         . shift;
 785                     warn($message);
 786                 };
 787                 $marc = MARC::Record->new_from_xml($r->marc(),
 788                                                 $Marque::config->option_value('encoding'),
 789                                                 $Marque::config->option_value('format'));
 790             };
 791             if ($@) {
 792                 warn("Error in authority record " . $r->id() . ": $@");
 793                 import MARC::File::XML; # Reset SAX Parser.
 794                 return $self->next();
 795             }
 796             if ($Marque::config->option_value('replace_001')) {
 797                 my $tcn = $marc->field('001');
 798                 if ($tcn) {
 799                     $tcn->update($r->id());
 800                 } else {
 801                     $tcn = MARC::Field->new('001', $r->id());
 802                     $marc->insert_fields_ordered($tcn);
 803                 }
 804             }
 805             if ($Marque::config->option_value('since')) {
 806                 my $leader = $marc->leader();
 807                 if ($U->is_true($r->deleted())) {
 808                     substr($leader, 5, 1) = 'd';
 809                     $marc->leader($leader);
 810                 } else {
 811                     my $create_date = Date::Manip::Date->new;
 812                     $create_date->parse($r->create_date());
 813                     my $edit_date = Date::Manip::Date->new;
 814                     $edit_date->parse($r->edit_date());
 815                     if ($self->{since_date}->cmp($create_date) < 0) {
 816                         substr($leader, 5, 1) = 'n';
 817                         $marc->leader($leader);
 818                     } elsif ($self->{since_date}->cmp($edit_date) < 0) {
 819                         substr($leader, 5, 1) = 'c';
 820                         $marc->leader($leader);
 821                     }
 822                 }
 823             }
 824             if ($Marque::config->option_value('format') eq 'XML') {
 825                 eval {
 826                     local $SIG{__WARN__} = sub {
 827                         my $message = "Warning from authority record " . $r->id() . ": "
 828                             . shift;
 829                         warn($message);
 830                     };
 831                     $output = $marc->as_xml_record;
 832                     $output =~ s/^<\?.+?\?>$//mo;
 833                 };
 834                 if ($@) {
 835                     warn("Error in authority record " . $r->id() . ": $@");
 836                     return $self->next();
 837                 }
 838             } else {
 839                 eval {
 840                     local $SIG{__WARN__} = sub {
 841                         my $message = "Warning from authority record " . $r->id() . ": "
 842                             . shift;
 843                         warn($message);
 844                     };
 845                     $output = $marc->as_usmarc;
 846                 };
 847                 if ($@) {
 848                     warn("Error in authority record " . $r->id() . ": $@");
 849                     return $self->next();
 850                 }
 851             }
 852         }
 853     }
 854
 855     return $output;
 856 }
 857
 858 # ------------------------------------------------------------------
 859 # Since the ultimate output is largely independent of the type of the
 860 # records, we use a single subpackage to group our output routines.
 861 package Marque::Output;
 862
 863 sub output {
 864     my $extractor = shift;
 865     if ($extractor->execute_query) {
 866         if ($Marque::config->option_value('encoding') eq 'UTF-8') {
 867             binmode(STDOUT, ':utf8');
 868         } else {
 869             binmode(STDOUT, ':raw');
 870         }
 871
 872         &preamble;
 873         while (my $output = $extractor->next()) {
 874             print $output;
 875         }
 876         &postamble;
 877     } else {
 878         print STDERR $extractor->{query} if ($Marque::config->option_value('debug'));
 879         die "Database query failed!";
 880     }
 881 }
 882
 883 sub preamble {
 884     if ($Marque::config->option_value('format') eq 'XML') {
 885         my $encoding = $Marque::config->option_value('encoding');
 886         print <<PREAMBLE;
 887 <?xml version="1.0" encoding="$encoding"?>
 888 <collection xmlns='http://www.loc.gov/MARC21/slim'>
 889 PREAMBLE
 890     }
 891 }
 892
 893 sub postamble {
 894     if ($Marque::config->option_value('format') eq 'XML') {
 895         print "</collection>\n";
 896     }
 897 }
 898
 899 1;