emig.d/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 --ingore_filetype true will have it not care what file returns as the type and
  15 always treat it as marc21
  16 =back
  17
  18 =cut
  19
  20 ###############################################################################
  21
  22 use strict;
  23 use warnings;
  24
  25 use Data::Dumper;
  26 use Env qw(
  27     HOME PGHOST PGPORT PGUSER PGDATABASE MIGSCHEMA
  28     MIGBASEWORKDIR MIGBASEGITDIR MIGGITDIR MIGWORKDIR
  29 );
  30 use Pod::Usage;
  31 use Switch;
  32 use Getopt::Long;
  33 use MARC::Batch;
  34 use MARC::Record;
  35 use MARC::Field;
  36 use Cwd 'abs_path';
  37 use Cwd qw(getcwd);
  38 use FindBin;
  39 my $mig_bin = "$FindBin::Bin/";
  40 use lib "$FindBin::Bin/";
  41 use EMig;
  42 use open ':encoding(utf8)';
  43
  44 pod2usage(-verbose => 2) if defined $ARGV[0] && $ARGV[0] eq '--help';
  45 pod2usage(-verbose => 1) if ! $ARGV[1];
  46
  47 my $file;
  48 my $uri_threshold = 1;
  49 my $p_holding_code;
  50 my $p_barcode_subfield;
  51 my $p_ils_name = 'Runtime ILS';
  52 my $holding_threshold = 50;
  53 my $p_ignore_filetype = 'false';
  54
  55 my $ret = GetOptions(
  56     'file:s'                    => \$file,
  57         'uri_threshold:i'               => \$uri_threshold,
  58         'holding_code:s'                => \$p_holding_code,
  59         'barcode:s'                     => \$p_barcode_subfield,
  60         'ignore_filetype:s'             => \$p_ignore_filetype,
  61         'ils_name:s'                    => \$p_ils_name,
  62         'holding_threshold:s'   => \$holding_threshold
  63 );
  64
  65 if ($p_holding_code and length $p_holding_code != 3) { abort('Holdings codes must be three characters.'); }
  66
  67 if ($p_barcode_subfield) {
  68         if (!defined $p_holding_code) { abort('A barcode field can not be used without a holding code.'); }
  69         if (length $p_barcode_subfield != 1) { abort('Barcode subfields must be a single character code.'); }
  70 }
  71
  72 my @ilses = (
  73         ['Mandarin','852','p'],
  74         ['Evergreen','852','p'],
  75         ['Polaris','852','p'],
  76         ['TLC','949','g'],
  77         ['Koha','952','p'],
  78         ['Sympony','999','i']
  79     ['Destiny','852','p']
  80 );
  81
  82 my @temp;
  83 if ($p_holding_code) {
  84         push @temp, $p_ils_name;
  85         push @temp, $p_holding_code;
  86         if ($p_barcode_subfield) { push @temp, lc $p_barcode_subfield; }
  87 }
  88 push @ilses, @temp;
  89
  90
  91
  92 my $batch = MARC::Batch->new('USMARC', $file);
  93 $batch->strict_off();
  94 my $filetype = `file $file`;
  95 if ($filetype =~ m/MARC21/ or $p_ignore_filetype eq 'true') { print "$filetype.\n" }
  96     else { abort("File is not MARC21."); }
  97
  98 my $i = 0;
  99 my $uri_count = 0;
 100 my $uri_valid_count = 0;
 101 my $uri_sub9_count = 0;
 102 my $author_sub0 = 0;
 103 my $title_sub0 = 0;
 104 my @uris;
 105 my @fields;
 106 my @codes;
 107 my @holding_code_strings;
 108 my %holding_counts;
 109 my %barcode_counts;
 110
 111 foreach (@ilses) {
 112         $holding_counts{@$_[0]} = 0;
 113         $barcode_counts{@$_[0]} = 0;
 114 }
 115
 116 while ( my $record = $batch->next() ) {
 117     $i++;
 118         #check holdings, bit time consuming but more future proof
 119         foreach (@ilses) {
 120                 my $ils = @$_[0];
 121                 my $hcode = @$_[1];
 122                 my $barcode = @$_[2];
 123                 my @holding_fields = $record->field($hcode);
 124                 my $l = scalar @holding_fields;
 125                 my $v = $holding_counts{$ils};
 126                 if ($l) { $holding_counts{$ils} = $v + $l; }
 127         }
 128     #process 856s
 129         @fields = $record->field('856');
 130         my $ldr = substr $record->leader(), 9, 1;
 131         push @codes, $ldr;
 132         foreach my $f (@fields) {
 133                 my $u = $f->subfield('u');
 134         my $n = $f->subfield('9');
 135         if (defined $n) { $uri_sub9_count++; }
 136                 if (defined $u) {
 137                         $uri_count++;
 138                         my $ind1 = $f->indicator('1');
 139                         my $ind2 = $f->indicator('2');
 140                         if ($ind1 eq '4') {
 141                                 if ($ind2 eq '0' or $ind2 eq '1') { $uri_valid_count++; }
 142                         }
 143                         my $ustring = lc $f->as_string('u');
 144                         $ustring =~ s/http:\/\///;
 145             $ustring =~ s/ftp:\/\///;
 146                         $ustring =~ s/https:\/\///;
 147                         $ustring =~ s/\/.*//;
 148                         push @uris, $ustring;
 149                 }
 150         }
 151     #check for authority linking on 100s and 245s, if present may need to scrub them
 152         @fields = $record->field('100');
 153         foreach my $f (@fields) {
 154                 my $t = $f->subfield('0');
 155                 if (defined $t) { $title_sub0++; }
 156         }
 157     @fields = $record->field('245');
 158     foreach my $f (@fields) {
 159         my $t = $f->subfield('0');
 160         if (defined $t) { $author_sub0++; }
 161     }
 162     if(($i % 1000) == 0) { print "Processing bib $i.\n"; }
 163 }
 164
 165 my %uri_counts;
 166 $uri_counts{$_}++ for @uris;
 167
 168 my %code_counts;
 169 $code_counts{$_}++ for @codes;
 170
 171 print "\n$filetype\n";
 172 print "$i bibs read in file\n\n";
 173
 174 print "=== Leader 09 codes\n";
 175 foreach my $key (keys %code_counts) {
 176     my $value = $code_counts{$key};
 177     print "=== $key   $value\n";
 178 }
 179 print "\n";
 180
 181 print "$uri_count 856 fields with a subfield u\n";
 182 print "$uri_valid_count 856 fields with a subfield u and valid indicators\n";
 183 print "$uri_sub9_count 856 fields have subfield 9s\n";
 184 print "$title_sub0 100 fields have a subfield 0\n";
 185 print "$author_sub0 245 fields have a subfield 0\n";
 186
 187 print "\n=== Holdings Analysis\n";
 188 foreach my $key (keys %holding_counts) {
 189         my $c = $holding_counts{$key};
 190         if (((100/$i)*$c) >= $holding_threshold) { print "Could be $key $holding_counts{$key} holdings tags\n"; }
 191 }
 192
 193 print "\nURI values are domains and filtered to only show those with more than $uri_threshold\n";
 194 foreach my $key (keys %uri_counts) {
 195         my $value = $uri_counts{$key};
 196         if ($value > $uri_threshold) { print "=== $key   $value\n"; }
 197 }
 198
 199 close $file;
 200
 201 ########### functions
 202
 203 sub abort {
 204     my $msg = shift;
 205     print STDERR "$0: $msg", "\n";
 206     exit 1;
 207 }