mig-bin/mig-bibstats

   1 #!/usr/bin/perl
   2 # -*- coding: iso-8859-15 -*-
   3 ###############################################################################
   4 =pod
   5
   6 =item B<bibstats> --file foo.mrc
   7
   8 Reads through a marc file to generate statistical information about the file
   9 for quick analysis.
  10
  11 --uri_threshold defaults to 1, only shows URI values with more than that
  12 frequency
  13
  14 =back
  15
  16 =cut
  17
  18 ###############################################################################
  19
  20 use strict;
  21 use warnings;
  22
  23 use Data::Dumper;
  24 use Env qw(
  25     HOME PGHOST PGPORT PGUSER PGDATABASE MIGSCHEMA
  26     MIGBASEWORKDIR MIGBASEGITDIR MIGGITDIR MIGWORKDIR
  27 );
  28 use Pod::Usage;
  29 use Switch;
  30 use Getopt::Long;
  31 use MARC::Batch;
  32 use MARC::Record;
  33 use MARC::Field;
  34 use Cwd 'abs_path';
  35 use Cwd qw(getcwd);
  36 use FindBin;
  37 my $mig_bin = "$FindBin::Bin/";
  38 use lib "$FindBin::Bin/";
  39 use Mig;
  40 use open ':encoding(utf8)';
  41
  42 pod2usage(-verbose => 2) if defined $ARGV[0] && $ARGV[0] eq '--help';
  43 pod2usage(-verbose => 1) if ! $ARGV[1];
  44
  45 my $file;
  46 my $uri_threshold = 1;
  47
  48 my $ret = GetOptions(
  49     'file:s'           => \$file,
  50         'uri_threshold:i'  => \$uri_threshold
  51 );
  52
  53 my $batch = MARC::Batch->new('USMARC', $file);
  54 $batch->strict_off();
  55 my $filetype = `file $file`;
  56 if ($filetype =~ m/MARC21/) { print "$filetype.\n" }
  57     else { abort("File is not MARC21."); }
  58
  59 my $i = 0;
  60 my $uri_count = 0;
  61 my $uri_valid_count = 0;
  62 my $uri_sub9_count = 0;
  63 my $author_sub0 = 0;
  64 my $title_sub0 = 0;
  65 my @uris;
  66 my @fields;
  67 my @codes;
  68 while ( my $record = $batch->next() ) {
  69     $i++;
  70         @fields = $record->field('856');
  71         my $ldr = substr $record->leader(), 9, 1;
  72         push @codes, $ldr;
  73         foreach my $f (@fields) {
  74                 my $u = $f->subfield('u');
  75         my $n = $f->subfield('9');
  76         if (defined $n) { $uri_sub9_count++; }
  77                 if (defined $u) {
  78                         $uri_count++;
  79                         my $ind1 = $f->indicator('1');
  80                         my $ind2 = $f->indicator('2');
  81                         if ($ind1 eq '4') {
  82                                 if ($ind2 eq '0' or $ind2 eq '1') { $uri_valid_count++; }
  83                         }
  84                         my $ustring = lc $f->as_string('u');
  85                         $ustring =~ s/http:\/\///;
  86             $ustring =~ s/ftp:\/\///;
  87                         $ustring =~ s/https:\/\///;
  88                         $ustring =~ s/\/.*//;
  89                         push @uris, $ustring;
  90                 }
  91         }
  92         @fields = $record->field('100');
  93         foreach my $f (@fields) {
  94                 my $t = $f->subfield('0');
  95                 if (defined $t) { $title_sub0++; }
  96         }
  97     @fields = $record->field('245');
  98     foreach my $f (@fields) {
  99         my $t = $f->subfield('0');
 100         if (defined $t) { $author_sub0++; }
 101     }
 102     if(($i % 1000) == 0) { print "Processing bib $i.\n"; }
 103 }
 104
 105 my %uri_counts;
 106 $uri_counts{$_}++ for @uris;
 107
 108 my %code_counts;
 109 $code_counts{$_}++ for @codes;
 110
 111 print "\n$filetype\n";
 112 print "$i bibs read in file\n\n";
 113
 114 print "=== codes\n";
 115 foreach my $key (keys %code_counts) {
 116     my $value = $code_counts{$key};
 117     print "=== $key   $value\n";
 118 }
 119 print "\n";
 120
 121 print "$uri_count 856 fields with a subfield u\n";
 122 print "$uri_valid_count 856 fields with a subfield u and valid indicators\n";
 123 print "$uri_sub9_count 856 fields have subfield 9s\n";
 124 print "$title_sub0 100 fields have a subfield 0\n";
 125 print "$author_sub0 245 fields have a subfield 0\n";
 126
 127 print "\nURI values are domains and filtered to only show those with more than $uri_threshold\n";
 128 foreach my $key (keys %uri_counts) {
 129         my $value = $uri_counts{$key};
 130         if ($value > $uri_threshold) { print "=== $key   $value\n"; }
 131 }
 132
 133 close $file;
 134
 135 ########### functions
 136
 137 sub abort {
 138     my $msg = shift;
 139     print STDERR "$0: $msg", "\n";
 140     exit 1;
 141 }