source: trunk/gsdl/perllib/plugins/MARCPlug.pm@ 13198

###########################################################################
#
# MARCPlug.pm -- basic MARC plugin
#
# A component of the Greenstone digital library software
# from the New Zealand Digital Library Project at the 
# University of Waikato, New Zealand.
#
# Copyright (C) 2002 New Zealand Digital Library Project
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
###########################################################################

package MARCPlug;

use SplitPlug;

use unicode;
use util;

use strict;
no strict 'refs'; # allow filehandles to be variables and viceversa

sub BEGIN {
    @MARCPlug::ISA = ('SplitPlug');
    unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan");
}

my $arguments = 
    [ { 'name' => "metadata_mapping",
    'desc' => "{MARCPlug.metadata_mapping}",
    'type' => "string",
    'deft' => "marctodc.txt",
    'reqd' => "no" },
      { 'name' => "process_exp",
    'desc' => "{BasPlug.process_exp}",
    'type' => "regexp",
    'reqd' => "no",
    'deft' => &get_default_process_exp() },
      { 'name' => "split_exp",
    'desc' => "{SplitPlug.split_exp}",
    'type' => "regexp",
    'reqd' => "no",
    'deft' => &get_default_split_exp() } 
      ];

my $options = { 'name'     => "MARCPlug",
        'desc'     => "{MARCPlug.desc}",
        'abstract' => "no",
        'inherits' => "yes",
        'explodes' => "yes",
        'args'     => $arguments };

require MARC::Record;  
require MARC::Batch;  
#use MARC::Record;  
#use MARC::Batch;

sub new {
    my ($class) = shift (@_);
    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
    push(@$pluginlist, $class);

    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};

    my $self = new SplitPlug($pluginlist, $inputargs, $hashArgOptLists);

    $self->{'type'} = "";
    
    return bless $self, $class;
}

sub init {
    my $self = shift (@_);
    my ($verbosity, $outhandle, $failhandle) = @_;

    my @metadata_mapping = ();

    # read in the metadata mapping file
    my $mm_file =
    &util::filename_cat( $ENV{'GSDLHOME'}, "etc", $self->{'metadata_mapping'} );

    if (!-e $mm_file)
    {

    my $msg = "MARCPlug ERROR: Can't locate mapping file \"" .
        $self->{'metadata_mapping'} . "\".\n    This file should be at $mm_file\n" .
        "    No marc files can be processed.\n";

    print $outhandle $msg;
    print $failhandle $msg;
    $self->{'metadata_mapping'} = undef;
    # We pick up the error in process() if there is no $mm_file
    # If we exit here, then pluginfo.pl will exit too!
    }
    elsif (open(MMIN, "<$mm_file"))
    {
    my $l=1;
    my $line;
    while (defined($line=<MMIN>))
    {
        chomp $line;
        if ($line =~ m/^(\d+)\s*->\s*([\w\^]+)$/)
        {
        my $marc_info = $1;
        my $gsdl_info = $2;
        my $mapping = { 'marc' => $marc_info, 'gsdl' => $gsdl_info };
        push(@metadata_mapping,$mapping);
        }
        elsif ($line !~ m/^\#/       # allow comments (# in first column)
           && $line !~ m/^\s*$/) # allow blank lines
        {
        print $outhandle "Parse error on line $l of $mm_file:\n";
        print $outhandle "  \"$line\"\n";
        }
        $l++
    }
    close(MMIN);
    }
    else
    {
    print STDERR "Unable to open $mm_file: $!\n";
    }

    $self->{'metadata_mapping'} = \@metadata_mapping;

    $self->SUPER::init(@_);
}
    

sub get_default_process_exp {
    my $self = shift (@_);

    return q^(?i)(\.marc)$^;
}


sub get_default_split_exp {
    # \r\n for msdos eol, \n for unix
    return q^\r?\n\s*\r?\n|\[\w+\]Record type: USmarc^;
}



# The bulk of this function is based on read_line in multiread.pm
# Unable to use read_line original because it expects to get its input
# from a file.  Here the line to be converted is passed in as a string

sub to_utf8
{
    my $self = shift (@_);
    my ($encoding, $line) = @_;

    if ($encoding eq "iso_8859_1") {
    # we'll use ascii2utf8() for this as it's faster than going
    # through convert2unicode()
    return &unicode::ascii2utf8 (\$line);
    }

    # everything else uses unicode::convert2unicode
    return &unicode::unicode2utf8 (&unicode::convert2unicode ($encoding, \$line));
}


sub read_file {
    my $self = shift (@_);
    my ($filename, $encoding, $language, $textref) = @_;

    $self->{'readfile_encoding'}->{$filename} = $encoding;

       
    if (!-r $filename)
    {
    my $outhandle = $self->{'outhandle'};
    print $outhandle "Read permission denied for $filename\n" if $self->{'verbosity'};
    return;
    }

    ##handle ascii marc
    #test whether this is ascii marc file 
    if (open (FILE, $filename)) {
    while (defined (my $line = <FILE>)) {
        $$textref .= $line;
       if ($line =~ /\[\w+\]Record type:/){
           undef $/;
           $$textref .= <FILE>;
           $/ = "\n";
           $self->{'type'} = "ascii";
           close FILE;
           return;
       }
    }
    close FILE; 
    }

      
    $$textref = "";
    my @marc_entries = ();
 
    my $batch = new MARC::Batch( 'USMARC', $filename );
    while ( my $marc = $batch->next ) 
    {
        push(@marc_entries,$marc);
    $$textref .= $marc->as_formatted();
    $$textref .= "\n\n"; # for SplitPlug - see default_split_exp above...
    }

    $self->{'marc_entries'}->{$filename} = \@marc_entries;
}



# do plugin specific processing of doc_obj
# This gets done for each record found by SplitPlug in marc files.
sub process {
    my $self = shift (@_);
    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;

    my $outhandle = $self->{'outhandle'};
    my $filename = &util::filename_cat($base_dir, $file);

    if (! defined($self->{'metadata_mapping'}))
    {
    print $outhandle "MARCPlug: no metadata file! Can't process $file\n";
    return undef;
    }

    print STDERR "<Processing n='$file' p='MARCPlug'>\n" if ($gli);
    print $outhandle "MARCPlug: processing $file\n"
    if $self->{'verbosity'} > 1;

    my $cursection = $doc_obj->get_top_section();

    # Add fileFormat as the metadata
    $doc_obj->add_metadata($cursection, "FileFormat", "MARC");
    
    my $marc_entries = $self->{'marc_entries'}->{$filename};
    my $marc = shift(@$marc_entries);

    my $encoding = $self->{'readfile_encoding'}->{$filename};

    if ($self->{'type'} ne "ascii" ){   
        $self->extract_metadata ($marc, $metadata, $encoding, $doc_obj, $cursection);
    }
    else{
    $self->extract_ascii_metadata ($$textref,$metadata,$doc_obj, $cursection);
    }

    # add spaces after the sub-field markers, for word boundaries
    $$textref =~ s/^(.{6} _\w)/$1 /gm;

    # add text to document object
    $$textref =~ s/</&lt;/g;
    $$textref =~ s/>/&gt;/g;

    $$textref = $self->to_utf8($encoding,$$textref);

    print $outhandle "  Adding Marc Record:\n",substr($$textref,0,40), " ...\n"
    if $self->{'verbosity'} > 2;

    # line wrapping
    $$textref = &wrap_text_in_columns($$textref, 64);
    $$textref = "<pre>\n" . $$textref . "</pre>\n"; # HTML formatting...

    $doc_obj->add_utf8_text($cursection, $$textref);

    return 1;
}

sub wrap_text_in_columns
{
    my ($text, $columnwidth) = @_;
    my $newtext = "";
    my $linelength = 0;
    
    # Break the text into words, and display one at a time
    my @words = split(/ /, $text);

    foreach my $word (@words) {
    # If printing this word would exceed the column end, start a new line
    if (($linelength + length($word)) >= $columnwidth) {
        $newtext .= "\n";
        $linelength = 0;
    }
    
    # Write the word
    $newtext .= " $word";
    if ($word =~ /\n/) {
        $linelength = 0;
    } else {
        $linelength = $linelength + length(" $word");
    }
    }

    $newtext .= "\n";
    return $newtext;
}


sub extract_metadata 
{
    my $self = shift (@_);
    my ($marc, $metadata, $encoding, $doc_obj, $section) = @_;
    my $outhandle = $self->{'outhandle'};

    if (!defined $marc){
    return;
    }

    my $metadata_mapping = $self->{'metadata_mapping'};
    my $mm;

    foreach $mm ( @$metadata_mapping )
    {
    my $marc_field = $mm->{'marc'};

    my @metavalues = $marc->field($marc_field);

    if (scalar(@metavalues)>0)
    {
        my $metaname = $mm->{'gsdl'};
        my $metavalue;
        foreach $metavalue ( @metavalues )
        {
        my $metavalue_str = $self->to_utf8($encoding,$metavalue->as_string());
        $doc_obj->add_utf8_metadata ($section, $metaname, $metavalue_str);
        }
    }
    }
}

sub extract_ascii_metadata 
{
    my $self = shift (@_);
    my ($text, $metadata,$doc_obj, $section) = @_;
    my $outhandle = $self->{'outhandle'};
    my $metadata_mapping = $self->{'metadata_mapping'};
    ## get fields
    my @fields = split(/[\n\r]+/,$text);
    my $marc_mapping ={};

    foreach my $field (@fields){
    if ($field ne ""){
        $field =~ /^(\d\d\d)\s/;
        my $code = $1;
        $field = $';
        ##get subfields
        my @subfields = split(/\$/,$field);
        my $i=0;
        $marc_mapping->{$code} = [];  
        foreach my $subfield (@subfields){
        if ($i == 0){
            ##print STDERR $subfield."\n";
            push(@{$marc_mapping->{$code}},"info");
            push(@{$marc_mapping->{$code}},$subfield);
                 
            $i++;
        } 
         else{
             $subfield =~ /(\w)\s/;
             ##print STDERR "$1=>$'\n";
             push(@{$marc_mapping->{$code}},$1);
                     push(@{$marc_mapping->{$code}},$'); 
         }
        }
    }
    }


     foreach my $mm ( @$metadata_mapping )
    {
    my $marc_field = $mm->{'marc'};
        
    my $matched_field = $marc_mapping->{$marc_field};
    my $subfield = undef;

    if (defined $matched_field){
        ## test whether this field has subfield
        if ($marc_field =~ /\d\d\d(\w)/){
        $subfield = $1;
        }
        my $metaname = $mm->{'gsdl'};
 
        my $metavalue;
        if (defined $subfield){
        my %mapped_subfield = {@$matched_field};
        $metavalue = $mapped_subfield{$subfield};
        }
        else{ ## get all values except info
        my $i =0;
        foreach my $value (@$matched_field){
            if ($i%2 != 0 and $i != 1){
            $metavalue .= $value." ";
            }
            $i++;
        }
        }
        
        ## escape [ and ]
        $metavalue =~ s/\[/\\\[/g;
        $metavalue =~ s/\]/\\\]/g;
        ##print STDERR  "$metaname=$metavalue\n";
        $doc_obj->add_metadata ($section, $metaname, $metavalue) ;          
    }
       
    }

}


1;