r742@llin: dpavlin | 2006-06-30 01:21:24 +0200

 added marc_repetable_subfield and marc_indicators, renamed marc21 to marc [2.23]

git-svn-id: svn+ssh://mjesec/home/dpavlin/svn/webpac2/trunk@547 07558da8-63fa-0310-ba24-9fe276d99e06

diff --git a/TODO b/TODO
index 381375b..30391c2 100644 (file)
--- a/TODO
+++ b/TODO
@@ -18,7 +18,8 @@
 + add Excel input format [2.16]
 + remove WebPAC::Normalize::XML and promote WebPAC::Normalize::Set to WebPAC::Normalize [2.20]
 + support arrays for normalize/path [2.21]
-+ add marc21 to normalize and create export MARC file [2.22]
++ add marc to normalize and create export MARC file [2.22]
++ implement indicators and repetable subfield in marc export [2.23]
 - support arrays for lookup
 - add dBase input format
 - remove delimiters characters from index and query entered

diff --git a/conf/normalize/mapping.pl b/conf/normalize/mapping.pl
index eb1dfd4..02f7ead 100644 (file)
--- a/conf/normalize/mapping.pl
+++ b/conf/normalize/mapping.pl
@@ -1,66 +1,68 @@
-marc21('001',
+marc('001',
        rec('000')
 );
 
-marc21('020','a',
+marc('020','a',
        rec('010')
 );
 
-marc21('101','a',
+marc_repeatable_subfield('041','a',
        rec('101')
 );
 
-marc21('245','a',
+marc_indicators('245', 0, 0);
+
+marc('245','a',
        rec('200','a')
 );
 
-marc21('245','b',
+marc('245','b',
        join_with(' : ',
                rec('200','d'),
                rec('200','e')
        )
 );
 
-marc21('245','c',
+marc('245','c',
        join_with(' ; ',
                rec('200','f'),
                rec('200','g')
        )
 );
 
-marc21('250','a',
+marc('250','a',
        rec('205','a')
 );
 
-marc21('260','a',
+marc('260','a',
        rec('210','a')
 );
 
-marc21('260','b',
+marc('260','b',
        rec('210','c')
 );
 
-marc21('260','c',
+marc('260','c',
        rec('210','d')
 );
 
-marc21('300','a',
+marc('300','a',
        rec('215','a')
 );
 
-marc21('300','b',
+marc('300','b',
        rec('215','c')
 );
 
-marc21('300','c',
+marc('300','c',
        rec('215','d')
 );
 
-marc21('300','e',
+marc('300','e',
        rec('215','e')
 );
 
-marc21('490','a',
+marc('490','a',
        join_with(' = ',
                rec('225','a'),
                join_with(" :  ",
@@ -73,30 +75,32 @@ marc21('490','a',
        )
 );
 
-marc21('490','v',
+marc('490','v',
        rec('225','v')
 );
 
-marc21('500','a',
+marc('500','a',
        rec('300')
 );
 
-marc21('504','a',
+marc('504','a',
        rec('320')
 );
 
-marc21('655','a',
+marc_indicators('655', ' ', 4);
+marc('655','a',
        rec('610')
 );
 
-marc21('100','a',
+marc_indicators('100', 0, ' ');
+marc('100','a',
        join_with(', ',
                rec('700', 'a'),
                rec('700', 'b')
        )
 );
 
-marc21('700','a',
+marc('700','a',
        join_with(', ',
                rec('701', 'a'),
                rec('701', 'b')
@@ -104,12 +108,12 @@ marc21('700','a',
 );
 
 if ( rec('701') ) { 
-       marc21('700','4', 
+       marc('700','4', 
                '070'
        ); 
 }
 
-marc21('700','a',
+marc('700','a',
        join_with(', ',
                rec('702','a'),
                rec('702','b')
@@ -117,7 +121,7 @@ marc21('700','a',
 );
 
 if ( rec('702') ) {
-       marc21('700','4',
+       marc('700','4',
                '340'
        );
 }

diff --git a/lib/WebPAC.pm b/lib/WebPAC.pm
index 24b6fca..ab4a2da 100644 (file)
--- a/lib/WebPAC.pm
+++ b/lib/WebPAC.pm
@@ -9,11 +9,11 @@ WebPAC - core module
 
 =head1 VERSION
 
-Version 2.21
+Version 2.23
 
 =cut
 
-our $VERSION = '2.21';
+our $VERSION = '2.23';
 
 =head1 SYNOPSIS
 

diff --git a/lib/WebPAC/Normalize.pm b/lib/WebPAC/Normalize.pm
index 59056e3..c3c36e3 100644 (file)
--- a/lib/WebPAC/Normalize.pm
+++ b/lib/WebPAC/Normalize.pm
@@ -5,7 +5,7 @@ use Exporter 'import';
        _get_ds _clean_ds
 
        tag search display
-       marc21
+       marc marc_indicators marc_repeatable_subfield
 
        rec1 rec2 rec
        regex prefix suffix surround
@@ -43,7 +43,7 @@ C<perl -c normalize.pl>.
 
 Normalisation can generate multiple output normalized data. For now, supported output
 types (on the left side of definition) are: C<tag>, C<display>, C<search> and
-C<marc21>.
+C<marc>.
 
 =head1 FUNCTIONS
 
@@ -109,9 +109,7 @@ Return hash formatted as data structure
 
 =cut
 
-my $out;
-my $marc21;
-my $marc_encoding;
+my ($out,$marc_record, $marc_encoding, $marc_repeatable_subfield, $marc_indicators);
 
 sub _get_ds {
        return $out;
@@ -127,8 +125,7 @@ Clean data structure hash for next record
 
 sub _clean_ds {
        my $a = {@_};
-       $out = undef;
-       $marc21 = undef;
+       ($out,$marc_record, $marc_encoding, $marc_repeatable_subfield, $marc_indicators) = (undef);
        $marc_encoding = $a->{marc_encoding};
 }
 
@@ -146,11 +143,11 @@ sub _set_lookup {
        $lookup = shift;
 }
 
-=head2 _get_marc21_fields
+=head2 _get_marc_fields
 
-Get all fields defined by calls to C<marc21>
+Get all fields defined by calls to C<marc>
 
-       $marc->add_fields( WebPAC::Normalize:_get_marc21_fields() );
+       $marc->add_fields( WebPAC::Normalize:_get_marc_fields() );
 
 
 
@@ -161,19 +158,22 @@ Repeatable field is created if there is second occurence of same subfield or
 if any of indicators are different. This is sane for most cases except for
 non-repeatable fields with repeatable subfields.
 
-B<TODO>: implement exceptions to magic
+You can change behaviour of that using C<marc_repeatable_subfield>.
 
 =cut
 
-sub _get_marc21_fields {
+sub _get_marc_fields {
        my @m;
        my $last;
-       foreach my $row (@{ $marc21 }) {
+       foreach my $row (@{ $marc_record }) {
                if ($last &&
                        $last->[0] eq $row->[0] &&              # check if field is same
                        $last->[1] eq $row->[1] &&              # check for i1
                        $last->[2] eq $row->[2] &&              # and for i2
-                       $last->[3] ne $row->[3]                 # and subfield is different
+                               ( $last->[3] ne $row->[3] ||                            # and subfield is different
+                               $last->[3] eq $row->[3] &&                                      # or subfield is same,
+                               $marc_repeatable_subfield->{ $row->[3] }        # but is repeatable
+                       )
                ) {
                        push @$last, ( $row->[3] , $row->[4] );
                        warn "## ++ added $row->[0] ^$row->[3] to $last->[0]\n";
@@ -244,28 +244,70 @@ sub search {
        $out->{$name}->{search} = \@o;
 }
 
-=head2 marc21
+=head2 marc
 
 Save value for MARC field
 
-  marc21('900','a', rec('200','a') );
+  marc('900','a', rec('200','a') );
 
 =cut
 
-sub marc21 {
-       my $f = shift or die "marc21 needs field";
-       die "marc21 field must be numer" unless ($f =~ /^\d+$/);
+sub marc {
+       my $f = shift or die "marc needs field";
+       die "marc field must be numer" unless ($f =~ /^\d+$/);
 
-       my $sf = shift or die "marc21 needs subfield";
+       my $sf = shift or die "marc needs subfield";
 
        foreach (@_) {
                my $v = $_;             # make var read-write for Encode
                next unless (defined($v) && $v !~ /^\s*$/);
                from_to($v, 'iso-8859-2', $marc_encoding) if ($marc_encoding);
-               push @{ $marc21 }, [ $f, ' ', ' ', $sf => $v ];
+               push @{ $marc_record }, [
+                       $f,
+                       $marc_indicators->{$f}->{i1} || ' ',
+                       $marc_indicators->{$f}->{i2} || ' ',
+                       $sf => $v
+               ];
        }
 }
 
+=head2 marc_repeatable_subfield
+
+Save values for MARC repetable subfield
+
+  marc_repeatable_subfield('910', 'z', rec('909') );
+
+=cut
+
+sub marc_repeatable_subfield {
+       die "marc_repeatable_subfield need subfield!\n" unless (defined($_[1]));
+       $marc_repeatable_subfield->{ $_[1] }++;
+       marc(@_);
+}
+
+=head2 marc_indicators
+
+Set both indicators for MARC field
+
+  marc_indicators('900', ' ', 1);
+
+Any indicator value other than C<0-9> will be treated as undefined.
+
+=cut
+
+sub marc_indicators {
+       my $f = shift || die "marc_indicators need field!\n";
+       my ($i1,$i2) = @_;
+       die "marc_indicators($f, ...) need i1!\n" unless(defined($i1));
+       die "marc_indicators($f, $i1, ...) need i2!\n" unless(defined($i2));
+
+       $i1 = ' ' if ($i1 !~ /^\d$/);
+       $i2 = ' ' if ($i2 !~ /^\d$/);
+       $marc_indicators->{$f}->{i1} = $i1;
+       $marc_indicators->{$f}->{i2} = $i2;
+}
+
+
 =head1 Functions to extract data from input
 
 This function should be used inside functions to create C<data_structure> described

diff --git a/run.pl b/run.pl
index d69d16d..2e3e01d 100755 (executable)
--- a/run.pl
+++ b/run.pl
@@ -286,7 +286,7 @@ while (my ($database, $db_config) = each %{ $config->{databases} }) {
                                if ($marc_fh) {
                                        my $marc = new MARC::Record;
                                        $marc->encoding( 'utf-8' );
-                                       $marc->add_fields( WebPAC::Normalize::_get_marc21_fields() );
+                                       $marc->add_fields( WebPAC::Normalize::_get_marc_fields() );
                                        print $marc_fh $marc->as_usmarc;
                                }
 

diff --git a/t/3-normalize.t b/t/3-normalize.t
index 6e465d9..26467ef 100755 (executable)
--- a/t/3-normalize.t
+++ b/t/3-normalize.t
@@ -2,7 +2,7 @@
 
 use strict;
 
-use Test::More tests => 69;
+use Test::More tests => 75;
 use Test::Exception;
 use Cwd qw/abs_path/;
 use blib;
@@ -342,9 +342,24 @@ sub test_s {
        }, 'correct get_ds');
 
        # MARC
-       test_s(qq{ marc21('900','a', rec('200') ) });
+       test_s(qq{ marc_indicators('900',1,2) });
+       test_s(qq{ marc('900','a', rec('200') ) });
        my @marc;
-       ok(@marc = WebPAC::Normalize::_get_marc21_fields(), "_get_marc21_fields");
-       diag Dumper(\@marc);
+       ok(@marc = WebPAC::Normalize::_get_marc_fields(), "_get_marc_fields");
+
+       is_deeply( \@marc, [
+               [ '900', 1, 2, 'a', '200a' ],
+               [ '900', 1, 2, 'a', '200-solo' ]
+       ], 'correct marc with indicators');
+
+       test_s(qq{ marc_indicators('900',' ',9) });
+       test_s(qq{ marc_repeatable_subfield('900','a', rec('200') ) });
+
+       ok(@marc = WebPAC::Normalize::_get_marc_fields(), "_get_marc_fields");
+
+       is_deeply( \@marc, [
+               [ '900', 1, 2, 'a', '200a', 'a', '200-solo' ],
+               [ '900', ' ', 9, 'a', '200a', 'a', '200-solo' ]
+       ], 'correct marc with repetable subfield');
 }