dmd-Preservation-DCmultidate

#!/usr/bin/env perl

package dmdPreservationDCMultiDate;

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 CIHM::Swift::Client;
use URI::Escape;
use DateTime::Format::ISO8601;
use HTTP::Date qw(:DEFAULT time2isoz);
use File::Spec;
use File::stat;
use XML::LibXML;
use utf8;
use Switch;
use CIHM::Meta::DCCSV;

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

my $inThisFile;

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

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

    if ( defined $inThisFile ) {
        print STDERR "$stripped in $inThisFile\n";
        $logger->warn("$stripped in $inThisFile");
    }
    else {
        $logger->warn($stripped);
        print STDERR "$stripped\n";
    }
}
local $SIG{__WARN__} = sub { &log_warnings };

my $dmddir = '/crkn-nas-wip/_Metadata_Synchronised';
my $csvdir = '/crkn-nas-wip/_Metadata_Synchronised/Fixed/dcDateRanges';

$logger->info("DMD Preservation DC MultiDate: start");

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

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

#
my $dccsv;

## Test an ID
#$dccsv = CIHM::Meta::DCCSV->new( { csvdir => $csvdir } );
#$dccsv->addElement( "oocihm.7a9790", "thisis" , "atest" );
#exit 0;

my $preservationdir = File::Spec->catfile( $dmddir, 'preservation' );
opendir( my $dh, $preservationdir ) || die "Can't open $preservationdir: $!";
while ( readdir $dh ) {
    if ( substr( $_, 0, 1 ) ne "." ) {
        my $prefixdir = $_;

        my $preservationcsvdir =
          File::Spec->catfile( $csvdir, 'preservation', $prefixdir );
        my $preservationsubdir =
          File::Spec->catfile( $dmddir, 'preservation', $prefixdir );

        $dccsv = CIHM::Meta::DCCSV->new( { csvdir => $preservationcsvdir } );

        $0 = $dmddcmultiprog . " find in $preservationsubdir";
        print "Find for $prefixdir\n";

        find( \&matching_dmd_file, $preservationsubdir );

        print "Write for $prefixdir\n";

        $dccsv->writeCSV();
        undef $dccsv;
    }
}
closedir $dh;

exit 0;

sub matching_dmd_file {
    if ( -f $_ ) {
        $0 = $dmddcmultiprog . " looking for DC in $File::Find::dir";
        if (/^(.*)-(\w*)\.xml$/) {
            my $id      = $1;
            my $dmdType = $2;

            if ( $dmdType eq 'DC' ) {
                $inThisFile = $File::Find::name;
                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;
                undef $inThisFile;

                # Ugly, but does the trick for now.
                # Great when we can get rid of these odd hacks for odd data
                $xmlin =~
s|<simpledc>|<simpledc xmlns:dc="http://purl.org/dc/elements/1.1/">|g;

                my $doc = XML::LibXML->new->parse_string($xmlin);

                my $xpc = XML::LibXML::XPathContext->new;
                $xpc->registerNs( 'dc', 'http://purl.org/dc/elements/1.1/' );

                my @datenodes = $xpc->findnodes( "//dc:date", $doc );

                if ( scalar(@datenodes) > 2 ) {
                    my $warn = "$id has " . scalar(@datenodes) . " dates";
                    warn "$warn\n";
                }
                elsif ( scalar(@datenodes) == 2 ) {

                    # Add AIP ID as an identifier
                    $dccsv->addElement( $id, "identifier", $id );

              #                    print "Orig $id:" . $doc->toString(1) . "\n";

                    # Append the second date to the first.
                    $datenodes[0]
                      ->appendTextNode( "/" . $datenodes[1]->textContent );

                    # Clean newline too just to look right...
                    my $sibling = $datenodes[1]->nextSibling();
                    if ( $sibling->nodeType() == XML_TEXT_NODE ) {
                        my $text = $sibling->data();
                        if ( $text =~ /^\s*$/ ) {
                            $sibling->unbindNode();
                        }
                    }

                    # Remove the second date
                    $datenodes[1]->unbindNode();

                    #print "Fixed DC:" . $doc->toString(1) . "\n";

                    my @allnodes = $xpc->findnodes( "//*", $doc );

                    foreach my $node (@allnodes) {
                        my $content = normaliseSpace( $node->textContent );

                        if ( length($content) ) {
                            my $nodename = lc( $node->nodeName );
                            $nodename =~
                              s|dc:||g;    # Strip namespace if it exists

                            if ( $nodename ne "simpledc" ) {
                                $dccsv->addElement( $id, $nodename, $content );
                            }
                        }
                    }
                }
            }
        }
        else {
            warn $_ . "  -- doesn't match pattern (in $File::Find::dir )\n";
        }
    }
}

sub normaliseSpace {
    my $content = shift;

    $content =~ s/^\s+|\s+$//g;    # Trim space at end and beginning.
    $content =~ s/\s+/ /g;         # Remove extra spaces

    return $content;
}