view release on metacpan or  search on metacpan

lib/MARC/Lint.pm  view on Meta::CPAN

=head1 SEE ALSO

Check the docs for L<MARC::Record>.  All software links are there.

=head1 TODO

=over 4

=item * Subfield 6

For subfield 6, it should always be the 1st subfield according to MARC 21 specifications. Perhaps a generic check should be added that warns if subfield 6 is not the 1st subfield.

=item * Subfield 8.

This subfield could be the 1st or 2nd subfield, so the code that checks for the 1st few subfields (check_245, check_250) should take that into account.

=item * Subfield 9

This subfield is not officially allowed in MARC, since it is locally defined. Some way needs to be made to allow messages/warnings about this subfield to be turned off (or otherwise deal with records using/allowing locally defined subfield 9).

=item * 008 length and presence check

Currently, 008 validation is not implemented in MARC::Lint, but is left to MARC::Errorchecks. It might be useful if MARC::Lint's basic validation checks included a verification that the 008 exists and is exactly 40 characters long. Additional 008-rel...

=item * ISBN and ISSN checking

020 and 022 fields are validated with the C<Business::ISBN> and
C<Business::ISSN> modules, respectively. Business::ISBN versions between 2 and
2.02_01 are incompatible with MARC::Lint.

=item * check_041 cleanup

Splitting subfield code strings every 3 chars could probably be written more efficiently.

=item * check_245 cleanup

The article checking in particular.

=item * Method for turning off checks

Provide a way for users to skip checks more easily when using check_record, or a
specific check_xxx method (e.g. skip article checking).

=back

=head1 LICENSE

This code may be distributed under the same terms as Perl itself.

Please note that these modules are not products of or supported by the
employers of the various contributors to the code.

=cut

# Used only to read the stuff from __DATA__
sub _read_rules {
    my $self = shift;

    my $tell = tell(DATA);  # Stash the position so we can reset it for next time

    local $/ = "";
    while ( my $tagblock = <DATA> ) {
        my @lines = split( /\n/, $tagblock );
        s/\s+$// for @lines;

        next unless @lines >= 4; # Some of our entries are tag-only

        my $tagline = shift @lines;
        my @keyvals = split( /\s+/, $tagline, 3 );
        my $tagno = shift @keyvals;
        my $repeatable = shift @keyvals;

        $self->_parse_tag_rules( $tagno, $repeatable, @lines );
    } # while

    # Set the pointer back to where it was, in case we do this again
    seek( DATA, $tell, 0 );
}

sub _parse_tag_rules {
    my $self = shift;
    my $tagno = shift;
    my $repeatable = shift;
    my @lines = @_;

    my $rules = ($self->{_rules}->{$tagno} ||= {});
    $rules->{'repeatable'} = $repeatable;

    for my $line ( @lines ) {
        my @keyvals = split( /\s+/, $line, 3 );
        my $key = shift @keyvals;
        my $val = shift @keyvals;

        # Do magic for indicators
        if ( $key =~ /^ind/ ) {
            $rules->{$key} = $val;

            my $desc;
            my $regex;

            if ( $val eq "blank" ) {
                $desc = "blank";
                $regex = qr/^ $/;
            } else {
                $desc = _nice_list($val);
                $val =~ s/^b/ /;
                $regex = qr/^[$val]$/;
            }

            $rules->{$key."_desc"} = $desc;
            $rules->{$key."_regex"} = $regex;
        } # if indicator
        else {
            if ( $key =~ /(.)-(.)/ ) {
                my ($min,$max) = ($1,$2);
                $rules->{$_} = $val for ($min..$max);
            } else {
                $rules->{$key} = $val;
            }
        } # not an indicator
    } # for $line