source: gsdl/trunk/perllib/marcmapping.pm@ 18006

###########################################################################
#
# marcmapping.pm -- code to read in the marc mapping files
#
# A component of the Greenstone digital library software
# from the New Zealand Digital Library Project at the 
# University of Waikato, New Zealand.
#
# Copyright (C) 2008 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 marcmapping;

sub parse_marc_metadata_mapping
{
    my ($mm_file_or_files, $outhandle) = @_;

    my $metadata_mapping = {};

    if (ref ($mm_file_or_files) eq 'SCALAR') {
    my $mm_file = $mm_file_or_files;
    &_parse_marc_metadata_mapping($mm_file,$metadata_mapping, $outhandle);
    }
    else {
    my $mm_files = $mm_file_or_files;
    
    # Need to process files in reverse order.  This is so in the
    # case where we have both a "collect" and "main" version,
    # the "collect" one tops up the main one

    my $mm_file;
    while ($mm_file = pop(@$mm_files)) {
        &_parse_marc_metadata_mapping($mm_file,$metadata_mapping, $outhandle);
    }
    }

    return $metadata_mapping;
}

sub _parse_marc_metadata_mapping
{
    my ($mm_file,$metadata_mapping, $outhandle) = @_;

    if (open(MMIN, "<$mm_file"))
    {
    my $l=0;
    my $line;
    while (defined($line=<MMIN>))
    {
        $l++;
        chomp $line;
        $line =~ s/#.*$//; # strip out any comments, including end of line
        next if ($line =~ m/^\s*$/); 
        $line =~ s/\s+$//; # remove any white space at end of line

        my $parse_error_count = 0;
        if ($line =~ m/^-(\d+)\s*$/) {
        # special "remove" rule syntax
        my $marc_info = $1;
        if (defined $metadata_mapping->{$marc_info}) {
            delete $metadata_mapping->{$marc_info};
        }
        else {
            print $outhandle "Parse Warning: Did not find pre-existing rule $marc_info to remove";
            print $outhandle " on line $l of $mm_file:\n";
            print $outhandle "  $line\n";
        }
        }
        elsif ($line =~ m/^(.*?)->\s*([\w\^]+)$/)
        {
        my $lhs = $1;
        my $gsdl_info = $2;

        my @fields = split(/,\s*/,$lhs);
        my $f;
        while ($f  = shift (@fields)) {
            $f =~ s/\s+$//; # remove any white space at end of line

            if ($f =~ m/^(\d+)\-(\d+)$/) {
            # number range => generate number in range and
            # push on to array
            push(@fields,$1..$2);
            next;
            }

            if ($f =~ m/^(\d+)((?:(?:\$|\^)\w)*)\s*$/) {

            my $marc_info = $1;
            my $opt_sub_fields = $2;

            if ($opt_sub_fields ne "") {            
                my @sub_fields = split(/\$|\^/,$opt_sub_fields);
                shift @sub_fields; # skip first entry, which is blank

                foreach my $sub_field (@sub_fields) {
                $metadata_mapping->{$marc_info."\$".$sub_field} = $gsdl_info;
                }
            }
            else {
                # no subfields to worry about
                $marc_info =~ s/\^/\$/;
                $metadata_mapping->{$marc_info} = $gsdl_info;
            }
            }
            else {
            $parse_error_count++;
            }
        }
        }
        else
        {
        $parse_error_count++;
        }

        if ($parse_error_count>0) {
        
        print $outhandle "Parse Error: $parse_error_count syntax error(s) on line $l of $mm_file:\n";
        print $outhandle "  $line\n";
        }
    }
    close(MMIN);
    }
    else
    {
    print $outhandle "Unable to open $mm_file: $!\n";
    }
}



1;