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