2 # ---------------------------------------------------------------
3 # Copyright © 2013 Merrimack Valley Library Consortium
4 # Jason Stephenson <jstephenson@mvlc.org>
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.
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 # ---------------------------------------------------------------
18 use OpenILS::Utils::Fieldmapper;
19 use OpenILS::Application::AppUtils;
20 use OpenSRF::Utils::JSON;
23 use MARC::File::XML (BinaryEncoding => 'UTF-8');
24 use Date::Manip::Date;
26 my $U = 'OpenILS::Application::AppUtils';
28 binmode(STDERR, ':utf8');
32 our $config = Marque::Config->new();
33 Fieldmapper->import(IDL => $config->option_value('xml-idl'));
35 # Look for passed in ids:
37 if ($config->need_ids()) {
38 print STDERR "Waiting for input\n" if (-t);
40 push @ids, $i if ($i =~ /^\s*[0-9]+\s*$/);
45 if ($config->option_value('type') eq 'authority') {
46 $exporter = Marque::Authority->new(\@ids);
48 $exporter = Marque::Biblio->new(\@ids);
51 Marque::Output::output($exporter);
53 # ------------------------------------------------------------------
54 package Marque::Config;
57 use List::MoreUtils qw(none);
59 use OpenSRF::Utils::SettingsClient;
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);
71 # For command line options.
74 # set some default values
75 $opts{'format'} = 'USMARC';
76 $opts{'encoding'} = 'MARC8';
77 $opts{'type'} = 'biblio';
80 $opts{'config'} = '@sysconfdir@/opensrf_core.xml';
81 $opts{'store'} = 'reporter';
106 This script exports MARC authority, bibliographic, and serial holdings
107 records from an Evergreen database.
109 Input to this script can consist of a list of record IDs, with one record ID
110 per line, corresponding to the record ID in the Evergreen database table of
111 your requested record type.
113 Alternately, passing the --all option will attempt to export all records of
114 the specified type from the Evergreen database. The --all option starts at
115 record ID 1 and increments the ID by 1 until the largest ID in the database
116 is retrieved. This may not be very efficient for databases with large gaps
117 in their ID sequences.
120 --help or -h This screen.
121 --config or -c Configuration file [@sysconfdir@/opensrf_core.xml]
122 --format or -f Output format (USMARC, UNIMARC, XML, BRE, ARE) [USMARC]
123 --encoding or -e Output encoding (UTF-8, ISO-8859-?, MARC8) [MARC8]
124 --xml-idl or -x Location of the IDL XML
125 --timeout Remains for backward compatibility. No longer used.
126 --type or -t Record type (BIBLIO, AUTHORITY) [BIBLIO]
127 --all or -a Export all records; ignores input list
128 --replace_001 Replace the 001 field value with the record ID
129 --store Use the given storage backend to connect to the database.
130 Choices are (reporter, cstore, storage) [reporter]
131 --since Export records modified since a certain date and time.
133 Additional options for type = 'BIBLIO':
134 --items or -i Include items (holdings) in the output
135 --money Currency symbol to use in item price field [\$]
136 --mfhd Export serial MFHD records for associated bib records
137 Not compatible with --format=BRE
138 --location or -l MARC Location Code for holdings from
139 http://www.loc.gov/marc/organizations/orgshome.html
140 --library Export the bibliographic records that have attached
141 holdings for the listed library or libraries as
142 identified by shortname
143 --descendants Like the --library option, but org. tree aware. It
144 exports records that have attached holdings for the
145 specified org. unit and all of its descendants in
147 --uris or -u Include records with located URIs in the output
151 To export a set of USMARC records in a file named "output_file" based on the
152 IDs contained in a file named "list_of_ids":
153 cat list_of_ids | $0 > output_file
155 To export a set of MARC21XML authority records in a file named "output.xml"
156 for all authority records in the database:
157 $0 --format XML --type AUTHORITY --all > output.xml
159 To export a set of USMARC bibliographic records encoded in UTF-8 in a file
160 named "sys1_bibs.mrc" based on records which have attached callnumbers for the
161 libraries with the short names "BR1" and "BR2":
163 $0 --library BR1 --library BR2 --encoding UTF-8 > sys1_bibs.mrc
169 OpenSRF::System->bootstrap_client( config_file => $opts{config} );
170 my $sclient = OpenSRF::Utils::SettingsClient->new();
171 unless ($opts{'xml-idl'}) {
172 $opts{'xml-idl'} = $sclient->config_value('IDL');
175 # Validate some of the settings.
176 if ($opts{all} && ($opts{library} || $opts{descendants})) {
177 die('Incompatible arguments: you cannot combine a request for all ' .
178 'records with a request for records by library');
180 if ($opts{all} && $opts{since}) {
181 die('Incompatible arguments: you cannot combine a request for all ' .
182 'records with a request for records added or changed since a certain date');
184 $opts{type} = lc($opts{type});
185 if (none {$_ eq $opts{type}} (TYPES)) {
186 die "Please select a supported type. ".
187 "Right now that means one of [".
188 join('|',(FORMATS)). "]\n";
190 $opts{format} = uc($opts{format});
191 if (none {$_ eq $opts{format}} (FORMATS)) {
192 die "Please select a supported format. ".
193 "Right now that means one of [".
194 join('|',(FORMATS)). "]\n";
197 if ($opts{format} eq 'ARE' && $opts{type} ne 'authority') {
198 die "Format ARE is not compatible with type " . $opts{type};
200 if ($opts{format} eq 'BRE' && $opts{type} ne 'biblio') {
201 die "Format BRE is not compatible with type " . $opts{type};
203 if ($opts{format} eq 'BRE' && $opts{items}) {
204 die "Format BRE is not compatible with exporting holdings."
208 if ($opts{type} ne 'biblio') {
209 die "MFHD export only works with bibliographic records.";
210 } elsif ($opts{format} eq 'BRE') {
211 die "MFHD export incompatible with format BRE.";
215 $opts{store} = lc($opts{store});
216 if (none {$_ eq $opts{store}} (STORES)) {
217 die "Please select a supported store. ".
218 "Right now that means one of [".
219 join('|',(STORES)). "]\n";
222 if ($opts{store} eq 'reporter') {
223 $app = 'open-ils.reporter-store';
225 $app = 'open-ils.' . $opts{store};
227 if ($app eq 'open-ils.storage') {
228 $self->{dbsettings} = $sclient->config_value(
229 apps => $app => app_settings => databases => 'database');
231 $self->{dbsettings} = $sclient->config_value(
232 apps => $app => app_settings => 'database');
235 $opts{encoding} = uc($opts{encoding});
237 $self->{'options'} = \%opts;
243 my ($self, $option) = @_;
244 return $self->{options}->{$option};
247 sub database_settings {
249 return $self->{dbsettings};
256 $rv = 0 if ($self->{options}->{all});
257 $rv = 0 if ($self->{options}->{since});
258 $rv = 0 if ($self->{options}->{library});
259 $rv = 0 if ($self->{options}->{descendants});
264 # ------------------------------------------------------------------
265 # This package exists to get a connection to the database. Since
266 # we'll need one for both biblio records and authorities, we've made a
267 # single subpackage with a function so that we don't have to duplicate
269 package Marque::Connector;
273 # Pass a Marque::Config object's database_settings return value into
274 # this to get a DBI connection.
276 # my $db = Marque::Connector::connect($config->database_settings);
280 # Build a connect string from the args.
281 my $connect_string = 'DBI:Pg:';
282 $connect_string .= 'dbname=' . $args->{db} . ';';
283 $connect_string .= 'host=' . $args->{host} . ';';
284 $connect_string .= 'port=' . $args->{port};
286 my $db_handle = DBI->connect($connect_string,
287 $args->{user}, $args->{pw});
291 # A function to get the date into a format better for PostgreSQL.
295 if (ref($input) eq 'Date::Manip::Date') {
298 $date = Date::Manip::Date->new();
299 if ($date->parse($input)) {
300 die "Can't parse date $input";
303 return $date->printf("%Y-%m-%dT%H:%M:%S%z");
306 # ------------------------------------------------------------------
307 # You would typically have the next two packages inherit from a common
308 # superclass, but ineritance doesn't seem to work when all packages
309 # are in single file, so we have some duplicated code between these
312 # Get bibliographic records from the database.
313 package Marque::Biblio;
318 my $self = {idlist => $idlist};
319 $self->{handle} = Marque::Connector::connect(
320 $Marque::config->database_settings);
321 $self->{since_date} = Date::Manip::Date->new;
322 $self->{since_date}->parse($Marque::config->option_value('since'));
324 # We need multiple fieldmapper classes depending on our
325 # options. We'll just get the information that we'll need for them
326 # all right here instead of only fetching the information when
328 $self->{breClass} = Fieldmapper::class_for_hint('bre');
329 $self->{acnClass} = Fieldmapper::class_for_hint('acn');
330 $self->{acpClass} = Fieldmapper::class_for_hint('acp');
331 $self->{sreClass} = Fieldmapper::class_for_hint('sre');
332 $self->{acnpClass} = Fieldmapper::class_for_hint('acnp');
333 $self->{acnsClass} = Fieldmapper::class_for_hint('acns');
334 $self->{auricnmClass} = Fieldmapper::class_for_hint('auricnm');
336 # Make an arrayref of shortname ids if the library option was
339 if ($Marque::config->option_value('library')) {
340 # This is done not only for speed, but to prevent SQL injection.
341 my $sth = $self->{handle}->prepare('select id from actor.org_unit where shortname=any(?::text[])');
342 if ($sth->execute($Marque::config->option_value('library'))) {
343 my $r = $sth->fetchall_arrayref();
344 my @ids = map {$_->[0]} @{$r};
345 $self->{libs} = \@ids;
349 # Ditto for descendants. We don't worry about redundancy, the db can deal with it.
350 if ($Marque::config->option_value('descendants')) {
351 # Unlike the above, we're looping to make this simpler in the database.
352 my $sth = $self->{handle}->prepare(
353 'select id from actor.org_unit_descendants((select id from actor.org_unit where shortname=?))');
354 foreach my $shortname (@{$Marque::config->option_value('descendants')}) {
355 if ($sth->execute($shortname)) {
356 my $r = $sth->fetchall_arrayref();
357 my @ids = map {$_->[0]} @{$r};
358 push(@{$self->{libs}}, @ids);
371 # TODO: There is some unfortunate code repetition in this
372 # subroutine and it is now about 93 lines long with comments and
373 # whitespace. It should probably be refactored into a series of
374 # smaller subroutines to avoid the repetition.
376 # Get the field names and tables for our classes. We add the fully
377 # qualified table names to the fields so that the joins will work.
378 my $breTable = $self->{breClass}->Table();
379 my @breFields = map {$breTable . '.' . $_} $self->{breClass}->real_fields();
380 my $acnTable = $self->{acnClass}->Table();
381 my $acpTable = $self->{acpClass}->Table();
382 my $acnpTable = $self->{acnpClass}->Table();
383 my $acnsTable = $self->{acnsClass}->Table();
384 my $auricnmTable = $self->{auricnmClass}->Table();
386 # Now we build the query in pieces:
388 # We always select the bre fields:
389 my $select = 'select distinct ' . join(',', @breFields);
390 # We always use the bre table.
391 my $from = "from $breTable";
393 # If have the libraries or items options, we need to join the
394 # asset.call_number table. If we have both, this variable checks
395 # that it has already been joined so we don't create an invalid
398 # Join to the acn table as needed for the library option.
399 if (@{$self->{libs}}) {
403 join $acnTable on $acnTable.record = $breTable.id
404 and $acnTable.owning_lib in (
406 $from .= join(',', @{$self->{libs}}) . ")";
407 $from .= "\nand $acnTable.deleted = 'f'" unless ($Marque::config->option_value('since'));
410 if ($Marque::config->option_value('items')) {
411 unless ($acn_joined) {
412 $from .= "\njoin $acnTable on $acnTable.record = $breTable.id";
413 $from .= "\nand $acnTable.deleted = 'f'" unless ($Marque::config->option_value('since'));
415 $from .= "\njoin $acpTable on $acpTable.call_number = $acnTable.id";
416 $from .= "\nand $acpTable.deleted = 'f'" unless ($Marque::config->option_value('since'));
417 $from .= "\nleft outer join $acnpTable on $acnTable.prefix = $acnpTable.id";
418 $from .= "\nleft outer join $acnsTable on $acnTable.suffix = $acnsTable.id";
421 # The where really depends on a few options:
422 my $where = "where $breTable.id > 0 and ";
423 # We fill in the where as necessary.
424 if ($self->{idlist} && @{$self->{idlist}}) {
425 $where .= "$breTable.id in (" . join(',', @{$self->{idlist}}) . ')';
426 } elsif ($Marque::config->option_value('since')) {
427 my $since_str = Marque::Connector::db_date($self->{since_date});
428 $where .= "($breTable.edit_date > '$since_str'";
429 $where .= " or $breTable.create_date > '$since_str')";
431 # We want all non-deleted records.
432 $where .= "$breTable.deleted = 'f'";
435 # Support the --uris option. It is orthogonal to --items, so we
436 # may have to build a second query to use with a UNION DISTINCT.
438 if ($Marque::config->option_value('uris')) {
439 if ($Marque::config->option_value('items')) {
440 # Build UNION DISTINCT for main query.
441 $uri_union = "\nunion distinct\n";
442 $uri_union .= $select;
443 $uri_union .= "\nfrom $breTable";
444 $uri_union .= "\njoin $acnTable on $acnTable.record = $breTable.id";
445 $uri_union .= "\nand $acnTable.owning_lib in (" . join(',', @{$self->{libs}}) . ")" if (@{$self->{libs}});
446 $uri_union .= "\nand $acnTable.deleted = 'f'" unless ($Marque::config->option_value('since'));
447 $uri_union .= "\njoin $auricnmTable on $auricnmTable.call_number = $acnTable.id";
448 $uri_union .= "\n$where";
450 unless ($acn_joined) {
451 $from .= "\njoin $acnTable on $acnTable.record = $breTable.id";
452 $from .= "\nand $acnTable.deleted = 'f'" unless ($Marque::config->option_value('since'));
454 $from .= "\njoin $auricnmTable on $auricnmTable.call_number = $acnTable.id";
458 $self->{query} = $select . "\n" . $from . "\n" . $where;
459 $self->{query} .= $uri_union if ($uri_union);
464 $self->build_query() unless ($self->{query});
465 $self->{sth} = $self->{handle}->prepare($self->{query});
466 return $self->{sth}->execute;
473 # $r holds the record object, either sre or bre. $marc holds the
474 # current record's MARC, either sre.marc or bre.marc
476 # If we have the mfhd option and we've previously retrieved some
477 # sres, then we output one of the retrieved sres for each call
478 # until we run out. These sres "go with" the previous bib record.
479 if ($Marque::config->option_value('mfhd') && $self->{mfhds} && @{$self->{mfhds}}) {
480 $r = shift(@{$self->{mfhds}});
482 local $SIG{__WARN__} = sub {
483 my $message = "Warning from serial record " . $r->id() . ": "
487 $marc = MARC::Record->new_from_xml($r->marc(),
488 $Marque::config->option_value('encoding'),
489 $Marque::config->option_value('format'));
492 warn("Error in serial record " . $r->id() . ": $@");
493 import MARC::File::XML; # Reset SAX Parser.
494 return $self->next();
497 my $data = $self->{sth}->fetchrow_hashref;
499 $r = $self->{breClass}->from_bare_hash($data);
500 if ($Marque::config->option_value('format') eq 'BRE') {
501 $output = OpenSRF::Utils::JSON->perl2JSON($r);
504 local $SIG{__WARN__} = sub {
505 my $message = "Warning from bibliographic record " . $r->id() . ": "
509 $marc = MARC::Record->new_from_xml($r->marc(),
510 $Marque::config->option_value('encoding'),
511 $Marque::config->option_value('format'));
514 warn("Error in bibliographic record " . $r->id() . ": $@");
515 import MARC::File::XML; # Reset SAX Parser.
516 return $self->next();
518 if ($Marque::config->option_value('replace_001')) {
519 my $tcn = $marc->field('001');
521 $tcn->update($r->id());
523 $tcn = MARC::Field->new('001', $r->id());
524 $marc->insert_fields_ordered($tcn);
527 if ($Marque::config->option_value('items')) {
528 my @acps = $self->acps_for_bre($r);
529 foreach my $acp (@acps) {
531 my $location = $Marque::config->option_value('location');
532 my $price = ($acp->price() ? $Marque::config->option_value('money').$acp->price() : '');
533 my $prefix = $acp->call_number()->prefix()->label();
534 my $suffix = $acp->call_number()->suffix()->label();
536 local $SIG{__WARN__} = sub {
537 my $message = "Warning from bibliographic record " . $r->id() . ": "
541 $marc->insert_grouped_field(
544 ($location ? ('a' => $location) : ()),
545 b => Encode::decode_utf8($acp->call_number()->owning_lib()->shortname()),
546 b => Encode::decode_utf8($acp->circ_lib()->shortname()),
547 c => Encode::decode_utf8($acp->location()->name()),
548 ($prefix ? (k => Encode::decode_utf8($prefix)) : ()),
549 j => Encode::decode_utf8($acp->call_number()->label()),
550 ($suffix ? (m => Encode::decode_utf8($suffix)) : ()),
551 ($acp->circ_modifier() ? (g => Encode::decode_utf8($acp->circ_modifier())) : ()),
552 p => Encode::decode_utf8($acp->barcode()),
553 ($price ? (y => Encode::decode_utf8($price)) : ()),
554 ($acp->copy_number() ? (t => $acp->copy_number()) : ()),
555 ($U->is_true($acp->ref()) ? (x => 'reference') : ()),
556 (!$U->is_true($acp->holdable()) ? (x => 'unholdable') : ()),
557 (!$U->is_true($acp->circulate()) ? (x => 'noncirculating') : ()),
558 (!$U->is_true($acp->opac_visible()) ? (x => 'hidden') : ())
562 warn("Error in bibliographic record " . $r->id() . ": $@");
563 import MARC::File::XML; # Reset SAX Parser.
564 return $self->next();
568 if ($Marque::config->option_value('mfhd')) {
569 $self->{mfhds} = [$self->sres_for_bre($r)];
574 # Common stuff that doesn't depend on record type.
576 if ($Marque::config->option_value('since')) {
577 my $leader = $marc->leader();
578 if ($U->is_true($r->deleted())) {
579 substr($leader, 5, 1) = 'd';
580 $marc->leader($leader);
582 my $create_date = Date::Manip::Date->new;
583 $create_date->parse($r->create_date());
584 my $edit_date = Date::Manip::Date->new;
585 $edit_date->parse($r->edit_date());
586 if ($self->{since_date}->cmp($create_date) < 0) {
587 substr($leader, 5, 1) = 'n';
588 $marc->leader($leader);
589 } elsif ($self->{since_date}->cmp($edit_date) < 0) {
590 substr($leader, 5, 1) = 'c';
591 $marc->leader($leader);
595 if ($Marque::config->option_value('format') eq 'XML') {
597 local $SIG{__WARN__} = sub {
598 my $message = "Warning from bibliographic record " . $r->id() . ": "
602 $output = $marc->as_xml_record;
603 $output =~ s/^<\?.+?\?>$//mo;
606 warn("Error in bibliographic record " . $r->id() . ": $@");
607 return $self->next();
611 local $SIG{__WARN__} = sub {
612 my $message = "Warning from bibliographic record " . $r->id() . ": "
616 $output = $marc->as_usmarc;
619 warn("Error in bibliographic record " . $r->id() . ": $@");
620 return $self->next();
627 # Returns a list of aou objects in an array.
630 unless ($self->{orgs} && @{$self->{orgs}}) {
631 my $fmClass = Fieldmapper::class_for_hint('aou');
632 my @classFields = $fmClass->real_fields();
633 my $classTable = $fmClass->Table();
634 my $query = 'select ' . join(',', @classFields);
635 $query .= "\nfrom $classTable";
636 my $sth = $self->{handle}->prepare($query);
637 if ($sth->execute()) {
638 my $result = $sth->fetchall_arrayref({});
639 my @orgs = map {$fmClass->from_bare_hash($_)} @{$result};
640 $self->{orgs} = \@orgs;
645 return @{$self->{orgs}};
648 # Returns an array of acpl objects.
652 unless ($self->{shelves} && @{$self->{shelves}}) {
653 my $fmClass = Fieldmapper::class_for_hint('acpl');
654 my @classFields = $fmClass->real_fields();
655 my $classTable = $fmClass->Table();
656 my $query = 'select ' . join(',', @classFields);
657 $query .= "\nfrom $classTable";
658 my $result = $self->{handle}->selectall_arrayref($query, {Slice=>{}});
659 my @shelves = map {$fmClass->from_bare_hash($_)} @{$result};
660 $self->{shelves} = \@shelves;
663 return @{$self->{shelves}};
666 # Returns an array of acnp objects.
670 unless ($self->{prefixes} && @{$self->{prefixes}}) {
671 my $fmClass = Fieldmapper::class_for_hint('acnp');
672 my @classFields = $fmClass->real_fields();
673 my $classTable = $fmClass->Table();
674 my $query = 'select ' . join(',', @classFields);
675 $query .= "\nfrom $classTable";
676 my $result = $self->{handle}->selectall_arrayref($query, {Slice=>{}});
677 my @prefixes = map {$fmClass->from_bare_hash($_)} @{$result};
678 $self->{prefixes} = \@prefixes;
681 return @{$self->{prefixes}};
684 # Returns an array of acns objects.
688 unless ($self->{suffixes} && @{$self->{suffixes}}) {
689 my $fmClass = Fieldmapper::class_for_hint('acns');
690 my @classFields = $fmClass->real_fields();
691 my $classTable = $fmClass->Table();
692 my $query = 'select ' . join(',', @classFields);
693 $query .= "\nfrom $classTable";
694 my $result = $self->{handle}->selectall_arrayref($query, {Slice=>{}});
695 my @suffixes = map {$fmClass->from_bare_hash($_)} @{$result};
696 $self->{suffixes} = \@suffixes;
699 return @{$self->{suffixes}};
702 # Returns an array of acn objects for a given bre object or id.
706 $bre = $bre->id() if (ref($bre));
708 unless ($self->{acnHandle}) {
709 my $query = "select " . join(',', $self->{acnClass}->real_fields());
710 $query .= "\nfrom " . $self->{acnClass}->Table();
711 $query .= "\nwhere record = ?";
712 if (@{$self->{libs}}) {
713 $query .= "\nand owning_lib in (";
714 $query .= join(',', @{$self->{libs}}) . ")";
716 $query .= "\nand deleted = 'f'" unless($Marque::config->option_value('since'));
717 $self->{acnHandle} = $self->{handle}->prepare($query);
720 if ($self->{acnHandle}->execute($bre)) {
721 my $result = $self->{acnHandle}->fetchall_arrayref({});
722 return map {$self->{acnClass}->from_bare_hash($_)} @{$result};
725 # If for some reason, we don't find anything.
729 # Returns an array of acp objects for a given bre object or id.
733 $bre = $bre->id() if (ref($bre));
735 my @orgs = $self->orgs();
736 my @locations = $self->shelves();
737 my @prefixes = $self->prefixes();
738 my @suffixes = $self->suffixes();
740 my @acns = $self->acns_for_bre($bre);
742 my $query = 'select ' . join(',', $self->{acpClass}->real_fields());
743 $query .= "\nfrom " . $self->{acpClass}->Table();
744 $query .= "\nwhere call_number in (";
745 $query .= join(',', map {$_->id()} @acns);
747 $query .= "\nand deleted = 'f'" unless ($Marque::config->option_value('since'));
748 my $result = $self->{handle}->selectall_arrayref($query, {Slice=>{}});
749 if ($result && @{$result}) {
750 my @acps = map {$self->{acpClass}->from_bare_hash($_)} @{$result};
752 my $cn = $_->call_number();
753 my $clib = $_->circ_lib();
754 my $loc = $_->location();
755 my ($org) = grep {$_->id() == $clib} @orgs;
756 my ($acn) = grep {$_->id() == $cn} @acns;
757 my ($location) = grep {$_->id() == $loc} @locations;
758 my $olib = $acn->owning_lib();
759 my $pre = $acn->prefix();
760 my $suf = $acn->suffix();
761 my ($acnp) = grep {$_->id() == $pre} @prefixes;
762 my ($acns) = grep {$_->id() == $suf} @suffixes;
763 my ($owner) = grep {$_->id() == $olib} @orgs;
764 $acn->owning_lib($owner);
765 $_->call_number($acn);
767 $_->location($location);
768 $_->call_number->prefix($acnp);
769 $_->call_number->suffix($acns);
775 # If for some reason, we don't find anything.
779 # Retreive an array for sre objects when the --mfhd option is used.
783 $bre = $bre->id() if (ref($bre));
785 # Build a query to retrieve SREs when the MFHD option is passed.
786 if ($Marque::config->option_value('mfhd')) {
787 # Create a persistent handle as needed.
788 unless ($self->{sreSth}) {
789 my $query = "select " . join(',', $self->{sreClass}->real_fields());
790 $query .= "\nfrom " . $self->{sreClass}->Table();
791 $query .= "\nwhere record = ?";
792 $query .= "\nand deleted = 'f'" unless ($Marque::config->option_value('since'));
793 $self->{sreSth} = $self->{handle}->prepare($query);
795 if ($self->{sreSth}->execute($bre)) {
796 while (my $data = $self->{sreSth}->fetchrow_hashref) {
797 push @sres, $self->{sreClass}->from_bare_hash($data);
799 $self->{sreSth}->finish; # Sometimes DBI complains.
806 # Get authority records from the database.
807 package Marque::Authority;
812 my $self = {idlist => $idlist};
813 $self->{handle} = Marque::Connector::connect(
814 $Marque::config->database_settings);
815 $self->{fmClass} = Fieldmapper::class_for_hint('are');
816 $self->{since_date} = Date::Manip::Date->new;
817 $self->{since_date}->parse($Marque::config->option_value('since'));
825 # Get the information for are object from the Fieldmapper:
826 my @fields = $self->{fmClass}->real_fields();
827 my $table = $self->{fmClass}->Table();
829 # Build the actual query.
830 my $select = "select " . join(',', @fields);
831 my $from = "from $table";
832 my $where = 'where ';
834 # If we have an idlist, we pretty much ignore anything else.
835 if ($self->{idlist} && @{$self->{idlist}}) {
836 $where .= 'id in (' . join(',', @{$self->{idlist}}) . ')';
837 } elsif ($Marque::config->option_value('since')) {
838 my $since_str = Marque::Connector::db_date($self->{since_date});
839 $where .= "edit_date > '$since_str'";
840 $where .= " or create_date > '$since_str'";
842 # We want all non-deleted records.
843 $where .= "deleted = 'f'";
846 $self->{query} = $select . "\n" . $from . "\n" . $where;
851 $self->build_query() unless ($self->{query});
852 $self->{sth} = $self->{handle}->prepare($self->{query});
853 return $self->{sth}->execute;
859 my $data = $self->{sth}->fetchrow_hashref;
862 my $format = $Marque::config->option_value('format');
863 my $r = $self->{fmClass}->from_bare_hash($data);
864 if ($format eq 'ARE') {
865 $output = OpenSRF::Utils::JSON->perl2JSON($r);
869 local $SIG{__WARN__} = sub {
870 my $message = "Warning from authority record " . $r->id() . ": "
874 $marc = MARC::Record->new_from_xml($r->marc(),
875 $Marque::config->option_value('encoding'),
876 $Marque::config->option_value('format'));
879 warn("Error in authority record " . $r->id() . ": $@");
880 import MARC::File::XML; # Reset SAX Parser.
881 return $self->next();
883 if ($Marque::config->option_value('replace_001')) {
884 my $tcn = $marc->field('001');
886 $tcn->update($r->id());
888 $tcn = MARC::Field->new('001', $r->id());
889 $marc->insert_fields_ordered($tcn);
892 if ($Marque::config->option_value('since')) {
893 my $leader = $marc->leader();
894 if ($U->is_true($r->deleted())) {
895 substr($leader, 5, 1) = 'd';
896 $marc->leader($leader);
898 my $create_date = Date::Manip::Date->new;
899 $create_date->parse($r->create_date());
900 my $edit_date = Date::Manip::Date->new;
901 $edit_date->parse($r->edit_date());
902 if ($self->{since_date}->cmp($create_date) < 0) {
903 substr($leader, 5, 1) = 'n';
904 $marc->leader($leader);
905 } elsif ($self->{since_date}->cmp($edit_date) < 0) {
906 substr($leader, 5, 1) = 'c';
907 $marc->leader($leader);
911 if ($Marque::config->option_value('format') eq 'XML') {
913 local $SIG{__WARN__} = sub {
914 my $message = "Warning from authority record " . $r->id() . ": "
918 $output = $marc->as_xml_record;
919 $output =~ s/^<\?.+?\?>$//mo;
922 warn("Error in authority record " . $r->id() . ": $@");
923 return $self->next();
927 local $SIG{__WARN__} = sub {
928 my $message = "Warning from authority record " . $r->id() . ": "
932 $output = $marc->as_usmarc;
935 warn("Error in authority record " . $r->id() . ": $@");
936 return $self->next();
945 # ------------------------------------------------------------------
946 # Since the ultimate output is largely independent of the type of the
947 # records, we use a single subpackage to group our output routines.
948 package Marque::Output;
951 my $extractor = shift;
952 if ($extractor->execute_query) {
953 if ($Marque::config->option_value('encoding') eq 'UTF-8') {
954 binmode(STDOUT, ':utf8');
956 binmode(STDOUT, ':raw');
960 while (my $output = $extractor->next()) {
965 print STDERR $extractor->{query} if ($Marque::config->option_value('debug'));
966 die "Database query failed!";
971 if ($Marque::config->option_value('format') eq 'XML') {
972 my $encoding = $Marque::config->option_value('encoding');
974 <?xml version="1.0" encoding="$encoding"?>
975 <collection xmlns='http://www.loc.gov/MARC21/slim'>
981 if ($Marque::config->option_value('format') eq 'XML') {
982 print "</collection>\n";