[sitka/sitka-tools.git] / marc_export_custom / marc_export_custom

#!/usr/bin/perl
# vim:et:sw=4:ts=4:
use strict;
use warnings;
use bytes;

use OpenSRF::System;
use OpenSRF::EX qw/:try/;
use OpenSRF::AppSession;
use OpenSRF::Utils::JSON;
use OpenSRF::Utils::SettingsClient;
use OpenILS::Application::AppUtils;
use OpenILS::Utils::Fieldmapper;
use OpenILS::Utils::CStoreEditor;

use MARC::Record;
use MARC::File::XML;
use UNIVERSAL::require;

use Time::HiRes qw/time/;
use Getopt::Long;

use Config::Simple;
use Data::Dumper;

my @formats = qw/USMARC UNIMARC XML BRE ARE/;

my ($config,$format,$encoding,$location,$dollarsign,$idl,$help,$holdings,$timeout,$export_mfhd,$type,$all_records) = ('/openils/conf/opensrf_core.xml','USMARC','MARC8','','$',0,undef,undef,0,undef,'biblio',undef);
my ($exclusion_ini,$collapse_to_depth);
my $cfg;
my $force901;

GetOptions(
        'help'       => \$help,
        'items'      => \$holdings,
        'mfhd'       => \$export_mfhd,
        'all'        => \$all_records,
        'location=s' => \$location,
        'money=s'    => \$dollarsign,
        'config=s'   => \$config,
        'format=s'   => \$format,
        'type=s'     => \$type,
        'xml-idl=s'  => \$idl,
        'encoding=s' => \$encoding,
        'timeout=i'  => \$timeout,
        'force901'  => \$force901,
        'exclusion_ini=s' => \$exclusion_ini,
        'collapse_to_depth=i' => \$collapse_to_depth,

);

$cfg = new Config::Simple($exclusion_ini) if ($exclusion_ini);

if ($help) {
print <<"HELP";
This script exports MARC authority, bibliographic, and serial holdings
records from an Evergreen database. 

Input to this script can consist of a list of record IDs, with one record ID
per line, corresponding to the record ID in the Evergreen database table of
your requested record type.

Alternately, passing the --all option will attempt to export all records of
the specified type from the Evergreen database. The --all option starts at
record ID 1 and increments the ID by 1 until the largest ID in the database
is retrieved. This may not be very efficient for databases with large gaps
in their ID sequences.

Usage: $0 [options]
 --help or -h       This screen.
 --config or -c     Configuration file [/openils/conf/opensrf_core.xml]
 --format or -f     Output format (USMARC, UNIMARC, XML, BRE, ARE) [USMARC]
 --encoding or -e   Output encoding (UTF-8, ISO-8859-?, MARC8) [MARC8]
 --xml-idl or -x    Location of the IDL XML
 --timeout          Timeout for exporting a single record; increase if you
                    are using --holdings and are exporting records that
                    have a lot of items attached to them.
 --type or -t       Record type (BIBLIO, AUTHORITY) [BIBLIO]
 --all or -a        Export all records; ignores input list

 Additional options for type = 'BIBLIO':
 --items or -i      Include items (holdings) in the output
 --money            Currency symbol to use in item price field [\$]
 --mfhd             Export serial MFHD records for associated bib records
                    Not compatible with --format=BRE
 --location or -l   MARC Location Code for holdings from
                    http://www.loc.gov/marc/organizations/orgshome.html

Examples:

To export a set of USMARC records in a file named "output_file" based on the
IDs contained in a file named "list_of_ids":
  cat list_of_ids | $0 > output_file

To export a set of MARC21XML authority records in a file named "output.xml"
for all authority records in the database:
  $0 --format XML --type AUTHORITY --all > output.xml

HELP
    exit;
}

$type = lc($type);
$format = uc($format);
$encoding = uc($encoding);

binmode(STDOUT, ':raw') if ($encoding ne 'UTF-8');
binmode(STDOUT, ':utf8') if ($encoding eq 'UTF-8');

if (!grep { $format eq $_ } @formats) {
    die "Please select a supported format.  ".
        "Right now that means one of [".
        join('|',@formats). "]\n";
}

if ($format ne 'XML') {
    my $type = 'MARC::File::' . $format;
    $type->require;
}

if ($timeout <= 0) {
    # set default timeout and/or correct silly user who 
    # supplied a negative timeout; default timeout of
    # 300 seconds if exporting items determined empirically.
    $timeout = $holdings ? 300 : 1;
}

OpenSRF::System->bootstrap_client( config_file => $config );

if (!$idl) {
    $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
}

Fieldmapper->import(IDL => $idl);

my $ses = OpenSRF::AppSession->create('open-ils.cstore');
OpenILS::Utils::CStoreEditor::init();
my $editor = OpenILS::Utils::CStoreEditor->new();

print <<HEADER if ($format eq 'XML');
<?xml version="1.0" encoding="$encoding"?>
<collection xmlns='http://www.loc.gov/MARC21/slim'>
HEADER

my %orgs;
my %shelves;
my %statuses;
my %outypes;

my $flesh = {};

if ($holdings) {
    get_bib_locations();
}

my $start = time;
my $last_time = time;
my %count = ('bib' => 0, 'did' => 0);
my $speed = 0;

if ($all_records) {
    my $top_record = 0;
    if ($type eq 'biblio') {
        $top_record = $editor->search_biblio_record_entry([
            {deleted => 'f'},
            {order_by => { 'bre' => 'id DESC' }, limit => 1}
        ])->[0]->id;
    } elsif ($type eq 'authority') {
        $top_record = $editor->search_authority_record_entry([
            {deleted => 'f'},
            {order_by => { 'are' => 'id DESC' }, limit => 1}
        ])->[0]->id;
    }
    for (my $i = 0; $i++ < $top_record;) {
        export_record($i);
    }
} else {
    while ( my $i = <> ) {
        export_record($i);
    }
}

print "</collection>\n" if ($format eq 'XML');

$speed = $count{did} / (time - $start);
my $time = time - $start;
print STDERR <<DONE;

Exports Attempted : $count{bib}
Exports Completed : $count{did}
Overall Speed     : $speed
Total Time Elapsed: $time seconds

DONE

sub export_record {
    my $id = shift;

    my $bib; 

    my $r = $ses->request( "open-ils.cstore.direct.$type.record_entry.retrieve", $id, $flesh );
    my $s = $r->recv(timeout => $timeout);
    if (!$s) {
        warn "\n!!!!! Failed trying to read record $id\n";
        return;
    }
    if ($r->failed) {
        warn "\n!!!!!! Failed trying to read record $id: " . $r->failed->stringify . "\n";
        return;
    }
    if ($r->timed_out) {
        warn "\n!!!!!! Timed out trying to read record $id\n";
        return;
    }
    $bib = $s->content;
    $r->finish;

    $count{bib}++;
    return unless $bib;

    if ($format eq 'ARE' or $format eq 'BRE') {
        print OpenSRF::Utils::JSON->perl2JSON($bib);
        stats();
        $count{did}++;
        return;
    }

    try {

        my $r = MARC::Record->new_from_xml( $bib->marc, $encoding, $format );
        if ($type eq 'biblio') {
            add_bib_holdings($bib, $r);
        }

        if ($format eq 'XML') {
            my $xml = $r->as_xml_record;
            $xml =~ s/^<\?.+?\?>$//mo;
            print $xml;
        } elsif ($format eq 'UNIMARC') {
            print $r->as_usmarc;
        } elsif ($format eq 'USMARC') {
            print $r->as_usmarc;
        }

        $count{did}++;

    } otherwise {
        my $e = shift;
        warn "\n$e\n";
        import MARC::File::XML; # reset SAX parser so that one bad record doesn't kill the entire export
    };

    if ($export_mfhd and $type eq 'biblio') {
        my $mfhds = $editor->search_serial_record_entry({record => $id, deleted => 'f'});
        foreach my $mfhd (@$mfhds) {
            try {
                my $r = MARC::Record->new_from_xml( $mfhd->marc, $encoding, $format );

                if ($format eq 'XML') {
                    my $xml = $r->as_xml_record;
                    $xml =~ s/^<\?.+?\?>$//mo;
                    print $xml;
                } elsif ($format eq 'UNIMARC') {
                    print $r->as_usmarc;
                } elsif ($format eq 'USMARC') {
                    print $r->as_usmarc;
                }
            } otherwise {
                my $e = shift;
                warn "\n$e\n";
                import MARC::File::XML; # reset SAX parser so that one bad record doesn't kill the entire export
            };
        }
    }

    stats() if (! ($count{bib} % 50 ));
}

sub stats {
    try {
        no warnings;

        $speed = $count{did} / (time - $start);

        my $speed_now = ($count{did} - $count{did_last}) / (time - $count{time_last});
        my $cn_speed = $count{cn} / (time - $start);
        my $cp_speed = $count{cp} / (time - $start);

        printf STDERR "\r  $count{did} of $count{bib} @  \%0.4f/s ttl / \%0.4f/s rt ".
                "($count{cn} CNs @ \%0.4f/s :: $count{cp} CPs @ \%0.4f/s)\r",
                $speed,
                $speed_now,
                $cn_speed,
                $cp_speed;
    } otherwise {};
    $count{did_last} = $count{did};
    $count{time_last} = time;
}

sub get_bib_locations {
    print STDERR "Retrieving Org Units ... ";
    my $r = $ses->request( 'open-ils.cstore.direct.actor.org_unit.search', { id => { '!=' => undef } } );

    while (my $o = $r->recv) {
        die $r->failed->stringify if ($r->failed);
        $o = $o->content;
        last unless ($o);
        $orgs{$o->id} = $o;
    }
    $r->finish;
    print STDERR "OK\n";

    print STDERR "Retrieving Copy statuses ... ";
    $r = $ses->request( 'open-ils.cstore.direct.config.copy_status.search', { id => { '!=' => undef } } );

    while (my $sta = $r->recv) {
        die $r->failed->stringify if ($r->failed);
        $sta = $sta->content;
        last unless ($sta);
        $statuses{$sta->id} = $sta;
    }
    $r->finish;
    print STDERR "OK\n";

    print STDERR "Retrieving OU types ... ";
    $r = $ses->request( 'open-ils.cstore.direct.actor.org_unit_type.search', { id => { '!=' => undef } } );

    while (my $outy = $r->recv) {
        die $r->failed->stringify if ($r->failed);
        $outy = $outy->content;
        last unless ($outy);
        $outypes{$outy->id} = $outy;
    }
    $r->finish;
    print STDERR "OK\n";

    print STDERR "Retrieving Shelving locations ... ";
    $r = $ses->request( 'open-ils.cstore.direct.asset.copy_location.search', { id => { '!=' => undef } } );

    while (my $s = $r->recv) {
        die $r->failed->stringify if ($r->failed);
        $s = $s->content;
        last unless ($s);
        $shelves{$s->id} = $s;
    }
    $r->finish;
    print STDERR "OK\n";

    $flesh = { flesh => 2, flesh_fields => { bre => [ 'call_numbers' ], acn => [ 'copies' ] } };
}

sub add_bib_holdings {
    my $bib = shift;
    my $r = shift;

    my $cn_list = $bib->call_numbers;
    if ($cn_list && @$cn_list) {

        $count{cn} += @$cn_list;
    
        my $cp_list = [ map { @{ $_->copies } } @$cn_list ];
        if ($cp_list && @$cp_list) {

            my %cn_map;
            push @{$cn_map{$_->call_number}}, $_ for (@$cp_list);
                            
            for my $cn ( @$cn_list ) {
                my $cn_map_list = $cn_map{$cn->id};

                COPYMAP: for my $cp ( @$cn_map_list ) {
                    $count{cp}++;


                    my $owninglib = $cn->owning_lib;
                    my $circlib = $cp->circ_lib;
                    my $printlib = $cp->circ_lib;

                    if($cfg){
                        my $thisorg = $orgs{$circlib};

                        if($collapse_to_depth){
                            while ( $outypes{ $thisorg->ou_type }->depth > $collapse_to_depth ){
                                my $localcfg = $cfg->param(-block=> $thisorg->shortname);
                                if( $localcfg->{'DontCollapse'} ){
                                    last;
                                }
                                if($thisorg->parent_ou){
                                    $thisorg = $orgs{$thisorg->parent_ou};
                                    $printlib = $thisorg->id;
                                }
                            }
                        }

                        $thisorg = $orgs{$circlib};


                        while( $thisorg ){
                            # load the local config from the .ini file for exclusions
                            my $localcfg = $cfg->param(-block=> $thisorg->shortname);

                            # if we see this setting, just skip that org

                            next COPYMAP if( $localcfg->{'ExcludeEntireOrg'} );

                            # what follows are exclusion rules
                    
                            # Excluded Flags
                            if($localcfg->{'Flags'}){
                                # this little line is just forcing scalars into an array so we can 'use strict' with Config::Simple
                                my @flags = ( (ref($localcfg->{'Flags'}) eq "ARRAY") ? @{$localcfg->{'Flags'}} : ($localcfg->{'Flags'}));
                                next COPYMAP if( grep { $_ eq 'reference' } @flags && $cp->ref eq 't');
                                next COPYMAP if( grep { $_ eq 'unholdable' } @flags && $cp->holdable eq 'f');
                                next COPYMAP if( grep { $_ eq 'circulate' } @flags && $cp->circulate eq 'f');
                                next COPYMAP if( grep { $_ eq 'hidden' } @flags && $cp->opac_visible eq 'f');
                            }
                            # Excluded Circ Modifiers
                            if($localcfg->{'CircMods'}){
                                my $circmod = $cp->circ_modifier || "";
                                my @circmods = ( (ref($localcfg->{'CircMods'}) eq "ARRAY") ? @{$localcfg->{'CircMods'}} : ($localcfg->{'CircMods'}) );
                                next COPYMAP if( grep { $_ eq $circmod } @circmods && @circmods);
                            }
                            # Inverse rule -- only include specified Circ Mods
                            if($localcfg->{'OnlyIncludeCircMods'}){
                                my $circmod = $cp->circ_modifier || "";
                                my @circmods = ( (ref($localcfg->{'CircMods'}) eq "ARRAY") ? @{$localcfg->{'CircMods'}} : ($localcfg->{'CircMods'}) );
                                next COPYMAP unless( grep { $_ eq $circmod } @circmods && @circmods);
                            }
                            # Excluded Copy Statuses
                            if($localcfg->{'Statuses'}){
                                my @statuses = ( (ref($localcfg->{'Statuses'}) eq "ARRAY") ? @{$localcfg->{'Statuses'}} : ($localcfg->{'Statuses'}) );
                                next COPYMAP if( grep { $_ eq $statuses{$cp->status}->name } @statuses && @statuses);
                            }
                            # Excluded Locations
                            if($localcfg->{'Locations'}){
                                my @locations = ( (ref($localcfg->{'Locations'}) eq "ARRAY") ? @{$localcfg->{'Locations'}} : ($localcfg->{'Locations'}) );
                                next COPYMAP if( grep { $_ eq $shelves{$cp->location}->name } @locations && @locations);
                            }
                            # Inverse rule - Only use the specified locations
                            if($localcfg->{'OnlyIncludeLocations'}){
                                my @locations = ( (ref($localcfg->{'OnlyIncludeLocations'}) eq "ARRAY") ? @{$localcfg->{'OnlyIncludeLocations'}} : ($localcfg->{'Locations'}) );
                                next COPYMAP unless( grep { $_ eq $shelves{$cp->location}->name } @locations && @locations);
                            }
                            # exclude based on a regex match to location names
                            if($localcfg->{'LocationRegex'}){
                                my @locregex = ( (ref($localcfg->{'LocationRegex'}) eq "ARRAY") ? @{$localcfg->{'LocationRegex'}} : ($localcfg->{'LocationRegex'}) );
                                my $reg = $localcfg->{'LocationRegex'};
                                next COPYMAP if( grep { $shelves{$cp->location}->name =~ m/($reg)/ } @locregex && @locregex);
                            }
                            # include based on a regex match to location names
                            if($localcfg->{'OnlyIncludeLocationRegex'}){
                                my @locregex = ( (ref($localcfg->{'OnlyIncludeLocationRegex'}) eq "ARRAY") ? @{$localcfg->{'OnlyIncludeLocationRegex'}} : ($localcfg->{'OnlyIncludeLocationRegex'}) );
                                my $reg = $localcfg->{'OnlyIncludeLocationRegex'};
                                next COPYMAP unless( grep { $shelves{$cp->location}->name =~ m/($reg)/ } @locregex && @locregex);
                            }
                            # Exclude based on a callno regex
                            if($localcfg->{'CallNoRegex'}){
                                my @callnoregex = ( (ref($localcfg->{'CallNoRegex'}) eq "ARRAY") ? @{$localcfg->{'CallNoRegex'}} : ($localcfg->{'CallNoRegex'}) );
                                my $reg = $localcfg->{'CallNoRegex'};
                                next COPYMAP if( grep { $cn->label =~ m/($reg)/ } @callnoregex && @callnoregex);
                            }
                            # Include based on a callno regex
                            if($localcfg->{'OnlyIncludeCallNoRegex'}){
                                my @callnoregex = ( (ref($localcfg->{'OnlyIncludeCallNoRegex'}) eq "ARRAY") ? @{$localcfg->{'OnlyIncludeCallNoRegex'}} : ($localcfg->{'OnlyIncludeCallNoRegex'}) );
                                my $reg = $localcfg->{'OnlyIncludeCallNoRegex'};
                                next COPYMAP unless( grep { $cn->label =~ m/($reg)/ } @callnoregex && @callnoregex);
                            }

                            # Trim call number to a float and exclude based on Dewey Range
                            if($localcfg->{'DeweyGT'} || $localcfg->{'DeweyLT'}){
                                my $gt = $localcfg->{'DeweyGT'};
                                my $lt = $localcfg->{'DeweyLT'};

                                # FIXME if either config has an array just ditch for now
                                next COPYMAP if (ref($gt) eq "ARRAY" or ref($lt) eq "ARRAY");
                                $gt =~ s/[^0-9\.]//g if $gt; #trim off anything not deweyish
                                $lt =~ s/[^0-9\.]//g if $lt; #trim off anything not deweyish

                                my $callno = $cn->label;
                                $callno =~ s/[^0-9\.]//g; #trim off anything not deweyish
                                print STDERR $callno;
                                #note that we are making big assumptions about the call numbers in the db 

                                # we have a range, exclude what's inbetween
                                if($lt && $gt){
                                    next COPYMAP if $callno > $gt and $callno < $lt;
                                # we only have a top threshold, exclude everything below it
                                } elsif ($lt){
                                    next COPYMAP if $callno < $lt;
                                # we only have a bottom threshold, exclude everything above it
                                } elsif ($gt){
                                    next COPYMAP if $callno > $gt;
                                }
                            }

                            if($thisorg->parent_ou){
                                 $thisorg = $orgs{$thisorg->parent_ou}
                            } else {
                                $thisorg = ();
                            }
                            
                        }
                    }

                    $r->append_fields(
                        MARC::Field->new(
                            852, '4', '', 
                            a => $location,
                            b => $orgs{$printlib}->shortname,
                            #b => $orgs{$owninglib}->shortname,
                            #b => $orgs{$circlib}->shortname,
                            c => $shelves{$cp->location}->name,
                            j => $cn->label,
                            ($cp->circ_modifier ? ( g => $cp->circ_modifier ) : ()),
                            p => $cp->barcode,
                            ($cp->price ? ( y => $dollarsign.$cp->price ) : ()),
                            ($cp->copy_number ? ( t => $cp->copy_number ) : ()),
                            ($cp->ref eq 't' ? ( x => 'reference' ) : ()),
                            ($cp->holdable eq 'f' ? ( x => 'unholdable' ) : ()),
                            ($cp->circulate eq 'f' ? ( x => 'noncirculating' ) : ()),
                            ($cp->opac_visible eq 'f' ? ( x => 'hidden' ) : ()),
                            z => $statuses{$cp->status}->name,
                        )
                    );

                    if($force901){
                        $r->delete_field( $r->field('901') );
                        $r->append_fields(
                            MARC::Field->new(
                                '901', ' ', ' ',
                                a => $bib->tcn_value,
                                b => $bib->tcn_source,
                                c => $bib->id
                            )
                        );

                    }

                    stats() if (! ($count{cp} % 100 ));
                } # for cnmap
            } # for cnlist
        } # if block
    } # if block
} # sub
Commit	Line	Data
456d236e JF	1	#!/usr/bin/perl
	2	# vim:et:sw=4:ts=4:
	3	use strict;
	4	use warnings;
	5	use bytes;
	6
	7	use OpenSRF::System;
	8	use OpenSRF::EX qw/:try/;
	9	use OpenSRF::AppSession;
	10	use OpenSRF::Utils::JSON;
	11	use OpenSRF::Utils::SettingsClient;
	12	use OpenILS::Application::AppUtils;
	13	use OpenILS::Utils::Fieldmapper;
	14	use OpenILS::Utils::CStoreEditor;
	15
	16	use MARC::Record;
	17	use MARC::File::XML;
	18	use UNIVERSAL::require;
	19
	20	use Time::HiRes qw/time/;
	21	use Getopt::Long;
	22
	23	use Config::Simple;
	24	use Data::Dumper;
	25
	26	my @formats = qw/USMARC UNIMARC XML BRE ARE/;
	27
	28	my ($config,$format,$encoding,$location,$dollarsign,$idl,$help,$holdings,$timeout,$export_mfhd,$type,$all_records) = ('/openils/conf/opensrf_core.xml','USMARC','MARC8','','$',0,undef,undef,0,undef,'biblio',undef);
	29	my ($exclusion_ini,$collapse_to_depth);
	30	my $cfg;
5eb3fcb8	31	my $force901;
456d236e JF	32
	33	GetOptions(
	34	'help' => \$help,
	35	'items' => \$holdings,
	36	'mfhd' => \$export_mfhd,
	37	'all' => \$all_records,
	38	'location=s' => \$location,
	39	'money=s' => \$dollarsign,
	40	'config=s' => \$config,
	41	'format=s' => \$format,
	42	'type=s' => \$type,
	43	'xml-idl=s' => \$idl,
	44	'encoding=s' => \$encoding,
	45	'timeout=i' => \$timeout,
5eb3fcb8	46	'force901' => \$force901,
456d236e JF	47	'exclusion_ini=s' => \$exclusion_ini,
	48	'collapse_to_depth=i' => \$collapse_to_depth,
	49
	50	);
	51
	52	$cfg = new Config::Simple($exclusion_ini) if ($exclusion_ini);
	53
	54	if ($help) {
	55	print <<"HELP";
	56	This script exports MARC authority, bibliographic, and serial holdings
	57	records from an Evergreen database.
	58
	59	Input to this script can consist of a list of record IDs, with one record ID
	60	per line, corresponding to the record ID in the Evergreen database table of
	61	your requested record type.
	62
	63	Alternately, passing the --all option will attempt to export all records of
	64	the specified type from the Evergreen database. The --all option starts at
	65	record ID 1 and increments the ID by 1 until the largest ID in the database
	66	is retrieved. This may not be very efficient for databases with large gaps
	67	in their ID sequences.
	68
	69	Usage: $0 [options]
	70	--help or -h This screen.
	71	--config or -c Configuration file [/openils/conf/opensrf_core.xml]
	72	--format or -f Output format (USMARC, UNIMARC, XML, BRE, ARE) [USMARC]
	73	--encoding or -e Output encoding (UTF-8, ISO-8859-?, MARC8) [MARC8]
	74	--xml-idl or -x Location of the IDL XML
	75	--timeout Timeout for exporting a single record; increase if you
	76	are using --holdings and are exporting records that
	77	have a lot of items attached to them.
	78	--type or -t Record type (BIBLIO, AUTHORITY) [BIBLIO]
	79	--all or -a Export all records; ignores input list
	80
	81	Additional options for type = 'BIBLIO':
	82	--items or -i Include items (holdings) in the output
	83	--money Currency symbol to use in item price field [\$]
	84	--mfhd Export serial MFHD records for associated bib records
	85	Not compatible with --format=BRE
	86	--location or -l MARC Location Code for holdings from
	87	http://www.loc.gov/marc/organizations/orgshome.html
	88
	89	Examples:
	90
	91	To export a set of USMARC records in a file named "output_file" based on the
	92	IDs contained in a file named "list_of_ids":
	93	cat list_of_ids \| $0 > output_file
	94
	95	To export a set of MARC21XML authority records in a file named "output.xml"
	96	for all authority records in the database:
	97	$0 --format XML --type AUTHORITY --all > output.xml
	98
	99	HELP
	100	exit;
	101	}
	102
	103	$type = lc($type);
	104	$format = uc($format);
	105	$encoding = uc($encoding);
	106
	107	binmode(STDOUT, ':raw') if ($encoding ne 'UTF-8');
	108	binmode(STDOUT, ':utf8') if ($encoding eq 'UTF-8');
	109
	110	if (!grep { $format eq $_ } @formats) {
111	die "Please select a supported format. ".
112	"Right now that means one of [".
113	join('\|',@formats). "]\n";
114	}
115
116	if ($format ne 'XML') {
117	my $type = 'MARC::File::' . $format;
118	$type->require;
119	}
120
121	if ($timeout <= 0) {
122	# set default timeout and/or correct silly user who
123	# supplied a negative timeout; default timeout of
124	# 300 seconds if exporting items determined empirically.
125	$timeout = $holdings ? 300 : 1;
126	}
127
128	OpenSRF::System->bootstrap_client( config_file => $config );
129
130	if (!$idl) {
131	$idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
132	}
133
134	Fieldmapper->import(IDL => $idl);
135
136	my $ses = OpenSRF::AppSession->create('open-ils.cstore');
137	OpenILS::Utils::CStoreEditor::init();
138	my $editor = OpenILS::Utils::CStoreEditor->new();
139
140	print <<HEADER if ($format eq 'XML');
141	<?xml version="1.0" encoding="$encoding"?>
142	<collection xmlns='http://www.loc.gov/MARC21/slim'>
143	HEADER
144
145	my %orgs;
146	my %shelves;
147	my %statuses;
148	my %outypes;
149
150	my $flesh = {};
151
152	if ($holdings) {
153	get_bib_locations();
154	}
155
156	my $start = time;
157	my $last_time = time;
158	my %count = ('bib' => 0, 'did' => 0);
159	my $speed = 0;
160
161	if ($all_records) {
162	my $top_record = 0;
163	if ($type eq 'biblio') {
164	$top_record = $editor->search_biblio_record_entry([
165	{deleted => 'f'},
166	{order_by => { 'bre' => 'id DESC' }, limit => 1}
167	])->[0]->id;
168	} elsif ($type eq 'authority') {
169	$top_record = $editor->search_authority_record_entry([
170	{deleted => 'f'},
171	{order_by => { 'are' => 'id DESC' }, limit => 1}
172	])->[0]->id;
173	}
174	for (my $i = 0; $i++ < $top_record;) {
175	export_record($i);
176	}
177	} else {
178	while ( my $i = <> ) {
179	export_record($i);
180	}
181	}
182
183	print "</collection>\n" if ($format eq 'XML');
184
185	$speed = $count{did} / (time - $start);
186	my $time = time - $start;
187	print STDERR <<DONE;
188
189	Exports Attempted : $count{bib}
190	Exports Completed : $count{did}
191	Overall Speed : $speed
192	Total Time Elapsed: $time seconds
193
194	DONE
195
196	sub export_record {
197	my $id = shift;
198
199	my $bib;
200
201	my $r = $ses->request( "open-ils.cstore.direct.$type.record_entry.retrieve", $id, $flesh );
202	my $s = $r->recv(timeout => $timeout);
203	if (!$s) {
204	warn "\n!!!!! Failed trying to read record $id\n";
205	return;
206	}
207	if ($r->failed) {
208	warn "\n!!!!!! Failed trying to read record $id: " . $r->failed->stringify . "\n";
209	return;
210	}
211	if ($r->timed_out) {
212	warn "\n!!!!!! Timed out trying to read record $id\n";
213	return;
214	}
215	$bib = $s->content;
216	$r->finish;
217
218	$count{bib}++;
219	return unless $bib;
220
221	if ($format eq 'ARE' or $format eq 'BRE') {
222	print OpenSRF::Utils::JSON->perl2JSON($bib);
223	stats();
224	$count{did}++;
225	return;
226	}
227
228	try {
229
230	my $r = MARC::Record->new_from_xml( $bib->marc, $encoding, $format );
231	if ($type eq 'biblio') {
232	add_bib_holdings($bib, $r);
233	}
234
235	if ($format eq 'XML') {
236	my $xml = $r->as_xml_record;
237	$xml =~ s/^<\?.+?\?>$//mo;
238	print $xml;
239	} elsif ($format eq 'UNIMARC') {
240	print $r->as_usmarc;
241	} elsif ($format eq 'USMARC') {
242	print $r->as_usmarc;
243	}
244
245	$count{did}++;
246
247	} otherwise {
248	my $e = shift;
249	warn "\n$e\n";
250	import MARC::File::XML; # reset SAX parser so that one bad record doesn't kill the entire export
251	};
252
253	if ($export_mfhd and $type eq 'biblio') {
254	my $mfhds = $editor->search_serial_record_entry({record => $id, deleted => 'f'});
255	foreach my $mfhd (@$mfhds) {
256	try {
257	my $r = MARC::Record->new_from_xml( $mfhd->marc, $encoding, $format );
258
259	if ($format eq 'XML') {
260	my $xml = $r->as_xml_record;
261	$xml =~ s/^<\?.+?\?>$//mo;
262	print $xml;
263	} elsif ($format eq 'UNIMARC') {
264	print $r->as_usmarc;
265	} elsif ($format eq 'USMARC') {
266	print $r->as_usmarc;
267	}
268	} otherwise {
269	my $e = shift;
270	warn "\n$e\n";
271	import MARC::File::XML; # reset SAX parser so that one bad record doesn't kill the entire export
272	};
273	}
274	}
275
276	stats() if (! ($count{bib} % 50 ));
277	}
278
279	sub stats {
280	try {
281	no warnings;
282
283	$speed = $count{did} / (time - $start);
284
285	my $speed_now = ($count{did} - $count{did_last}) / (time - $count{time_last});
286	my $cn_speed = $count{cn} / (time - $start);
287	my $cp_speed = $count{cp} / (time - $start);
288
289	printf STDERR "\r $count{did} of $count{bib} @ \%0.4f/s ttl / \%0.4f/s rt ".
290	"($count{cn} CNs @ \%0.4f/s :: $count{cp} CPs @ \%0.4f/s)\r",
291	$speed,
292	$speed_now,
293	$cn_speed,
294	$cp_speed;
295	} otherwise {};
296	$count{did_last} = $count{did};
297	$count{time_last} = time;
298	}
299
300	sub get_bib_locations {
301	print STDERR "Retrieving Org Units ... ";
302	my $r = $ses->request( 'open-ils.cstore.direct.actor.org_unit.search', { id => { '!=' => undef } } );
303
304	while (my $o = $r->recv) {
305	die $r->failed->stringify if ($r->failed);
306	$o = $o->content;
307	last unless ($o);
308	$orgs{$o->id} = $o;
309	}
310	$r->finish;
311	print STDERR "OK\n";
312
313	print STDERR "Retrieving Copy statuses ... ";
314	$r = $ses->request( 'open-ils.cstore.direct.config.copy_status.search', { id => { '!=' => undef } } );
315
316	while (my $sta = $r->recv) {
317	die $r->failed->stringify if ($r->failed);
318	$sta = $sta->content;
319	last unless ($sta);
320	$statuses{$sta->id} = $sta;
321	}
322	$r->finish;
323	print STDERR "OK\n";
324
325	print STDERR "Retrieving OU types ... ";
326	$r = $ses->request( 'open-ils.cstore.direct.actor.org_unit_type.search', { id => { '!=' => undef } } );
327
328	while (my $outy = $r->recv) {
329	die $r->failed->stringify if ($r->failed);
330	$outy = $outy->content;
331	last unless ($outy);
332	$outypes{$outy->id} = $outy;
333	}
334	$r->finish;
335	print STDERR "OK\n";
336
337	print STDERR "Retrieving Shelving locations ... ";
338	$r = $ses->request( 'open-ils.cstore.direct.asset.copy_location.search', { id => { '!=' => undef } } );
339
340	while (my $s = $r->recv) {
341	die $r->failed->stringify if ($r->failed);
342	$s = $s->content;
343	last unless ($s);
344	$shelves{$s->id} = $s;
345	}
346	$r->finish;
347	print STDERR "OK\n";
348
349	$flesh = { flesh => 2, flesh_fields => { bre => [ 'call_numbers' ], acn => [ 'copies' ] } };
350	}
351
352	sub add_bib_holdings {
353	my $bib = shift;
354	my $r = shift;
355
356	my $cn_list = $bib->call_numbers;
357	if ($cn_list && @$cn_list) {
358
359	$count{cn} += @$cn_list;
360
361	my $cp_list = [ map { @{ $_->copies } } @$cn_list ];
362	if ($cp_list && @$cp_list) {
363
364	my %cn_map;
365	push @{$cn_map{$_->call_number}}, $_ for (@$cp_list);
366
367	for my $cn ( @$cn_list ) {
368	my $cn_map_list = $cn_map{$cn->id};
369
370	COPYMAP: for my $cp ( @$cn_map_list ) {
371	$count{cp}++;
372
373
374	my $owninglib = $cn->owning_lib;
375	my $circlib = $cp->circ_lib;
376	my $printlib = $cp->circ_lib;
377
378	if($cfg){
379	my $thisorg = $orgs{$circlib};
380
381	if($collapse_to_depth){
382	while ( $outypes{ $thisorg->ou_type }->depth > $collapse_to_depth ){
383	my $localcfg = $cfg->param(-block=> $thisorg->shortname);
384	if( $localcfg->{'DontCollapse'} ){
385	last;
386	}
387	if($thisorg->parent_ou){
388	$thisorg = $orgs{$thisorg->parent_ou};
389	$printlib = $thisorg->id;
390	}
391	}
392	}
393
394	$thisorg = $orgs{$circlib};
395
806177d6	396
456d236e	397	while( $thisorg ){
456d236e JF	398	# load the local config from the .ini file for exclusions
	399	my $localcfg = $cfg->param(-block=> $thisorg->shortname);
	400
	401	# if we see this setting, just skip that org
	402
	403	next COPYMAP if( $localcfg->{'ExcludeEntireOrg'} );
	404
	405	# what follows are exclusion rules
806177d6	406
456d236e JF	407	# Excluded Flags
	408	if($localcfg->{'Flags'}){
	409	# this little line is just forcing scalars into an array so we can 'use strict' with Config::Simple
	410	my @flags = ( (ref($localcfg->{'Flags'}) eq "ARRAY") ? @{$localcfg->{'Flags'}} : ($localcfg->{'Flags'}));
	411	next COPYMAP if( grep { $_ eq 'reference' } @flags && $cp->ref eq 't');
	412	next COPYMAP if( grep { $_ eq 'unholdable' } @flags && $cp->holdable eq 'f');
	413	next COPYMAP if( grep { $_ eq 'circulate' } @flags && $cp->circulate eq 'f');
	414	next COPYMAP if( grep { $_ eq 'hidden' } @flags && $cp->opac_visible eq 'f');
	415	}
	416	# Excluded Circ Modifiers
	417	if($localcfg->{'CircMods'}){
806177d6	418	my $circmod = $cp->circ_modifier \|\| "";
456d236e	419	my @circmods = ( (ref($localcfg->{'CircMods'}) eq "ARRAY") ? @{$localcfg->{'CircMods'}} : ($localcfg->{'CircMods'}) );
806177d6	420	next COPYMAP if( grep { $_ eq $circmod } @circmods && @circmods);
456d236e	421	}
3add9381 JF	422	# Inverse rule -- only include specified Circ Mods
3add9381 JF	423	if($localcfg->{'OnlyIncludeCircMods'}){
806177d6	424	my $circmod = $cp->circ_modifier \|\| "";
3add9381	425	my @circmods = ( (ref($localcfg->{'CircMods'}) eq "ARRAY") ? @{$localcfg->{'CircMods'}} : ($localcfg->{'CircMods'}) );
806177d6	426	next COPYMAP unless( grep { $_ eq $circmod } @circmods && @circmods);
3add9381	427	}
456d236e JF	428	# Excluded Copy Statuses
	429	if($localcfg->{'Statuses'}){
	430	my @statuses = ( (ref($localcfg->{'Statuses'}) eq "ARRAY") ? @{$localcfg->{'Statuses'}} : ($localcfg->{'Statuses'}) );
	431	next COPYMAP if( grep { $_ eq $statuses{$cp->status}->name } @statuses && @statuses);
	432	}
	433	# Excluded Locations
	434	if($localcfg->{'Locations'}){
	435	my @locations = ( (ref($localcfg->{'Locations'}) eq "ARRAY") ? @{$localcfg->{'Locations'}} : ($localcfg->{'Locations'}) );
	436	next COPYMAP if( grep { $_ eq $shelves{$cp->location}->name } @locations && @locations);
	437	}
	438	# Inverse rule - Only use the specified locations
	439	if($localcfg->{'OnlyIncludeLocations'}){
	440	my @locations = ( (ref($localcfg->{'OnlyIncludeLocations'}) eq "ARRAY") ? @{$localcfg->{'OnlyIncludeLocations'}} : ($localcfg->{'Locations'}) );
	441	next COPYMAP unless( grep { $_ eq $shelves{$cp->location}->name } @locations && @locations);
	442	}
	443	# exclude based on a regex match to location names
	444	if($localcfg->{'LocationRegex'}){
	445	my @locregex = ( (ref($localcfg->{'LocationRegex'}) eq "ARRAY") ? @{$localcfg->{'LocationRegex'}} : ($localcfg->{'LocationRegex'}) );
	446	my $reg = $localcfg->{'LocationRegex'};
	447	next COPYMAP if( grep { $shelves{$cp->location}->name =~ m/($reg)/ } @locregex && @locregex);
	448	}
	449	# include based on a regex match to location names
	450	if($localcfg->{'OnlyIncludeLocationRegex'}){
	451	my @locregex = ( (ref($localcfg->{'OnlyIncludeLocationRegex'}) eq "ARRAY") ? @{$localcfg->{'OnlyIncludeLocationRegex'}} : ($localcfg->{'OnlyIncludeLocationRegex'}) );
	452	my $reg = $localcfg->{'OnlyIncludeLocationRegex'};
	453	next COPYMAP unless( grep { $shelves{$cp->location}->name =~ m/($reg)/ } @locregex && @locregex);
	454	}
	455	# Exclude based on a callno regex
	456	if($localcfg->{'CallNoRegex'}){
	457	my @callnoregex = ( (ref($localcfg->{'CallNoRegex'}) eq "ARRAY") ? @{$localcfg->{'CallNoRegex'}} : ($localcfg->{'CallNoRegex'}) );
	458	my $reg = $localcfg->{'CallNoRegex'};
	459	next COPYMAP if( grep { $cn->label =~ m/($reg)/ } @callnoregex && @callnoregex);
	460	}
	461	# Include based on a callno regex
	462	if($localcfg->{'OnlyIncludeCallNoRegex'}){
	463	my @callnoregex = ( (ref($localcfg->{'OnlyIncludeCallNoRegex'}) eq "ARRAY") ? @{$localcfg->{'OnlyIncludeCallNoRegex'}} : ($localcfg->{'OnlyIncludeCallNoRegex'}) );
	464	my $reg = $localcfg->{'OnlyIncludeCallNoRegex'};
	465	next COPYMAP unless( grep { $cn->label =~ m/($reg)/ } @callnoregex && @callnoregex);
	466	}
806177d6	467
456d236e JF	468	# Trim call number to a float and exclude based on Dewey Range
	469	if($localcfg->{'DeweyGT'} \|\| $localcfg->{'DeweyLT'}){
	470	my $gt = $localcfg->{'DeweyGT'};
	471	my $lt = $localcfg->{'DeweyLT'};
	472
	473	# FIXME if either config has an array just ditch for now
	474	next COPYMAP if (ref($gt) eq "ARRAY" or ref($lt) eq "ARRAY");
	475	$gt =~ s/[^0-9\.]//g if $gt; #trim off anything not deweyish
	476	$lt =~ s/[^0-9\.]//g if $lt; #trim off anything not deweyish
	477
	478	my $callno = $cn->label;
	479	$callno =~ s/[^0-9\.]//g; #trim off anything not deweyish
	480	print STDERR $callno;
	481	#note that we are making big assumptions about the call numbers in the db
	482
	483	# we have a range, exclude what's inbetween
	484	if($lt && $gt){
	485	next COPYMAP if $callno > $gt and $callno < $lt;
	486	# we only have a top threshold, exclude everything below it
	487	} elsif ($lt){
	488	next COPYMAP if $callno < $lt;
	489	# we only have a bottom threshold, exclude everything above it
	490	} elsif ($gt){
	491	next COPYMAP if $callno > $gt;
	492	}
	493	}
	494
456d236e JF	495	if($thisorg->parent_ou){
	496	$thisorg = $orgs{$thisorg->parent_ou}
	497	} else {
	498	$thisorg = ();
	499	}
	500
	501	}
	502	}
	503
	504	$r->append_fields(
	505	MARC::Field->new(
	506	852, '4', '',
	507	a => $location,
	508	b => $orgs{$printlib}->shortname,
	509	#b => $orgs{$owninglib}->shortname,
	510	#b => $orgs{$circlib}->shortname,
	511	c => $shelves{$cp->location}->name,
	512	j => $cn->label,
	513	($cp->circ_modifier ? ( g => $cp->circ_modifier ) : ()),
	514	p => $cp->barcode,
	515	($cp->price ? ( y => $dollarsign.$cp->price ) : ()),
	516	($cp->copy_number ? ( t => $cp->copy_number ) : ()),
	517	($cp->ref eq 't' ? ( x => 'reference' ) : ()),
	518	($cp->holdable eq 'f' ? ( x => 'unholdable' ) : ()),
	519	($cp->circulate eq 'f' ? ( x => 'noncirculating' ) : ()),
	520	($cp->opac_visible eq 'f' ? ( x => 'hidden' ) : ()),
	521	z => $statuses{$cp->status}->name,
	522	)
	523	);
	524
5eb3fcb8 JF	525	if($force901){
	526	$r->delete_field( $r->field('901') );
	527	$r->append_fields(
	528	MARC::Field->new(
	529	'901', ' ', ' ',
	530	a => $bib->tcn_value,
	531	b => $bib->tcn_source,
	532	c => $bib->id
	533	)
	534	);
	535
	536	}
	537
456d236e JF	538	stats() if (! ($count{cp} % 100 ));
	539	} # for cnmap
	540	} # for cnlist
	541	} # if block
	542	} # if block
	543	} # sub