dmdstats-MARC856-URIcount

#!/usr/bin/env perl

package dmdstatsMARC856URIcount;

use strict;
use warnings;
use FindBin;
use lib "$FindBin::RealBin/../lib";
use Getopt::Long;
use Fcntl qw(:DEFAULT :flock);
use Try::Tiny;
use Log::Log4perl;
use File::Find;
use Data::Dumper;
use Digest::MD5;
use JSON;
use Poppler;
use XML::LibXML;
use MARC::File::XML ( BinaryEncoding => 'utf8', RecordFormat => 'USMARC' );
use CIHM::Swift::Client;
use URI::Escape;
use DateTime::Format::ISO8601;
use HTTP::Date qw(:DEFAULT time2isoz);
use File::Path qw(make_path remove_tree);
use File::Spec;
use File::stat;
use XML::LibXML;
use utf8;
use Switch;
use Text::CSV qw( csv );

Log::Log4perl->init_once("/etc/canadiana/tdr/log4perl.conf");
my $logger = Log::Log4perl::get_logger("CIHM::TDR");

sub log_warnings {
    my $warning = shift;
    chomp $warning;

    # Strip wide characters before  trying to log
    ( my $stripped = $warning ) =~ s/[^\x00-\x7f]//g;

    $logger->warn($stripped);
    print STDERR "$warning\n";
}
local $SIG{__WARN__} = sub { &log_warnings };

my $dmddir = '/crkn-nas-wip/_Metadata_Synchronised';
$dmddir = $ENV{syncdmd_dmddir} if ( exists $ENV{syncdmd_dmddir} );

my $outfile =
  '/crkn-nas-wip/_Metadata_Synchronised/analysis/dmdstats-MARC856-URIcount.csv';

$logger->info("DMD stats: start");

GetOptions(
    'outfile:s' => \$outfile,
    'dmddir:s'  => \$dmddir,
);

# Used to show a different processname during processing
my $dmdstatsprog = $0;

my %results;
my $maxcount = 0;

my $preservationdir = File::Spec->catfile( $dmddir, 'preservation' );
find( \&matching_dmd_file, $preservationdir );

my $accessdir = File::Spec->catfile( $dmddir, 'access' );
find( \&matching_dmd_file, $accessdir );

sub matching_dmd_file {
    if ( -f $_ ) {
        $0 = $dmdstatsprog . " counting in $File::Find::dir";
        if (/^(.*)-(\w*)\.xml$/) {
            my $id      = $1;
            my $dmdType = $2;
            return if $dmdType ne "MARC";

            if ( $File::Find::dir =~ /$dmddir\/([^\/]+)\/(.*)$/ ) {
                my $repo   = $1;
                my $prefix = $2;

                open my $fh, '<:encoding(UTF-8)', $File::Find::name
                  or die "can't open DC file=$File::Find::name: $!\n";

                my $xmlin = do { local $/; <$fh> };
                close $fh;

                my $record = MARC::Record->new_from_xml($xmlin);

                # There may be many 856's, and each may have many 'u' subfields
                # https://www.loc.gov/marc/bibliographic/bd856.html
                my $locationcount = 0;
                foreach my $field ( $record->field('856') ) {
                    foreach my $subfield ( $field->subfield("u") ) {
                        $locationcount++;
                    }
                }
                if ( $locationcount > $maxcount ) {
                    $maxcount = $locationcount;
                    print "$id in $repo/$prefix has $maxcount\n";
                }

                if ( defined $results{$repo}{$prefix}{$locationcount} ) {
                    $results{$repo}{$prefix}{$locationcount}++;
                }
                else {
                    $results{$repo}{$prefix}{$locationcount} = 1;
                }
            }
            else {
                warn $File::Find::dir . "  -- doesn't match pattern\n";
            }
        }
        else {
            warn $_ . "  -- doesn't match pattern (in $File::Find::dir )\n";
        }
    }
}

my @res = [ "repository", "prefix" ];
push @{ $res[0] }, ( 0 .. $maxcount ), "totals";

foreach my $repo ( sort keys %results ) {
    foreach my $prefix ( sort keys %{ $results{$repo} } ) {
        my @thisline = ( $repo, $prefix );
        my $total = 0;
        foreach my $locationcount ( 0 .. $maxcount ) {
            if ( defined $results{$repo}{$prefix}{$locationcount} ) {
                push @thisline, $results{$repo}{$prefix}{$locationcount};
                $total += $results{$repo}{$prefix}{$locationcount};
            }
            else {
                push @thisline, 0;
            }
        }
        push @thisline, $total;
        push @res, [@thisline];
    }
}

csv( in => \@res, out => $outfile );