Open-ILS/src/extras/import/marcFilterDump.pl

   1 #!/usr/bin/perl -w
   2 use strict;
   3 use Error qw/:try/;
   4 use MARC::Batch;
   5 use MARC::File::XML;
   6 use XML::LibXML;
   7 use Getopt::Long;
   8 use encoding 'utf8';
   9
  10 my ($out_enc, $in_enc, $filter) = ('UTF8','MARC8');
  11 GetOptions('r=s' => \$filter, 'f=s' => \$in_enc, 't=s' => \$out_enc);
  12 die("Please specify a filter with -r!\n") unless ($filter);
  13
  14 my $batch = MARC::Batch->new( 'USMARC', @ARGV );
  15 $batch->strict_off;
  16
  17 my $parser = new XML::LibXML;
  18
  19 my $counter = 1;
  20 my $current_file = $ARGV[0];
  21
  22 print STDERR "\nWorking on file $current_file ";
  23
  24 my $marc = $batch->next;
  25 while ($marc) {
  26
  27         my ($next,$xml,$doc,@nodes);
  28
  29         try {
  30                 $xml = $marc->as_xml($out_enc);
  31         } otherwise {
  32                 print STDERR "\n ARG! I couldn't parse the MARC record (number $counter): $@\n";
  33                 $marc = $batch->next;
  34                 $next++;
  35         };
  36         next if ($next);
  37
  38         try {
  39                 $doc = $parser->parse_string($xml);
  40         } otherwise {
  41                 print STDERR "\n ARG! I couldn't turn the MARC record into MARCXML (number $counter): $@\n";
  42                 $marc = $batch->next;
  43                 $next++;
  44         };
  45         next if ($next);
  46
  47         try {
  48                 @nodes = $doc->documentElement->findnodes($filter);
  49         } otherwise {
  50                 print STDERR "\n ARG! I couldn't prune the MARCXML record (number $counter): $@\n";
  51                 $marc = $batch->next;
  52                 $next++;
  53         };
  54         next if ($next);
  55
  56         for my $n (@nodes) {
  57                 $n->parentNode->removeChild($n);
  58         }
  59
  60         my $string = $doc->toStringC14N;
  61         $string =~ s/\n/ /gso;
  62         $string =~ s/\t/ /gso;
  63         $string =~ s/>\s+</></gso;
  64
  65         print "$string\n";
  66
  67         unless ($counter % 1000) {
  68                 if ($current_file ne $batch->filename) {
  69                         $current_file = $batch->filename;
  70                         print STDERR "\nWorking on file $current_file ";
  71                 }
  72                 print STDERR '.'
  73         }
  74         $counter++;
  75         try {
  76                 $marc = $batch->next;
  77         } otherwise {
  78                 print STDERR "\n ARG! I couldn't parse the MARC record (number $counter): $@\n";
  79                 $marc = $batch->next;
  80         }
  81 }