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