extract_holdings

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4
   5 use XML::Twig;
   6 use YAML;
   7 use JSON;
   8
   9 my $marcxml = shift;
  10
  11 open HOLDINGS, '>', "holdings";
  12 open X, '>', "holdings.x";
  13 open Z, '>', "holdings.z";
  14 open ALL852, '>', "holdings.all852";
  15
  16 my $holdings = {};
  17 my $copyid = 0;
  18 my %all852 = ( x => {}, z => {} ); # hash of all subfields in all 852s
  19
  20 my $t = XML::Twig->new( twig_handlers => { record => \&record } );
  21 $t->parsefile($marcxml);
  22 #print ALL852 to_json(\%all852);
  23 print ALL852 Dump(%all852);
  24
  25 sub record {
  26     my($t, $r)= @_;
  27     $holdings = { copies => [] };
  28
  29     my @dfields = $r->children('datafield');
  30     for my $d (@dfields) {
  31         process_datafields($d)
  32     }
  33
  34     for my $copy (@{$holdings->{copies}})
  35       { print_reports($copy) }
  36     $r->purge;
  37 }
  38
  39 sub process_datafields {
  40     my ($d) = @_;
  41     # get 903
  42     if ($d->{'att'}->{'tag'} == 903) {
  43         my $s = $d->first_child('subfield');
  44         $holdings->{id} = $s->text;;
  45     }
  46
  47     # and holdings data
  48     if ($d->{'att'}->{'tag'} == 852) {
  49         push @{$holdings->{copies}}, { x =>[], z => [] };
  50         $holdings->{copies}[-1]{copyid} = $copyid;
  51         my @subs = $d->children('subfield');
  52         for my $s (@subs)
  53           { process_subs($s) }
  54         $copyid++;
  55     }
  56 }
  57
  58 sub process_subs {
  59     my ($s) = @_;
  60     my $copy = $holdings->{copies}[-1];
  61
  62     my $code = $s->{'att'}->{'code'};
  63     my $value = $s->text;
  64
  65     if ($code eq 'x' or $code eq 'z') {
  66         push @{$copy->{$code}}, $value;
  67         my ($k,$v) = split /:/, $value;
  68         $all852{$code}{$k} = $v;
  69     } else {
  70         $copy->{$code} = $value;
  71         $all852{$code} = $value;
  72     }
  73 }
  74
  75 sub print_reports {
  76     my ($copy) = @_;
  77     my $note = 0;
  78     for (@{$copy->{x}}) {
  79         print X join("\t", $holdings->{id}, $copy->{copyid}, $note, $_), "\n";
  80         $note++;
  81     }
  82     $note = 0;
  83     for (@{$copy->{z}}) {
  84         print Z join("\t", $holdings->{id}, $copy->{copyid}, $note, $_), "\n";
  85         $note++;
  86     }
  87     print HOLDINGS join("\t", $holdings->{id}, $copy->{copyid},
  88                         $copy->{b}, $copy->{p}, $copy->{h}, $copy->{9}), "\n";
  89 }