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