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 --ignore_filetype true will have it not care what file returns as the type and
  15 always treat it as marc21
  16
  17 --ils --holding_code --barcode_subfield work together to pass an new ILS
  18 definnition without it being hardcode in the script and can test arbitary
  19 fields
  20
  21 --exportbarcodes ils_name is used if you want to export the barcodes associated
  22 with one of the ILSes so provide the name
  23
  24 --exportbarcodesfile will use this file name for a barcode export instead
  25 of the generic 'barcodes_export.txt'
  26
  27 --item_type_subfield will make use of --holding_code and provide a breakdown of
  28 bib types by item types.  If --branch_subfield is also provided, then the
  29 breakdown will be further subdivided by branch.
  30
  31 =back
  32 =cut
  33
  34 ###############################################################################
  35
  36 use strict;
  37 use warnings;
  38
  39 use Data::Dumper;
  40 use Env qw(
  41     HOME PGHOST PGPORT PGUSER PGDATABASE MIGSCHEMA
  42     MIGBASEWORKDIR MIGBASEGITDIR MIGGITDIR MIGWORKDIR
  43 );
  44 use Pod::Usage;
  45 use Switch;
  46 use Getopt::Long;
  47 use MARC::Batch;
  48 use MARC::Record;
  49 use MARC::Field;
  50 use Cwd 'abs_path';
  51 use Cwd qw(getcwd);
  52 use List::MoreUtils qw(uniq);
  53 use FindBin;
  54 my $mig_bin = "$FindBin::Bin/";
  55 use lib "$FindBin::Bin/";
  56 use EMig;
  57 #use KMig;
  58 use open ':encoding(utf8)';
  59
  60 pod2usage(-verbose => 2) if defined $ARGV[0] && $ARGV[0] eq '--help';
  61 pod2usage(-verbose => 1) if ! $ARGV[1];
  62
  63 my $file;
  64 my $uri_threshold = 1;
  65 my $p_holding_code;
  66 my $p_barcode_subfield;
  67 my $p_item_type_subfield;
  68 my $p_branch_subfield;
  69 my $p_ils_name = '';
  70 my $holding_threshold = 50;
  71 my $p_ignore_filetype = 'false';
  72 my @holdings;
  73 my %unique_barcodes;
  74 my $exportbarcodes;
  75 my $exportbarcodesfile;
  76
  77 my $ret = GetOptions(
  78     'file:s'                    => \$file,
  79     'uri_threshold:i'           => \$uri_threshold,
  80     'holding_code:s'            => \$p_holding_code,
  81     'barcode_subfield:s'     => \$p_barcode_subfield,
  82     'item_type_subfield:s'     => \$p_item_type_subfield,
  83     'branch_subfield:s'     => \$p_branch_subfield,
  84     'ignore_filetype:s'         => \$p_ignore_filetype,
  85     'ils:s'                     => \$p_ils_name,
  86     'exportbarcodes:s'         => \$exportbarcodes,
  87     'exportbarcodesfile:s'   => \$exportbarcodesfile,
  88     'holding_threshold:s'     => \$holding_threshold
  89 );
  90
  91 if ($exportbarcodesfile and !defined $exportbarcodes) { abort('You have to provide an ILS name if you want a barcode export file.'); }
  92
  93 if ($p_holding_code and length $p_holding_code != 3) { abort('Holdings codes must be three characters.'); }
  94
  95 if ($p_barcode_subfield) {
  96     if (!defined $p_holding_code) { abort('A barcode field can not be used without a holding code.'); }
  97     if (length $p_barcode_subfield != 1) { abort('Barcode subfields must be a single character code.'); }
  98 }
  99
 100 if ($p_item_type_subfield) {
 101         if (!defined $p_holding_code) { abort('An item type field can not be used without a holding code.'); }
 102         if (length $p_item_type_subfield != 1) { abort('Item type subfields must be a single character code.'); }
 103 }
 104
 105 if ($p_branch_subfield) {
 106         if (!defined $p_holding_code) { abort('A branch field can not be used without a holding code.'); }
 107         if (length $p_branch_subfield != 1) { abort('Branch subfields must be a single character code.'); }
 108 }
 109
 110 # ils name, holding tag, barcode subfield
 111 my @ilses = (
 112     ['Mandarin','852','p'],
 113     ['Evergreen','852','p'],
 114     ['Polaris','852','p'],
 115     ['TLC','949','g'],
 116     ['Koha','952','p'],
 117     ['Sympony','999','i'],
 118     ['Destiny','852','p']
 119 );
 120
 121 my @temp;
 122 if (defined $p_holding_code && defined $p_ils_name && defined $p_barcode_subfield) {
 123     push @temp, $p_ils_name;
 124     push @temp, $p_holding_code;
 125     if ($p_barcode_subfield) { push @temp, lc $p_barcode_subfield; }
 126     push @ilses, [@temp];
 127 }
 128
 129 #to do - add a check for exportbarcodes being in @ilses
 130
 131 my $filetype = `file $file`;
 132 my $batch;
 133 if ($filetype =~ m/MARC21/) {
 134     $batch = MARC::Batch->new( 'USMARC', $file );
 135 } else {
 136     $batch = MARC::Batch->new( 'XML', $file );
 137 }
 138 $batch->strict_off();
 139
 140 my $i = 0;
 141 my $uri_count = 0;
 142 my $uri_valid_count = 0;
 143 my $uri_sub9_count = 0;
 144 my $author_sub0 = 0;
 145 my $title_sub0 = 0;
 146 my @uris;
 147 my @fields;
 148 my @encodings;
 149 my @types;
 150 my %bib_types_by_item_type;
 151 my @holding_code_strings;
 152 my %holding_counts;
 153 my %barcode_counts;
 154
 155 foreach (@ilses) {
 156     $holding_counts{@$_[0]} = 0;
 157     $barcode_counts{@$_[0]} = 0;
 158 }
 159
 160 while ( my $record = $batch->next() ) {
 161     $i++;
 162     #check holdings, bit time consuming but more future proof
 163     foreach (@ilses) {
 164         my $ils = @$_[0];
 165         my $hcode = @$_[1];
 166         my $barcode = @$_[2];
 167         my @holding_fields = $record->field($hcode);
 168         foreach my $hf (@holding_fields) {
 169             my @h;
 170             my $barcode_string = $hf->subfield($barcode);
 171             push @h, $ils;
 172             push @h, $barcode_string;
 173             push @holdings, [@h];
 174         }
 175         my $l = scalar @holding_fields;
 176         my $v = $holding_counts{$ils};
 177         if ($l) { $holding_counts{$ils} = $v + $l; }
 178     }
 179     #process 856s
 180     @fields = $record->field('856');
 181     my $enc = substr $record->leader(), 9, 1;
 182     push @encodings, $enc;
 183     my $type = substr $record->leader(), 6, 1;
 184     push @types, $type;
 185     # bib type by branch and by item type if item subfield (and optionally branch subfield) provided
 186     if (defined $p_holding_code && defined $p_item_type_subfield) {
 187         my @holding_fields = $record->field($p_holding_code);
 188         foreach my $hf (@holding_fields) {
 189             my $item_type = $hf->subfield($p_item_type_subfield) || '<missing item type subfield>';
 190             my $branch = $p_branch_subfield || 'default';
 191             if (! defined $bib_types_by_item_type{ $branch }) {
 192                 $bib_types_by_item_type{ $branch } = {};
 193             }
 194             if (! defined $bib_types_by_item_type{ $branch }{ $type }) {
 195                 $bib_types_by_item_type{ $branch }{ $type } = {};
 196             }
 197             if (! defined $bib_types_by_item_type{ $branch }{ $type }{ $item_type }) {
 198                 $bib_types_by_item_type{ $branch }{ $type }{ $item_type } = 0;
 199             }
 200             $bib_types_by_item_type{ $branch }{ $type }{ $item_type }++;
 201         }
 202     }
 203     foreach my $f (@fields) {
 204         my $u = $f->subfield('u');
 205         my $n = $f->subfield('9');
 206         if (defined $n) { $uri_sub9_count++; }
 207         if (defined $u) {
 208             $uri_count++;
 209             my $ind1 = $f->indicator('1');
 210             my $ind2 = $f->indicator('2');
 211             if ($ind1 eq '4') {
 212                 if ($ind2 eq '0' or $ind2 eq '1') { $uri_valid_count++; }
 213             }
 214             my $ustring = lc $f->as_string('u');
 215             $ustring =~ s/http:\/\///;
 216             $ustring =~ s/ftp:\/\///;
 217             $ustring =~ s/https:\/\///;
 218             $ustring =~ s/\/.*//;
 219             push @uris, $ustring;
 220         }
 221     }
 222     #check for authority linking on 100s and 245s, if present may need to scrub them
 223     @fields = $record->field('100');
 224     foreach my $f (@fields) {
 225         my $t = $f->subfield('0');
 226         if (defined $t) { $title_sub0++; }
 227     }
 228     @fields = $record->field('245');
 229     foreach my $f (@fields) {
 230         my $t = $f->subfield('0');
 231         if (defined $t) { $author_sub0++; }
 232     }
 233     if(($i % 1000) == 0) { print "Processing bib $i.\n"; }
 234 }
 235
 236 foreach (@ilses) {
 237     my $ils = @$_[0];
 238     my @temp_barcodes;
 239     foreach my $h (@holdings) {
 240         my $temp_ils_name = @$h[0];
 241         if ($temp_ils_name eq $ils) { push @temp_barcodes, @$h[1]; }
 242     }
 243     my @uniq_barcodes = uniq @temp_barcodes;;
 244     $barcode_counts{$ils} = scalar @uniq_barcodes;
 245 }
 246
 247 my %uri_counts;
 248 $uri_counts{$_}++ for @uris;
 249
 250 my %encoding_counts;
 251 $encoding_counts{$_}++ for @encodings;
 252
 253 my %type_counts;
 254 $type_counts{$_}++ for @types;
 255
 256 print "\n$filetype\n";
 257 print "$i bibs read in file\n\n";
 258
 259 print "===== Leader 09, # = MARC-8, a = UCS/Unicode\n";
 260 foreach my $key (keys %encoding_counts) {
 261     my $value = $encoding_counts{$key};
 262     print "  $key   $value\n";
 263 }
 264 print "\n";
 265
 266 print "===== Leader 06\n";
 267 foreach my $key (keys %type_counts) {
 268     my $value = $type_counts{$key};
 269     my $type = give_type($key);
 270     print "  $key   $value $type\n";
 271 }
 272 print "\n";
 273
 274 if ($p_item_type_subfield) {
 275     print "===== Branch / Leader 06 / Item Type\n";
 276     foreach my $branch (keys %bib_types_by_item_type) {
 277         foreach my $btype (keys %{ $bib_types_by_item_type{$branch} }) {
 278             foreach my $itype (keys %{ $bib_types_by_item_type{$branch}{$btype} }) {
 279                 my $count = $bib_types_by_item_type{$branch}{$btype}{$itype};
 280                 print "$branch\t$btype (" . give_type($btype) . ")\t$itype\t$count\n";
 281             }
 282         }
 283     }
 284     print "\n";
 285 }
 286
 287 print "===== Summary of Select Field Counts\n";
 288 print "  $uri_count 856 fields with a subfield u\n";
 289 print "  $uri_valid_count 856 fields with a subfield u and valid indicators\n";
 290 print "  $uri_sub9_count 856 fields have a subfield 9\n";
 291 print "  $title_sub0 100 fields have a subfield 0\n";
 292 print "  $author_sub0 245 fields have a subfield 0\n";
 293
 294 print "\n===== Holdings Analysis\n";
 295 foreach my $key (keys %holding_counts) {
 296     my $c = $holding_counts{$key};
 297     if (((100/$i)*$c) >= $holding_threshold) { print "  $key $holding_counts{$key} holdings in $i bibs with $barcode_counts{$key} unique barcodes\n"; }
 298 }
 299
 300 print "\n===== URI values are domains and filtered to only show those with more than $uri_threshold\n";
 301 foreach my $key (keys %uri_counts) {
 302     my $value = $uri_counts{$key};
 303     if ($value > $uri_threshold) { print "  $key   $value\n"; }
 304 }
 305
 306 if ($exportbarcodes) {
 307     my @temp_barcodes;
 308     my $outfile;
 309     if ($exportbarcodesfile) { $outfile = $exportbarcodesfile; } else { $outfile = 'barcodes_export.txt'; }
 310     open my $out_fh, '>:utf8', $outfile or abort('can not open output file for barcode list');
 311     foreach my $h (@holdings) {
 312         my $temp_ils_name = @$h[0];
 313         my $barcode = @$h[1];
 314         if (!defined $barcode) { $barcode = 'no barcode found'; }
 315         if ($temp_ils_name eq $exportbarcodes) { print $out_fh "@$h[1]\n" }
 316     }
 317     close $out_fh;
 318 } else { print "frack\n"; }
 319
 320 close $file;
 321
 322 ########### functions
 323
 324 sub abort {
 325     my $msg = shift;
 326     print STDERR "$0: $msg", "\n";
 327     exit 1;
 328 }
 329
 330 sub give_type {
 331     my $type = shift;
 332     if ($type eq 'a') { return 'Language material'; }
 333     if ($type eq 'c') { return 'Notated Music'; }
 334     if ($type eq 'd') { return 'Manuscript notated music'; }
 335     if ($type eq 'e') { return 'Cartographic material'; }
 336     if ($type eq 'f') { return 'Manuscript cartographic material'; }
 337     if ($type eq 'g') { return 'Projected Medium'; }
 338     if ($type eq 'i') { return 'Nonmusical sound recording'; }
 339     if ($type eq 'j') { return 'Musical sound recording'; }
 340     if ($type eq 'k') { return 'Two-dimensional nonprojectable graphic'; }
 341     if ($type eq 'm') { return 'Computer file'; }
 342     if ($type eq 'o') { return 'Kit'; }
 343     if ($type eq 'p') { return 'Mixed materials'; }
 344     if ($type eq 'r') { return 'Three-dimensaional artifact or naturally occurring object'; }
 345     if ($type eq 't') { return 'Manuscript language material'; }
 346     if ($type eq 'z') { return 'Authority'; }
 347     return 'unknown';
 348 }