netlib01.pl

#!/usr/local/bin/perl -w

###############################################
#
#  Perl script: netlib01.pl
#  
#  A Perl/MARC.pm script to preprocess
#  a file of netLibrary records.
#
#  2001, Michael Doran, doran@uta.edu
#
#  Adapted from a script in a VUGM 2001
#  session handout by David Bennett.
#
#  Notice: Quick hack; use at your own risk.
#  No warranties, etc., etc.
#
###############################################

use MARC;

if (! ($#ARGV == 1)) {
    print "Usage: $0 input_file output_file\n";
    exit(1);
}

$infile = shift;
$outfile = shift;

if ( ! -f $infile ) {
    print "$0: can't find $infile...exiting\n";
    exit(1);
}  

if ( -f $outfile ) {
    print "$0: $outfile already exists...exiting\n";
    exit(1);
}

my $ezproxy_url = 'http://continuum.uta.edu:2048/login?url=';
my $blurb       = 'In netLibrary Collection <img
 src="http://pulse.uta.edu/images/offcampPulse.gif" border="0"
 width="115" height="17" />';

$x = new MARC;
$x->openmarc({file=>"$infile",'format'=>"usmarc"});
while ($x->nextmarc(1)) {

    my $call_number = "Web Access";
    $x->addfield({record=>'1',field=>'099',value=>[a=>"$call_number"]});

    my $field_856   = {record=>1,field=>856,rebuild_map=>1};
    my @data_856    = $x->getfields($field_856);
    foreach my $entry (@data_856) {
        my $sub_u       = $x->getmatch('u',$entry);
        my $sub_z       = $x->getmatch('z',$entry);
        $$sub_u         = "$ezproxy_url$$sub_u";
        $$sub_z         = "$blurb";
    }

    $x->rebuild_map_all(1);
    $x->output({file=>">>$outfile",'format'=>"usmarc"});
    $x->deletemarc(); #empty the object for reading in another
}        

$x->closemarc();

exit(0);