File Coverage

blib/lib/Catmandu/Fix/marc_copy.pm

Criterion	Covered	Total	%
statement	12	31	38.7
branch			n/a
condition			n/a
subroutine	4	6	66.6
pod	0	1	0.0
total	16	38	42.1

package Catmandu::Fix::marc_copy;

use Catmandu::Sane;
use Catmandu::MARC;
use Moo;
use Catmandu::Fix::Has;

with 'Catmandu::Fix::Base';

our $VERSION = '1.13';

has marc_path      => (fix_arg => 1);
has path           => (fix_arg => 1);
has equals         => (fix_opt => 1);

sub emit {
    my ($self,$fixer) = @_;
    my $path         = $fixer->split_path($self->path);
    my $key          = $path->[-1];
    my $marc_obj     = Catmandu::MARC->instance;

    # Precompile the marc_path to gain some speed
    my $marc_context = $marc_obj->compile_marc_path($self->marc_path, subfield_wildcard => 0);
    my $marc         = $fixer->capture($marc_obj);
    my $marc_path    = $fixer->capture($marc_context);
    my $equals       = $fixer->capture($self->equals);

    my $var           = $fixer->var;
    my $result        = $fixer->generate_var;
    my $current_value = $fixer->generate_var;

    my $perl = "";
    $perl .= $fixer->emit_declare_vars($current_value, "[]");
    $perl .=<<EOF;
if (my ${result} = ${marc}->marc_copy(
            ${var},
            ${marc_path},
            ${equals}) ) {
    ${result} = ref(${result}) ? ${result} : [${result}];
    for ${current_value} (\@{${result}}) {
EOF

    $perl .= $fixer->emit_create_path(
            $var,
            $path,
            sub {
                my $var2 = shift;
                "${var2} = ${current_value}"
            }
    );

    $perl .=<<EOF;
    }
}
EOF
    $perl;
}

1;

__END__

=head1 NAME

Catmandu::Fix::marc_copy - copy marc data in a structured way to a new field

=head1 SYNOPSIS

    # Cut the 001 field out of the MARC record into the fixed001
    marc_copy(001, fixed001)

    # Cut all 650 fields out of the MARC record into the subjects array
    marc_copy(650, subjects)


=head1 DESCRIPTION

Copy MARC data referred by MARC_TAG in a structured way to JSON path.

In contrast to L<Catmandu::Fix::marc_map> and L<Catmandu::Fix::marc_spec>
marc_copy will not only copy data content (values) but also all data elements
like tag, indicators and subfield codes into a nested data structure.

=head1 METHODS

=head2 marc_copy(MARC_PATH, JSON_PATH, [equals: REGEX])

Copy this MARC fields referred by a MARC_PATH to a JSON_PATH.

    # Copy all the 300 fields
    marc_copy(300,tmp)

    # Copy all the 300 fields with indicator 1 = 1
    marc_copy(300[1],tmp)

    # Copy all the 300 fields which have subfield c
    marc_copy(300c,tmp)

    # Copy all the 300 fields which have subfield c equal to 'ABC'
    marc_copy(300c,tmp,equal:"^ABC")

    The JSON_PATH C<tmp> will contain an array with one item per field that was copied.
    Each item is a hash containing the following fields:

      tmp.*.tag        - The names of the MARC field
      tmp.*.ind1       - The value of the first indicator
      tmp.*.ind2       - The value of the second indicator
      tmp.*.subfields  - An array of subfield item. Each subfield item is a
                         hash of the subfield code and subfield value

    E.g.

        tmp:
        - tag: '300'
          ind1: ' '
          ind2: ' '
          subfields:
          - a: 'blabla:'
          - v: 'test123'
          - c: 'ok123'

    These JSON paths can be used like:

        # Set the first indicator of all 300 fields
        do marc_each()
          if marc_has(300)
            marc_copy(300,tmp)

            # Set the first indicator to 1
            # We only check the first item in tmp because the march_each
            # binder can contain only one MARC field at a time
            set_field(tmp.0.ind1,1)

            marc_paste(tmp)
          end
        end

        # Capitalize all the v subfields of 300
        do marc_each()
          if marc_has(300)
             marc_copy(300,tmp)

             do list(path:tmp.0.subfields, var:loop)
                if (exists(loop.v))
                    upcase(loop.v)
                end
             end

             marc_paste(tmp)
          end
        end


=head1 INLINE

This Fix can be used inline in a Perl script:

    use Catmandu::Fix::marc_copy as => 'marc_copy';

    my $data = { record => ['650', ' ', 0, 'a', 'Perl'] };

    $data = marc_copy($data,'650','subject');

    print $data->{subject}->[0]->{tag} , "\n"; # '650'
    print $data->{subject}->[0]->{ind1} , "\n"; # ' '
    print $data->{subject}->[0]->{ind2} , "\n"; # 0
    print $data->{subject}->[0]->{subfields}->[0]->{a} , "\n"; # 'Perl'

=head1 SEE ALSO

=over

=item * L<Catmandu::Fix::marc_cut>

=item * L<Catmandu::Fix::marc_paste>

=back

=head1 LICENSE AND COPYRIGHT

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

=cut