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 use Equinox::Migration::SubfieldMapper;
   9
  10 $| = 1;
  11
  12 my $c = initialize();
  13 my $marcxml = shift;
  14 my $copyid = 0;
  15 my $holdings;
  16
  17 my $count = 0;
  18 my $total = `grep -c '<record' $marcxml`;
  19 my $percent = 0;
  20 my $prevper = -1;
  21
  22 my $yaml = YAML::Tiny->new;
  23 my $t = XML::Twig->new( twig_handlers => { record => \&record } );
  24 $t->parsefile($marcxml);
  25 write_sample_fieds();
  26
  27 sub record {
  28     my($t, $r)= @_;
  29     $holdings = {};
  30
  31     my @dfields = $r->children('datafield');
  32     for my $d (@dfields) {
  33         process_datafields($d);
  34     }
  35     write_data_out();
  36     $r->purge;
  37
  38     $count++;
  39     $percent = int(($count / $total) * 100);
  40     print "\r$percent% done ($count)";# if ($percent != $prevper);
  41     $prevper = $percent;
  42 }
  43
  44 sub process_datafields {
  45     my ($d) = @_;
  46     my $tag = $d->{'att'}->{'tag'};
  47
  48     if ($tag == 903) {
  49         my $s = $d->first_child('subfield');
  50         $holdings->{id} = $s->text;;
  51     } elsif ($c->{map}->has($tag)) {
  52         push @{$holdings->{copies}}, { tag => $tag };
  53         my @subs = $d->children('subfield');
  54         for my $sub (@subs)
  55           { process_subs($tag,$sub) }
  56     }
  57 }
  58
  59 sub process_subs {
  60     my ($tag, $sub) = @_;
  61     my $code = $sub->{'att'}->{'code'};
  62
  63     unless ($c->{map}->has($tag, $code)) {
  64         # this is a subfield code we don't have mapped. report on it if this is a sample tag
  65         push @{$c->{sample}{$tag}}, $code if defined $c->{sample}{tag};
  66         return;
  67     }
  68
  69     my $copy = $holdings->{copies}[-1];
  70     my $field = $c->{map}->field($tag, $code);
  71     if ($c->{map}->mod($field) eq 'multi') {
  72         my $name = $tag . $code;
  73         push @{$copy->{multi}{$name}}, $sub->text;
  74     } else {
  75         $copy->{uni}{$code} = $sub->text;
  76     }
  77 }
  78
  79
  80 #------------------------------------------------
  81
  82 sub write_data_out {
  83     my $i = 0;
  84
  85     for my $copy (@{$holdings->{copies}}) {
  86         print HOLDINGS $holdings->{id}, "\t$i\t", $copy->{tag};
  87         for ( sort keys %{ $c->{map}{fields} } ) {
  88             if (defined $copy->{uni}{$_->{sub}}) {
  89                 print HOLDINGS "\t", $copy->{uni}{$_->{sub}};
  90             } else {
  91                 print HOLDINGS "\t";
  92             }
  93         }
  94         print HOLDINGS "\n";
  95
  96         for my $m (sort keys %{$copy->{multi}}) {
  97             my $fh = $c->{files}{multi}{$m};
  98             print $fh join("\t", $holdings->{id}, $i, @{$copy->{multi}{$m}}), "\n";
  99         }
 100         $i++;
 101     }
 102 }
 103
 104 sub write_sample_fields {
 105 }
 106
 107 #------------------------------------------------
 108
 109
 110 sub initialize {
 111     my $c = {};
 112     my @missing = ();
 113
 114     # set mode on existing filehandles
 115     binmode(STDIN, ':utf8');
 116
 117     my $rc = GetOptions( $c,
 118                          'sample|s=s',
 119                          'map|m=s',
 120                          'ils=s',
 121                          'prefix|p=s',
 122                          'help|h',
 123                        );
 124     show_help() unless $rc;
 125     show_help() if ($c->{help});
 126
 127     my @keys = keys %{$c};
 128     show_help() unless (@ARGV and @keys);
 129     for my $key ('prefix', 'map', 'ils')
 130       { push @missing, $key unless $c->{$key} }
 131     if (@missing) {
 132         print "Required option: ", join(', ', @missing), " missing!\n";
 133         show_help();
 134     }
 135
 136     # generate subfield map
 137     $c->{map} = Equinox::Migration::SubfieldMapper->new( file => $c->{map} );
 138
 139     # explode sample tags string
 140     if (defined $c->{sample}) {
 141         my $sample = $c->{sample};
 142         $c->{sample} = {};
 143         for (split /,/, $c->{sample}) {
 144             $c->{sample}{$_} = [];
 145         }
 146     }
 147
 148     # open required files
 149     open HOLDINGS, '>', ($c->{prefix} . ".holdings.pg");
 150     for my $f (keys %{$c->{map}{fields}}) {
 151         if ($c->{map}->mod($f)) {
 152           open my $mfh, '>', join('.', $c->{prefix}, "holdings",
 153                                   $c->{map}{fields}{$f}{tag},
 154                                   $c->{map}{fields}{$f}{sub}, "pg");
 155           $c->{files}{multi}{ ($c->{map}{fields}{$f}{tag} . $c->{map}{fields}{$f}{sub}) }
 156             = $mfh;
 157       }
 158     }
 159
 160     # print file headers
 161     print HOLDINGS "BEGIN;\n";
 162     print HOLDINGS "CREATE TABLE ", $c->{prefix}, ".asset_copy_", $c->{ils};
 163     print HOLDINGS $c->{library} if (defined $c->{library});
 164     print HOLDINGS " (";
 165     for ( sort keys %{ $c->{map}{fields} } ) {
 166         print HOLDINGS "l_", $_, " TEXT, ";
 167     }
 168     print HOLDINGS ") INHERITS FROM (", $c->{prefix}, ".asset_copy);\n";
 169     print HOLDINGS "COPY ", $c->{prefix}, ".asset_copy_", $c->{ils};
 170     print HOLDINGS $c->{library} if (defined $c->{library});
 171     print HOLDINGS " (";
 172     for ( sort keys %{ $c->{map}{fields} } ) {
 173         print HOLDINGS "l_", $_, ", ";
 174     }
 175     print HOLDINGS ") FROM STDIN;\n";
 176
 177
 178     return $c;
 179 }
 180
 181 sub show_help {
 182     print <<HELP;
 183 Usage is: ...
 184 HELP
 185     exit;
 186 }