view release on metacpan or  search on metacpan

lib/Catmandu/Importer/MARC/Line.pm  view on Meta::CPAN

our $VERSION = '1.281';

with 'Catmandu::Importer';

sub generator {
    my ($self) = @_;
    sub {
        state $fh    = $self->fh;
        state $count = 0;

        # set input record separator to paragraph mode
        local $/ = '';

        # get next record
        while (defined(my $data = $fh->getline)) {
            $count++;
            my @record;
            my $id;
            chomp $data;

            # split record into fields
            my @fields = split /\n/, $data;

            # first field should be the MARC leader
            my $leader = shift @fields;
            if (length $leader == 24 && $leader =~ m/^\d{5}.*4500/) {
                push @record, ['LDR', ' ', ' ', '_', $leader];
            } else {
                warn "not a valid MARC leader: $leader";
            }
            for my $field (@fields) {

                # process control fields
                if ($field =~ m/^00.\s/) {
                    my ($tag, $value) = $field =~ m/^(\d{3})\s(.*)/;
                    push @record, [$tag, ' ', ' ', '_', $value];

                    # get record id
                    if ($tag eq '001') {
                        $id = $value;
                    }
                }

                # process variable data fields
                else {
                    my ($tag, $ind1, $ind2, $sf)
                        = $field =~ m/^(\d{3})\s([a-z0-9\s])([a-z0-9\s])\s(.*)/;

                    # check if field has content
                    if ($sf) {
                        # get subfield codes by pattern
                        # some special characters are allowed as subfiled codes in local defined field
                        # see https://www.loc.gov/marc/96principl.html#eight 8.4.2.3.
                        my @sf_codes = $sf =~ m/\s?\$([a-z0-9!"#\$%&'\(\)\*\+'-\.\/:;<=>])\s/g;

                        # split string by subfield code pattern
                        my @sf_values
                            = grep {length $_}
                                split
                                /\s?\$[a-z0-9!"#\$%&'\(\)\*\+'-\.\/:;<=>]\s/,
                                $sf;
                           
                        if (scalar @sf_codes != scalar @sf_values) {
                            warn
                                'different number of subfield codes and values';
                            next;
                        }

                        push @record,
                            [
                            $tag,  $ind1,
                            $ind2, map {$_, shift @sf_values} @sf_codes
                            ];
                    }

                    # skip empty fields
                    else {
                        warn "field $tag has no content";
                        next;
                    }

                }
            }
            return {_id => defined $id ? $id : $count, record => \@record};
        }
        return;
    };
}

1;