emig.d/bin/mig-prepbibs

   1 #!/usr/bin/perl
   2 # -*- coding: iso-8859-15 -*-
   3 ###############################################################################
   4 =pod
   5
   6 =item B<prepbibs> --file foo.mrc
   7
   8 Converts a MARC binary file internally to XML and changes 852 subfields to
   9 851s with a special subfield z with a value of 'converted 852 field' added for
  10 identification.
  11
  12 =back
  13 =cut
  14
  15 ###############################################################################
  16
  17 use strict;
  18 use warnings;
  19
  20 use Data::Dumper;
  21 use Env qw(
  22     HOME PGHOST PGPORT PGUSER PGDATABASE MIGSCHEMA
  23     MIGBASEWORKDIR MIGBASEGITDIR MIGGITDIR MIGWORKDIR
  24 );
  25 use Pod::Usage;
  26 use Switch;
  27 use Getopt::Long;
  28 use MARC::Batch;
  29 use MARC::Record;
  30 use MARC::Field;
  31 use MARC::Batch;
  32 use MARC::File::XML;
  33 use Cwd 'abs_path';
  34 use Cwd qw(getcwd);
  35 use List::MoreUtils qw(uniq);
  36 use FindBin;
  37 my $mig_bin = "$FindBin::Bin/";
  38 use lib "$FindBin::Bin/";
  39 use KMig;
  40 use open ':encoding(utf8)';
  41
  42 binmode STDOUT, ":utf8";
  43
  44 pod2usage(-verbose => 2) if defined $ARGV[0] && $ARGV[0] eq '--help';
  45 pod2usage(-verbose => 1) if ! $ARGV[1];
  46
  47 my $infile;
  48
  49 my $ret = GetOptions(
  50     'file:s'                     => \$infile
  51 );
  52
  53 my $outfile = $infile . '.prepped_xml';
  54
  55 open my $outfh, '>:utf8', $outfile or die "Can't open output file $!\n";
  56
  57 my $batch = MARC::Batch->new( 'USMARC', $infile );
  58 $batch->strict_off();
  59
  60 while ( my $record = $batch->next() ) {
  61         my @nnn = $record->field('852');
  62         foreach my $n (@nnn) {
  63                 $n->set_tag('851');
  64                 $n->add_subfields( 'z' => 'converted 852 field' );
  65         }
  66     print $outfh $record->as_xml(),"\n";
  67 }
  68
  69 close ($infile);
  70 close ($outfile);
  71
  72
  73 ########### functions
  74
  75 sub abort {
  76     my $msg = shift;
  77     print STDERR "$0: $msg", "\n";
  78     exit 1;
  79 }