view release on metacpan or  search on metacpan

lib/Business/LCCN.pm  view on Meta::CPAN

            $out{serial}                = ( defined $3 ? $3 : $4 );
            $out{suffix_encoded}        = ( defined($5) ? $5 : '' );
            $out{revision_year_encoded} = $6;
            $out{revision_number}       = ( $7 || undef );

            # per http://www.loc.gov/marc/marbi/dp/dp84.html and
            # http://en.wikipedia.org/wiki/Library_of_Congress_Control_Number,
            # the first LCCNs were assigned in 1898, and there were fewer than
            # 8000 LCCns issued each of those years

            if ( $out{year_encoded} eq '98' ) {
                if ( $out{serial} < 3000 ) {
                    $out{year_cataloged} = 1898;
                } else {
                    $out{year_cataloged} = 1998;
                }
            } elsif ( $out{year_encoded} eq '99' ) {
                if ( $out{serial} < 6000 ) {
                    $out{year_cataloged} = 1899;
                } else {
                    $out{year_cataloged} = 1999;
                }
            } elsif ( $out{year_encoded} eq '00' ) {
                if ( $out{serial} < 8000 ) {
                    $out{year_cataloged} = 1900;
                } else {
                    $out{year_cataloged} = 2000;
                }
            } elsif ( $out{year_encoded} eq '50' ) {
                $out{lccn_externally_created_flag} = 1;    # zzz
            } elsif ( $out{year_encoded} =~ m/^7\d$/ ) {
                if ( _verify_7_checksum( $out{year_encoded}, $out{serial} ) )
                {
                    $out{lccn_structure_series} = 7;
                } else {
                    $out{year_cataloged} = $out{year_encoded} + 1900;
                }
            } else {
                $out{year_cataloged} = $out{year_encoded} + 1900;
            }

            if ( defined $out{revision_year_encoded}
                 and length $out{revision_year_encoded} ) {
                if (    $out{revision_year_encoded} == 98
                     or $out{revision_year_encoded} == 99 ) {
                    $out{revision_year} = $out{revision_year_encoded} + 1800;
                } else {
                    $out{revision_year} = $out{revision_year_encoded} + 1900;
                }
            }

        } else {
            if ( $input !~ m/\d\d/ ) {
                carp
                    qq{LCCN input "$input" doesn't contain enough numbers. Please check the input and try again.}
                    if $emit_warnings;
            } elsif ( $input =~ m/^\s*(0(?:01|10))\b/ ) {
                carp
                    qq{LCCN input "$input" starts with "$1", suggesting you've copied in part of a MARC record. Please remove MARC record formatting from the LCCN.}
                    if $emit_warnings;
            } elsif ( $input =~ m/^\s*(\$[ab])\b/ ) {
                carp
                    qq{LCCN $input "input" starts with "$1", suggesting you've copied in part of a MARC record. Please remove MARC record formatting from the LCCN.}
                    if $emit_warnings;
            } elsif ( $input =~ m/#/ ) {
                carp
                    qq{LCCN input "$input" contains "#" characters, which are sometimes used as placeholders for spaces Please remove the "#" characters from the LCCN input.}
                    if $emit_warnings;
            } elsif ( $input =~ m/^\s*(_[a-z])\b\s*/ ) {
                carp
                    qq{LCCN input "$input" starts with "$1", which may be MARC formatting. Please remove any such formatting from the LCCN.}
                    if $emit_warnings;
            } else {
                carp qq{LCCN input "$input" cannot be parsed.}
                    if $emit_warnings;
            }

            return;
        }

        my $req_prefix_length = ( $out{lccn_structure} eq 'A' ? 3 : 2 );

        # fixup serial
        $out{serial} = sprintf '%06i', $out{serial};

        # fixup prefix
        if ( defined $out{prefix_encoded} ) {
            $out{prefix_encoded} =~ s/^\s+|\s+$//;
            $out{prefix_encoded} = lc $out{prefix_encoded};
            unless ( length $out{prefix_encoded} == $req_prefix_length ) {
                $out{prefix_encoded} .= ' '
                    x ( $req_prefix_length - length $out{prefix_encoded} );
            }

            $out{prefix} = $out{prefix_encoded};
            $out{prefix} =~ s/\s+//g;
        }

        # fixup suffix
        if ( !defined $out{suffix_encoded} ) {
            $out{suffix_encoded} = '';
        }

        # fixup revision year
        if ( !defined $out{revision_year_encoded} ) {
            $out{revision_year_encoded} = '';
        }

        $next->( $self, \%out );
    }
};

sub _canonical {
    my $self = shift;
    if ( $self->lccn_structure eq 'B' ) {
        return
            sprintf( "%- 2s%4i%06i",
                     $self->prefix, $self->year_encoded, $self->serial );
    } elsif ( $self->lccn_structure eq 'A' ) {
        my $string =
            sprintf( "%- 3s%02i%06i %s",