r57346 - in /branches/upstream/libmarc-record-perl/current: ./ lib/MARC/ lib/MARC/Doc/ lib/MARC/File/ t/

chrisb at users.alioth.debian.org chrisb at users.alioth.debian.org
Sun May 2 17:31:45 UTC 2010


Author: chrisb
Date: Sun May  2 17:31:16 2010
New Revision: 57346

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=57346
Log:
[svn-upgrade] Integrating new upstream version, libmarc-record-perl (2.0.1)

Added:
    branches/upstream/libmarc-record-perl/current/t/67.subfield.t
    branches/upstream/libmarc-record-perl/current/t/delete-field.t
    branches/upstream/libmarc-record-perl/current/t/extra_controlfields.t
    branches/upstream/libmarc-record-perl/current/t/filler.t   (with props)
    branches/upstream/libmarc-record-perl/current/t/filler.usmarc   (with props)
Modified:
    branches/upstream/libmarc-record-perl/current/Changes
    branches/upstream/libmarc-record-perl/current/MANIFEST
    branches/upstream/libmarc-record-perl/current/META.yml
    branches/upstream/libmarc-record-perl/current/Makefile.PL
    branches/upstream/libmarc-record-perl/current/README
    branches/upstream/libmarc-record-perl/current/lib/MARC/Batch.pm
    branches/upstream/libmarc-record-perl/current/lib/MARC/Doc/Tutorial.pod
    branches/upstream/libmarc-record-perl/current/lib/MARC/Field.pm
    branches/upstream/libmarc-record-perl/current/lib/MARC/File.pm
    branches/upstream/libmarc-record-perl/current/lib/MARC/File/USMARC.pm
    branches/upstream/libmarc-record-perl/current/lib/MARC/Record.pm
    branches/upstream/libmarc-record-perl/current/t/60.insert.t

Modified: branches/upstream/libmarc-record-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmarc-record-perl/current/Changes?rev=57346&op=diff
==============================================================================
--- branches/upstream/libmarc-record-perl/current/Changes (original)
+++ branches/upstream/libmarc-record-perl/current/Changes Sun May  2 17:31:16 2010
@@ -1,4 +1,23 @@
 Revision history for Perl extension MARC::Record.
+
+2.0.1 Sat May  1 15:59:54 EDT 2010
+        [ENHANCEMENTS]
+        - improve support for subclassing MARC::Field (Dan Wells)
+        - RT#55993: MARC::Record->insert_fields_after can now insert 
+          after last field in record (Frédéric Demians)
+        - added methods to MARC::Field to allow a (class-level) list of 
+          fields that should be considered control fields in addition 
+          to 001-009. Includes test t/extra_controlfields.t, and 
+          supports alphabetic characters in the tag labels.  The new 
+          methods are
+               allow_controlfield_tags
+               disallow_controlfield_tags
+               is_controlfield_tag
+          (Bill Dueber)
+        - added MARC::Record::delete_fields() and t/delete-field.t 
+          (Ed Summers)
+        - documentation improvements (Mike Rylander and Dan Scott)
+        - baked in minimum Perl version required: 5.8.2
 
 2.0
         [THINGS THAT MAY BREAK YOUR CODE]

Modified: branches/upstream/libmarc-record-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmarc-record-perl/current/MANIFEST?rev=57346&op=diff
==============================================================================
--- branches/upstream/libmarc-record-perl/current/MANIFEST (original)
+++ branches/upstream/libmarc-record-perl/current/MANIFEST Sun May  2 17:31:16 2010
@@ -1,19 +1,17 @@
+bin/marcdump
 Changes
-MANIFEST
-Makefile.PL
-META.yml
-README
-bin/marcdump
-
 lib/MARC/Batch.pm
 lib/MARC/Doc/Tutorial.pod
 lib/MARC/Field.pm
+lib/MARC/File.pm
 lib/MARC/File/Encode.pm
 lib/MARC/File/MicroLIF.pm
-lib/MARC/File.pm
 lib/MARC/File/USMARC.pm
 lib/MARC/Record.pm
-
+Makefile.PL
+MANIFEST
+META.yml
+README
 t/00.load.t
 t/10.camel.t
 t/11.astring.t
@@ -29,6 +27,7 @@
 t/64.create.t
 t/66.grouped.t
 t/66.ordered.t
+t/67.subfield.t
 t/70.croak.t
 t/75.warnings.t
 t/80.alphatag.t
@@ -45,19 +44,23 @@
 t/cameleof.usmarc
 t/convenience.t
 t/decode-filter.t
+t/delete-field.t
 t/delete-subfield.t
 t/dosEOF.t
+t/extra_controlfields.t
 t/file-filter.t
 t/file-header.t
+t/filler.t
+t/filler.usmarc
 t/lineendings-0a.lif
+t/lineendings-0d.lif
 t/lineendings-0d0a.lif
-t/lineendings-0d.lif
 t/lineendings.t
+t/pod-coverage.t
 t/pod.t
-t/pod-coverage.t
-t/sample100.lif
 t/sample1.lif
 t/sample1.usmarc
+t/sample100.lif
 t/sample1eof.usmarc
 t/sample20.lif
 t/title_proper.t

Modified: branches/upstream/libmarc-record-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmarc-record-perl/current/META.yml?rev=57346&op=diff
==============================================================================
--- branches/upstream/libmarc-record-perl/current/META.yml (original)
+++ branches/upstream/libmarc-record-perl/current/META.yml Sun May  2 17:31:16 2010
@@ -1,14 +1,25 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
-name:         MARC-Record
-version:      2.0.0
-version_from: lib/MARC/Record.pm
-installdirs:  site
+--- #YAML:1.0
+name:               MARC-Record
+version:            2.0.1
+abstract:           Perl extension for handling MARC records
+author:
+    - Galen Charlton <gmcharlt at gmail.com>
+license:            unknown
+distribution_type:  module
+configure_requires:
+    ExtUtils::MakeMaker:  0
+build_requires:
+    ExtUtils::MakeMaker:  0
 requires:
-    Carp:                          0
-    File::Find:                    0
-    File::Spec:                    0
-    Test::More:                    0
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.30
+    Carp:        0
+    File::Find:  0
+    File::Spec:  0
+    Test::More:  0
+no_index:
+    directory:
+        - t
+        - inc
+generated_by:       ExtUtils::MakeMaker version 6.52
+meta-spec:
+    url:      http://module-build.sourceforge.net/META-spec-v1.4.html
+    version:  1.4

Modified: branches/upstream/libmarc-record-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmarc-record-perl/current/Makefile.PL?rev=57346&op=diff
==============================================================================
--- branches/upstream/libmarc-record-perl/current/Makefile.PL (original)
+++ branches/upstream/libmarc-record-perl/current/Makefile.PL Sun May  2 17:31:16 2010
@@ -1,5 +1,5 @@
 # vi:et:sw=4 ts=4
-require v5.8.1;
+require v5.8.2;
 use strict;
 use ExtUtils::MakeMaker;
 
@@ -9,7 +9,7 @@
     VERSION_FROM    => 'lib/MARC/Record.pm',
     ABSTRACT_FROM   => 'lib/MARC/Record.pm',
     PMLIBDIRS       => [ qw( lib/ ) ],
-    AUTHOR          => 'Andy Lester <andy at petdance.com>',
+    AUTHOR          => 'Galen Charlton <gmcharlt at gmail.com>',
     PREREQ_PM       => {
         'Test::More' => 0,
         'File::Spec' => 0,

Modified: branches/upstream/libmarc-record-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmarc-record-perl/current/README?rev=57346&op=diff
==============================================================================
--- branches/upstream/libmarc-record-perl/current/README (original)
+++ branches/upstream/libmarc-record-perl/current/README Sun May  2 17:31:16 2010
@@ -41,13 +41,10 @@
 
 DEPENDENCIES
 
-MARC::Record now requires a perl version >= 5.8.1 for processing unicode
+MARC::Record now requires a perl version >= 5.8.2 for processing unicode
 correctly.
 
 COPYRIGHT AND LICENCE
 
 This software is free software and may be distributed under the same
 terms as Perl itself .
-
-Copyright (C) 2001-2002 Andy Lester <marc at petdance.com>
-

Modified: branches/upstream/libmarc-record-perl/current/lib/MARC/Batch.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmarc-record-perl/current/lib/MARC/Batch.pm?rev=57346&op=diff
==============================================================================
--- branches/upstream/libmarc-record-perl/current/lib/MARC/Batch.pm (original)
+++ branches/upstream/libmarc-record-perl/current/lib/MARC/Batch.pm Sun May  2 17:31:16 2010
@@ -11,6 +11,11 @@
 multiple-file aspects.
 
     use MARC::Batch;
+
+    # If you have werid control fields...
+    use MARC::Field;
+    MARC::Field->allow_controlfield_tags('FMT', 'LDX');    
+    
 
     my $batch = MARC::Batch->new( 'USMARC', @files );
     while ( my $marc = $batch->next ) {

Modified: branches/upstream/libmarc-record-perl/current/lib/MARC/Doc/Tutorial.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmarc-record-perl/current/lib/MARC/Doc/Tutorial.pod?rev=57346&op=diff
==============================================================================
--- branches/upstream/libmarc-record-perl/current/lib/MARC/Doc/Tutorial.pod (original)
+++ branches/upstream/libmarc-record-perl/current/lib/MARC/Doc/Tutorial.pod Sun May  2 17:31:16 2010
@@ -33,7 +33,7 @@
 version at CPAN: http://www.cpan.org/modules/by-module/MARC/. You'll notice
 that some sections aren't filled in yet, which is a result of this document
 being a work in progress. If you have ideas for new sections please make a
-suggestion to perl4lib: http://www.rice.edu/perl4lib/.
+suggestion to perl4lib: http://perl4lib.perl.org/.
 
 =head2 History of MARC on CPAN
 

Modified: branches/upstream/libmarc-record-perl/current/lib/MARC/Field.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmarc-record-perl/current/lib/MARC/Field.pm?rev=57346&op=diff
==============================================================================
--- branches/upstream/libmarc-record-perl/current/lib/MARC/Field.pm (original)
+++ branches/upstream/libmarc-record-perl/current/lib/MARC/Field.pm Sun May  2 17:31:16 2010
@@ -16,6 +16,9 @@
 =head1 SYNOPSIS
 
   use MARC::Field;
+
+  # If your system uses wacky control field tags, add them
+  MARC::Field->allow_controlfield_tags('FMT', 'LLE');
 
   my $field = MARC::Field->new( 245, '1', '0',
        'a' => 'Raccoons and ripe corn / ',
@@ -33,6 +36,18 @@
 None by default.  Any errors are stored in C<$MARC::Field::ERROR>, which
 C<$MARC::Record> usually bubbles up to C<$MARC::Record::ERROR>.
 
+=head1 CLASS VARIABLES
+
+B<extra_controlfield_tags>: Some systems (notably Ex Libris's Aleph) throw
+extra control fields in their MARC (e.g., Aleph's MARC-XML tends to have a 
+C<FMT> control field). We keep a class-level hash to track to track them; it can
+be manipulated with C<allow_controlfield_tags> and c<disallow_controlfield_tags>.
+
+=cut
+
+my %extra_controlfield_tags = ();
+
+
 =head1 METHODS
 
 =head2 new()
@@ -47,7 +62,7 @@
        'c' => 'Jim Arnosky.'
   );
 
-Or if you want to add a field < 010 that does not have indicators.
+Or if you want to add a control field (< 010) that does not have indicators.
 
   my $field = MARC::Field->new( '001', ' 14919759' );
 
@@ -59,11 +74,14 @@
 
     ## MARC spec indicates that tags can have alphabetical
     ## characters in them! If they do appear we assume that
-    ## they have indicators like tags > 010
+    ## they have indicators like tags > 010 unless they've
+    ## been previously defined as control tags using
+    ## add_controlfield
+    
     my $tagno = shift;
     ($tagno =~ /^[0-9A-Za-z]{3}$/)
         or croak( "Tag \"$tagno\" is not a valid tag." );
-    my $is_control = (($tagno =~ /^\d+$/) && ($tagno < 10));
+    my $is_control = $class->is_controlfield_tag($tagno);
 
     my $self = bless {
         _tag => $tagno,
@@ -73,10 +91,12 @@
 
     if ( $is_control ) {
         $self->{_data} = shift;
+        $self->_warn("Too much data for control field '$tagno'") if (@_);
     } else {
         for my $indcode ( qw( _ind1 _ind2 ) ) {
             my $indicator = shift;
-            if ( $indicator !~ /^[0-9A-Za-z ]$/ ) {
+            scalar(@_) or croak("Field $tagno must have indicators (use ' ' for empty indicators)");
+            if ($indicator !~ /^[0-9A-Za-z ]$/ ) {
                 $self->_warn( "Invalid indicator \"$indicator\" forced to blank" ) unless ($indicator eq "");
                 $indicator = " ";
             }
@@ -117,7 +137,7 @@
     my $self = shift;
     my $indno = shift;
 
-    $self->_warn( "Fields below 010 do not have indicators" )
+    $self->_warn( "Control fields (generally, those with tags below 010) do not have indicators" )
         if $self->is_control_field;
 
     if ( $indno == 1 ) {
@@ -129,6 +149,57 @@
     }
 }
 
+=head2 allow_controlfield_tags($tag, $tag2, ...)
+
+Add $tags to class-level list of strings to consider valid control fields tags (in addition to 001 through 009).
+Tags must have three characters. 
+
+=cut
+
+sub allow_controlfield_tags {
+  my $self = shift;
+  foreach my $tag (@_) {
+    $extra_controlfield_tags{$tag} = 1;
+  }
+}
+
+=head2 disallow_controlfield_tags($tag, $tag2, ...)
+=head2 disallow_controlfield_tags('*')
+
+Revoke the validity of a control field tag previously added with allow_controlfield_tags. As a special case, 
+if you pass the string '*' it will clear out all previously-added tags.
+
+NOTE that this will only deal with stuff added with allow_controlfield_tags; you can't disallow '001'.
+
+=cut
+
+sub disallow_controlfield_tags {
+  my $self = shift;
+  if ($_[0] eq '*') {
+    %extra_controlfield_tags = ();
+    return;
+  }
+  foreach my $tag (@_) {
+    delete $extra_controlfield_tags{$tag};
+  }
+}
+
+=head2 is_controlfield_tag($tag) -- does the given tag denote a control field?
+
+Generally called as a class method (e.g., MARC::Field->is_controlfield_tag('001'))
+
+=cut
+
+sub is_controlfield_tag
+{
+  my $self = shift;
+  my $tag = shift;
+  return 1 if ($extra_controlfield_tags{$tag});
+  return 1 if (($tag =~ /^\d+$/) && ($tag < 10));
+  return 0; # otherwise, it's not a control field
+}
+
+
 =head2 is_control_field()
 
 Tells whether this field is one of the control tags from 001-009.
@@ -155,7 +226,7 @@
 If no matching subfields are found, C<undef> is returned in a scalar context
 and an empty list in a list context.
 
-If the tag is less than an 010, C<undef> is returned and
+If the tag is a control field, C<undef> is returned and
 C<$MARC::Field::ERROR> is set.
 
 =cut
@@ -164,7 +235,7 @@
     my $self = shift;
     my $code_wanted = shift;
 
-    croak( "Fields below 010 do not have subfields, use data()" )
+    croak( "Control fields (generally, just tags below 010) do not have subfields, use data()" )
         if $self->is_control_field;
 
     my @data = @{$self->{_subfields}};
@@ -197,7 +268,7 @@
 sub subfields {
     my $self = shift;
 
-    $self->_warn( "Fields below 010 do not have subfields" )
+    $self->_warn( "Control fields (generally, just tags below 010)  do not have subfields" )
         if $self->is_control_field;
 
     my @list;
@@ -217,7 +288,7 @@
 sub data {
     my $self = shift;
 
-    croak( "data() is only for tags less than 010, use subfield()" )
+    croak( "data() is only for control fields (generally, just tags below 010) , use subfield()" )
         unless $self->is_control_field;
 
     $self->{_data} = $_[0] if @_;
@@ -238,7 +309,7 @@
 sub add_subfields {
     my $self = shift;
 
-    croak( "Subfields are only for tags >= 10" )
+    croak( "Subfields are only for data fields (generally, just tags >= 010)" )
         if $self->is_control_field;
 
     push( @{$self->{_subfields}}, @_ );
@@ -501,14 +572,14 @@
 =head2 as_usmarc()
 
 Returns a string for putting into a USMARC file.  It's really only
-useful by C<MARC::Record::as_usmarc()>.
+useful for C<MARC::Record::as_usmarc()>.
 
 =cut
 
 sub as_usmarc() {
     my $self = shift;
 
-    # Tags < 010 are pretty easy
+    # Control fields are pretty easy
     if ( $self->is_control_field ) {
         return $self->data . END_OF_FIELD;
     } else {
@@ -545,7 +616,7 @@
     my $self = shift;
 
     my $tagno = $self->{_tag};
-    my $is_control = (($tagno =~ /^\d+$/) && ($tagno < 10));
+    my $is_control = $self->is_controlfield_tag($tagno);
 
     my $clone =
         bless {

Modified: branches/upstream/libmarc-record-perl/current/lib/MARC/File.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmarc-record-perl/current/lib/MARC/File.pm?rev=57346&op=diff
==============================================================================
--- branches/upstream/libmarc-record-perl/current/lib/MARC/File.pm (original)
+++ branches/upstream/libmarc-record-perl/current/lib/MARC/File.pm Sun May  2 17:31:16 2010
@@ -14,6 +14,10 @@
 =head1 SYNOPSIS
 
     use MARC::File::USMARC;
+
+    # If you have werid control fields...
+    use MARC::Field;
+    MARC::Field->allow_controlfield_tags('FMT', 'LDX');    
 
     my $file = MARC::File::USMARC->in( $filename );
 

Modified: branches/upstream/libmarc-record-perl/current/lib/MARC/File/USMARC.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmarc-record-perl/current/lib/MARC/File/USMARC.pm?rev=57346&op=diff
==============================================================================
--- branches/upstream/libmarc-record-perl/current/lib/MARC/File/USMARC.pm (original)
+++ branches/upstream/libmarc-record-perl/current/lib/MARC/File/USMARC.pm Sun May  2 17:31:16 2010
@@ -16,6 +16,7 @@
 use vars qw( @ISA ); @ISA = qw( MARC::File );
 
 use MARC::Record qw( LEADER_LEN );
+use MARC::Field;
 use constant SUBFIELD_INDICATOR     => "\x1F";
 use constant END_OF_FIELD           => "\x1E";
 use constant END_OF_RECORD          => "\x1D";
@@ -188,7 +189,7 @@
             next unless $filter_func->( $tagno, $tagdata );
         }
 
-        if ( ($tagno =~ /^\d+$/) && ($tagno < 10) ) {
+        if ( MARC::Field->is_controlfield_tag($tagno) ) {
             $marc->append_fields( MARC::Field->new( $tagno, $tagdata ) );
         } else {
             my @subfields = split( SUBFIELD_INDICATOR, $tagdata );

Modified: branches/upstream/libmarc-record-perl/current/lib/MARC/Record.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmarc-record-perl/current/lib/MARC/Record.pm?rev=57346&op=diff
==============================================================================
--- branches/upstream/libmarc-record-perl/current/lib/MARC/Record.pm (original)
+++ branches/upstream/libmarc-record-perl/current/lib/MARC/Record.pm Sun May  2 17:31:16 2010
@@ -16,12 +16,12 @@
 
 =head1 VERSION
 
-Version 2.0.0
+Version 2.0.1
 
 =cut
 
 use vars qw( $VERSION );
-$VERSION = '2.0.0';
+$VERSION = '2.0.1';
 
 use Exporter;
 use vars qw( @ISA @EXPORTS @EXPORT_OK );
@@ -245,7 +245,7 @@
 
 sub _all_parms_are_fields {
     for ( @_ ) {
-        return 0 unless ref($_) eq 'MARC::Field';
+        return 0 unless UNIVERSAL::isa($_, 'MARC::Field');
     }
     return 1;
 }
@@ -327,13 +327,17 @@
     ## find position of $after
     my $fields = $self->{_fields};
     my $pos = 0;
+    my $found = 0;
     foreach my $f (@$fields) {
-        last if ($f == $after);
+        if ($f == $after) {
+            $found = 1;
+            last;
+        }
         $pos++;
     }
 
     ## insert after $after
-    if ($pos+1 >= @$fields) {
+    unless ($found) {
         $self->_warn("Couldn't find field to insert after");
         return;
     }
@@ -417,31 +421,41 @@
 }
 
 
-=head2 delete_field( $field )
-
-Deletes a field from the record.
-
-The field must have been retrieved from the record using the
-C<field()> method.  For example, to delete a 526 tag if it exists:
-
-    my $tag526 = $marc->field( "526" );
-    if ( $tag526 ) {
-        $marc->delete_field( $tag526 );
-    }
-
-C<delete_field()> returns the number of fields that were deleted.
-This shouldn't be 0 unless you didn't get the tag properly.
+=head2 delete_fields( $field )
+
+Deletes a given list of MARC::Field objects from the the record.
+
+    # delete all note fields
+    my @notes = $record->field('5..');
+    $record->delete_fields(@notes);
+
+delete_fields() will return the number of fields that were deleted.
+
+=cut
+
+sub delete_fields {
+    my $self = shift;
+    _all_parms_are_fields(@_) or croak('Arguments must be MARC::Field object');
+    my @fields = @{$self->{_fields}};
+    my $original_count = @fields;
+
+    foreach my $deleter (@_) {
+        @fields = grep { $_ != $deleter } @fields;
+    }
+    $self->{_fields} = \@fields;
+
+    return $original_count - @fields;
+}
+
+=head2 delete_field()
+
+Same thing as delete_fields() but only expects a single MARC::Field to be passed
+in. Mainly here for backwards compatibility.
 
 =cut
 
 sub delete_field {
-    my $self = shift;
-    my $deleter = shift;
-    my $list = $self->{_fields};
-
-    my $old_count = @$list;
-    @$list = grep { $_ != $deleter } @$list;
-    return $old_count - @$list;
+    return delete_fields(@_);
 }
 
 =head2 as_usmarc()
@@ -525,10 +539,10 @@
 
     # when setting
     if ( defined($arg) ) {
-        if ( $arg =~ /UTF-8/i ) { 
+        if ( $arg =~ /UTF-?8/i ) { 
             substr($leader,9,1) = 'a';
         }
-        elsif ( $arg =~ /MARC-8/i ) {
+        elsif ( $arg =~ /MARC-?8/i ) {
             substr($leader,9,1) = ' ';
         }
         $self->leader($leader);
@@ -547,6 +561,9 @@
     my $self = shift;
     my $reclen = shift;
     my $baseaddr = shift;
+    if ($reclen > 99999) {
+            carp( "Record length of $reclen is larger than the MARC spec allows (99999 bytes)." );
+    }
     substr($self->{_leader},0,5)  = sprintf("%05d",$reclen);
     substr($self->{_leader},12,5) = sprintf("%05d",$baseaddr);
     # MARC21 defaults: http://www.loc.gov/marc/bibliographic/ecbdldrd.html
@@ -678,7 +695,7 @@
             last; # Bail out, we're done eating parms
 
         # User handed us an object.
-        } elsif ( ref($parm) eq "MARC::Field" ) {
+        } elsif ( UNIVERSAL::isa($parm, 'MARC::Field') ) {
             push( @$fields, $parm );
             ++$nfields;
 
@@ -765,7 +782,7 @@
 
 =over 4
 
-=item * perl4lib (L<http://www.rice.edu/perl4lib/>)
+=item * perl4lib (L<http://perl4lib.perl.org/>)
 
 A mailing list devoted to the use of Perl in libraries.
 
@@ -779,7 +796,7 @@
 Online version of the free booklet.  An excellent overview of the MARC format.  Essential.
 
 
-=item * Tag Of The Month (L<http://www.tagofthemonth.com/>)
+=item * Tag Of The Month (L<http://www.follettsoftware.com/sub/tag_of_the_month/>)
 
 Follett Software Company's
 (L<http://www.fsc.follett.com/>) monthly discussion of various MARC tags.
@@ -846,9 +863,19 @@
 Please note that these modules are not products of or supported by the
 employers of the various contributors to the code.
 
-=head1 AUTHOR
-
-Andy Lester, C<< <andy at petdance.com> >>
-
-=cut
-
+=head1 AUTHORS
+
+=over 4
+
+=item * Andy Lester 
+
+=item * Mike O'Regan
+
+=item * Ed Summers
+
+=item * Mike Rylander
+
+=back
+
+=cut
+

Modified: branches/upstream/libmarc-record-perl/current/t/60.insert.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmarc-record-perl/current/t/60.insert.t?rev=57346&op=diff
==============================================================================
--- branches/upstream/libmarc-record-perl/current/t/60.insert.t (original)
+++ branches/upstream/libmarc-record-perl/current/t/60.insert.t Sun May  2 17:31:16 2010
@@ -4,7 +4,7 @@
 use integer;
 use File::Spec;
 
-use Test::More tests=>16;
+use Test::More tests=>20;
 
 BEGIN {
     use_ok( 'MARC::Batch' );
@@ -121,6 +121,20 @@
 $n = $record->delete_field($newagain);
 is( $n, 1 );
 
+# marker field for last field of record - testing rt55993
+my $new999 = MARC::Field->new('999', ' ', ' ', a => 'last field');
+$nappended = $record->append_fields($new999);
+is ( $nappended, 1, 'added 999 field as last field (RT#55993 test)' );
+
+$nadds = $record->insert_fields_after($new999,$newagain);
+
+is( $nadds, 1, 'added 650 after last field in record (RT#55993 test)' );
+
+$n = $record->delete_field($newagain);
+is( $n, 1 );
+
+$n = $record->delete_field($new999);
+is( $n, 1, 'deleted 999 field' );
 
 ## test insert_record_before
 

Added: branches/upstream/libmarc-record-perl/current/t/67.subfield.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmarc-record-perl/current/t/67.subfield.t?rev=57346&op=file
==============================================================================
--- branches/upstream/libmarc-record-perl/current/t/67.subfield.t (added)
+++ branches/upstream/libmarc-record-perl/current/t/67.subfield.t Sun May  2 17:31:16 2010
@@ -1,0 +1,29 @@
+#!perl -Tw
+
+use Test::More tests => 6; 
+
+use strict;
+
+## make sure that MARC::Field::subfield() is aware of the context 
+## in which it is called. In list context it returns *all* subfields
+## and in scalar just the first.
+
+use_ok( 'MARC::Field' );
+my $field = MARC::Field->new( '245', '', '', a=>'foo', b=>'bar', a=>'baz' );
+isa_ok( $field, 'MARC::Field' );
+
+my $subfieldA = $field->subfield( 'a' );
+is( $subfieldA, 'foo', 'subfield() in scalar context' );
+
+my @subfieldsA = $field->subfield( 'a' );
+is( $subfieldsA[0], 'foo', 'subfield() in list context 1' );
+is( $subfieldsA[1], 'baz', 'subfield() in list context 2' );
+
+## should not be able to call subfield on field < 010
+$field = MARC::Field->new( '000', 'foobar' );
+eval { $field->subfield( 'a' ) };
+like( 
+    $@, qr/just tags below 010/, 
+    'subfield cannot be called on fields < 010' 
+);
+

Added: branches/upstream/libmarc-record-perl/current/t/delete-field.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmarc-record-perl/current/t/delete-field.t?rev=57346&op=file
==============================================================================
--- branches/upstream/libmarc-record-perl/current/t/delete-field.t (added)
+++ branches/upstream/libmarc-record-perl/current/t/delete-field.t Sun May  2 17:31:16 2010
@@ -1,0 +1,23 @@
+use strict;
+use warnings;
+use Test::More tests => 4;
+use MARC::Record;
+
+my $record = MARC::Record->new();
+$record->append_fields(MARC::Field->new('035', '', '', 'a' => 'Foo'));
+$record->append_fields(MARC::Field->new('035', '', '', 'a' => 'Bar'));
+$record->append_fields(MARC::Field->new('035', '', '', 'a' => 'Baz'));
+
+
+my @original_035s = $record->field('035');
+is scalar(@original_035s), 3, 'found 3 035 fields';
+
+my @delete_035s = @original_035s[1..2];
+is scalar(@delete_035s), 2, 'going to delete last 2 035 fields';
+$record->delete_fields(@delete_035s);
+
+# now should have just one 035
+my @new_035s = $record->field('035');
+is scalar(@new_035s), 1, 'found 1 035 field';
+is $new_035s[0]->subfield('a'), 'Foo', 'got the right 035';
+

Added: branches/upstream/libmarc-record-perl/current/t/extra_controlfields.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmarc-record-perl/current/t/extra_controlfields.t?rev=57346&op=file
==============================================================================
--- branches/upstream/libmarc-record-perl/current/t/extra_controlfields.t (added)
+++ branches/upstream/libmarc-record-perl/current/t/extra_controlfields.t Sun May  2 17:31:16 2010
@@ -1,0 +1,62 @@
+use strict;
+use warnings;
+use Test::More tests => 31;
+use MARC::Field;
+
+# Test is_controlfield_tag
+
+foreach my $i (1..9) {
+  my $field = MARC::Field->new('00' . $i, 'TestData $i');
+  ok($field->is_control_field, "$i identified as control field");
+}
+
+# Should not be control fields
+foreach my $i qw(010 011 555 FMT) {
+  my $field = MARC::Field->new($i, 0, 0, 'a', 'Hello');
+  ok(!$field->is_control_field, "Non-control showing up as such for $i");
+}
+
+# Add the FMT
+MARC::Field->allow_controlfield_tags('FMT');
+
+foreach my $i qw(001 002 003 004 005 FMT) {
+  my $field = MARC::Field->new( $i, "TestData $i");
+  ok($field->is_control_field, "$i correctly identified as control field");
+  is($field->data, "TestData $i", "Got it back out");
+}
+
+# Take it out again
+
+MARC::Field->disallow_controlfield_tags('FMT');
+
+foreach my $i ('FMT') {
+  my $field = MARC::Field->new( $i, 0, 0, 'a', 'Test');
+  ok(!$field->is_control_field, "$i identified as data field");
+  is($field->subfield('a'), 'Test', "Got it back out");
+}
+
+# Add the FMT
+MARC::Field->allow_controlfield_tags('FMT');
+
+# See if it throws an error trying to make a datafield out of a control field
+
+foreach my $i ('FMT', '001') {
+  my $field = MARC::Field->new( $i, 0, 0, 'a', 'Test');
+  like(join(' ', $field->warnings), qr/too much data/i, "Caught error trying to make datafield out of controlfield '$i'");
+};
+
+# Take it out again
+
+MARC::Field->disallow_controlfield_tags('*');
+
+# See if it throws an error trying to make a control field out of a data field
+
+foreach my $i ('FMT', '010') {
+  eval {
+    my $field = MARC::Field->new($i, 'Test');
+  };
+  like($@, qr/must have indicators/, "Correctly got error trying to make control field out of '$i'");
+  
+}
+
+

Added: branches/upstream/libmarc-record-perl/current/t/filler.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmarc-record-perl/current/t/filler.t?rev=57346&op=file
==============================================================================
--- branches/upstream/libmarc-record-perl/current/t/filler.t (added)
+++ branches/upstream/libmarc-record-perl/current/t/filler.t Sun May  2 17:31:16 2010
@@ -1,0 +1,52 @@
+#!perl -Tw
+
+use strict;
+use integer;
+
+use File::Spec;
+
+use Test::More 'no_plan';
+
+BEGIN {
+    use_ok( 'MARC::File::USMARC' );
+}
+
+my $filename = File::Spec->catfile( 't', 'filler.usmarc' );
+my $file = MARC::File::USMARC->in( $filename );
+isa_ok( $file, 'MARC::File::USMARC', 'opened the test file' );
+
+
+my $marc;
+
+# There are exactly three records in the file, and there are
+# various problems with leading and trailing spaces, nulls,
+# and newlines.  There should be no warnings or errors
+# reading the file.
+
+$marc = $file->next();
+isa_ok( $marc, 'MARC::Record', 'got record 1' );
+is( scalar $marc->fields(), 18, 'should be 18 fields' );
+is( scalar $marc->warnings(), 0, 'should be 0 warnings' );
+ok( !defined $MARC::Record::ERROR, 'should be no errors' );
+
+$marc = $file->next();
+isa_ok( $marc, 'MARC::Record', 'got record 2' );
+is( scalar $marc->fields(), 18, 'should be 18 fields' );
+is( scalar $marc->warnings(), 0, 'should be 0 warnings' );
+ok( !defined $MARC::Record::ERROR, 'should be no errors' );
+
+$marc = $file->next();
+isa_ok( $marc, 'MARC::Record', 'got record 3' );
+is( scalar $marc->fields(), 15, 'should be 15 fields' );
+is( scalar $marc->warnings(), 0, 'should be 0 warnings' );
+ok( !defined $MARC::Record::ERROR, 'should be no errors' );
+
+# Last record has been read.  The only thing remaining
+# before eof is a newline, which should be consumed
+# by this next() and undef then returned because we're
+# at the file eof.
+$marc = $file->next();
+ok( !defined $marc, 'no record, just eof' );
+ok( !defined $MARC::Record::ERROR, 'should be no errors' );
+
+$file->close;

Propchange: branches/upstream/libmarc-record-perl/current/t/filler.t
------------------------------------------------------------------------------
    svn:executable = *

Added: branches/upstream/libmarc-record-perl/current/t/filler.usmarc
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmarc-record-perl/current/t/filler.usmarc?rev=57346&op=file
==============================================================================
Binary file - no diff available.

Propchange: branches/upstream/libmarc-record-perl/current/t/filler.usmarc
------------------------------------------------------------------------------
    svn:mime-type = application/octet-stream




More information about the Pkg-perl-cvs-commits mailing list