extract_holdings

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4
   5 use XML::Twig;
   6 use YAML::Tiny;
   7 use Getopt::Long;
   8
   9
  10 my $conf = initialize();
  11 my $marcxml = shift;
  12
  13 open HOLDINGS, '>', $conf->{output};
  14 open X, '>', $conf->{pubnotesfile};
  15 open Z, '>', $conf->{privnotesfile};
  16 my $holdings = {};
  17 my %sample = ( x => {}, z => {} ); # hash of all subfields in all 852s
  18 my $copyid = 0;
  19
  20
  21 $| = 1;
  22 my $count = 0;
  23 my $total = `grep -c '<record' $marcxml`;
  24 my $percent = 0;
  25 my $prevper = -1;
  26
  27 my $yaml = YAML::Tiny->new;
  28 my $t = XML::Twig->new( twig_handlers => { record => \&record } );
  29 $t->parsefile($marcxml);
  30 $yaml->[0] = \%sample;
  31 $yaml->write('holdings.sample');
  32 print "\n\n";
  33
  34 sub record {
  35     my($t, $r)= @_;
  36     $holdings = { copies => [] };
  37
  38     my @dfields = $r->children('datafield');
  39     for my $d (@dfields)
  40       { process_datafields($d) }
  41
  42     for my $copy (@{$holdings->{copies}})
  43       { print_reports($copy) }
  44     $r->purge;
  45
  46     $count++;
  47     $percent = int(($count / $total) * 100);
  48     print "\r$percent% done ($count)" if ($percent != $prevper);
  49     $prevper = $percent;
  50 }
  51
  52 sub process_datafields {
  53     my ($d) = @_;
  54     # get 903
  55     if ($d->{'att'}->{'tag'} == 903) {
  56         my $s = $d->first_child('subfield');
  57         $holdings->{id} = $s->text;;
  58     }
  59
  60     # and holdings data
  61     if ($d->{'att'}->{'tag'} == $conf->{tag}) {
  62         push @{$holdings->{copies}}, { x =>[], z => [] };
  63         $holdings->{copies}[-1]{copyid} = $copyid;
  64         my @subs = $d->children('subfield');
  65         for my $s (@subs)
  66           { process_subs($s) }
  67         $copyid++;
  68     }
  69 }
  70
  71 sub process_subs {
  72     my ($s) = @_;
  73     my $copy = $holdings->{copies}[-1];
  74
  75     my $code = $s->{'att'}->{'code'};
  76     my $value = $s->text;
  77
  78     if ($code eq $conf->{pubnotes} or $code eq $conf->{privnotes}) {
  79         push @{$copy->{$code}}, $value;
  80         my ($k,$v) = split /:/, $value;
  81         $sample{$code}{$k} = $v;
  82     } else {
  83         $copy->{$code} = $value;
  84         $sample{$code} = $value;
  85     }
  86 }
  87
  88 sub print_reports {
  89     return unless defined $holdings->{id};
  90     my ($copy) = @_;
  91     my $note = 0;
  92     for (@{$copy->{x}}) {
  93         print X join("\t", $holdings->{id}, $copy->{copyid}, $note, $_), "\n";
  94         $note++;
  95     }
  96     $note = 0;
  97     for (@{$copy->{z}}) {
  98         print Z join("\t", $holdings->{id}, $copy->{copyid}, $note, $_), "\n";
  99         $note++;
 100     }
 101     my @fields = ();
 102     for ( @{$conf->{fields}} )
 103       { $copy->{$_} = '' unless defined $copy->{$_}; push @fields, $copy->{$_} }
 104     print HOLDINGS join("\t", $holdings->{id}, $copy->{copyid}, @fields), "\n";
 105 }
 106
 107
 108 #------------------------------------------------
 109
 110
 111 sub initialize {
 112     my $c = {};
 113     my @missing = ();
 114
 115     # set mode on existing filehandles
 116     binmode(STDIN, ':utf8');
 117
 118     my $rc = GetOptions( $c,
 119                          'fields|f=s',
 120                          'output|o=s',
 121                          'prefix|p=s',
 122                          'pubnotes|pub=i',
 123                          'pubnotesfile=s',
 124                          'privnotes|priv=s',
 125                          'privnotesfile=s',
 126                          'tag|t=i',
 127                          'help|h',
 128                        );
 129     show_help() unless $rc;
 130     show_help() if ($c->{help});
 131
 132     # set defaults
 133     $c->{prefix} = (defined $c->{prefix}) ? ($c->{prefix} . '.') : '';
 134     $c->{tag} = $c->{tag} || '852';
 135     $c->{output} =
 136       $c->{output} || join('', $c->{prefix}, "holdings.pg");
 137     $c->{pubnotes} = $c->{pubnotes} || 'x';
 138     $c->{pubnotesfile} =
 139       $c->{pubnotesfile} || join('', $c->{prefix}, "holdings.pubnote.pg");
 140     $c->{privnotes} = $c->{privnotes} || 'z';
 141     $c->{privnotesfile} =
 142       $c->{privnotesfile} || join('', $c->{prefix}, "holdings.privnote.pg");
 143
 144     my @keys = keys %{$c};
 145     show_help() unless (@ARGV and @keys);
 146     for my $key ('fields', 'tag')
 147       { push @missing, $key unless $c->{$key} }
 148     if (@missing) {
 149         print "Required option: ", join(', ', @missing), " missing!\n";
 150         show_help();
 151     }
 152
 153     # explode and validate fields string
 154     process_fields($c);
 155     return $c;
 156 }
 157
 158 sub process_fields {
 159     my ($c) = @_;
 160     my @holdings_fields = split /,/, $c->{fields};
 161     for (@holdings_fields) {
 162         die "Field names must be alphanumeric!\n" if /\W/;
 163         die "Field names must be single characters!\n"
 164           if /\w{2,}/;
 165     }
 166     $c->{fields} = \@holdings_fields;
 167 }
 168
 169 sub show_help {
 170     print <<HELP;
 171 Usage is: extract_holdings MARCXML_FILE HOLDINGS_TAG
 172 HELP
 173     exit;
 174 }