File Coverage

blib/lib/Catmandu/Fix/marc_paste.pm
Criterion Covered Total %
statement 12 17 70.5
branch n/a
condition n/a
subroutine 4 5 80.0
pod 0 1 0.0
total 16 23 69.5


line stmt bran cond sub pod time code
1             package Catmandu::Fix::marc_paste;
2              
3 1     1   333758 use Catmandu::Sane;
  1         11  
  1         8  
4 1     1   642 use Catmandu::MARC;
  1         2  
  1         35  
5 1     1   8 use Moo;
  1         2  
  1         4  
6 1     1   560 use Catmandu::Fix::Has;
  1         954  
  1         5  
7              
8             with 'Catmandu::Fix::Inlineable';
9              
10             our $VERSION = '1.20';
11              
12             has path => (fix_arg => 1);
13             has at => (fix_opt => 1);
14             has equals => (fix_opt => 1);
15              
16             sub fix {
17 0     0 0   my ($self, $data) = @_;
18 0           my $path = $self->path;
19 0           my $at = $self->at;
20 0           my $regex = $self->equals;
21 0           return Catmandu::MARC->instance->marc_paste($data,$path,$at,$regex);
22             }
23              
24             1;
25              
26             __END__
27              
28             =head1 NAME
29              
30             Catmandu::Fix::marc_paste - paste a MARC structured field back into the MARC record
31              
32             =head1 SYNOPSIS
33              
34             # Copy and paste to the end of the record
35             marc_copy(001, fixed001)
36             set_fieldfixed001.$first.tag,002)
37             marc_paste(fixed001)
38              
39             # Copy and paste in place (rename a field)
40             do marc_each()
41             if marc_has(001)
42             # Copy a MARC field
43             marc_copy(001, fixed001)
44              
45             # Change it
46             set_fieldfixed001.$first.tag,002)
47              
48             # Paste it back into the record
49             marc_paste(fixed001)
50             end
51             end
52              
53              
54             =head1 DESCRIPTION
55              
56             Paste a MARC stucture created by L<Catmandu::Fix::marc_struc> back at the end of
57             a MARC record.
58              
59             =head1 METHODS
60              
61             =head2 marc_paste(JSON_PATH, [at: MARC+PATH , [equals: REGEX]])
62              
63             Paste a MARC struct PATH back in the MARC record. By default the MARC structure will
64             be pasted at the end of the record. Optionally provide an C<at> option to set the
65             MARC field after which the structure needs to be pasted. Optionally provide a regex
66             that should match the content of the C<at> field.
67              
68             # Paste mycopy at the end of the record
69             marc_paste(mycopy)
70              
71             # Paste mycopy after the last 300 field
72             marc_paste(mycopy, at:300)
73              
74             # Paste mycopy after the last 300 field with indicator1 = 1
75             marc_paste(mycopy, at:300[1])
76              
77             # Paste mycopy after the last 300 field which has an 'a' subfield
78             marc_paste(mycopy, at:300a)
79              
80             # Paste mycopy after the last 300 field which has an 'a' subfield equal to 'ABC'
81             marc_paste(mycopy, at:300a, equals:'^ABC$')
82              
83             # Paste mycopy after the last 300 field with all concatinated subfields equal to 'ABC'
84             marc_paste(mycopy, at:300, equals:'^ABC$')
85              
86             =head1 INLINE
87              
88             This Fix can be used inline in a Perl script:
89              
90             use Catmandu::Fix::marc_struc as => 'marc_struc';
91             use Catmandu::Fix::marc_paste as => 'marc_paste';
92              
93             my $data = { record => ['650', ' ', 0, 'a', 'Perl'] };
94              
95             $data = marc_struc($data,'650','subject');
96             $data = marc_paste($data,'subject');
97              
98              
99             =head1 SEE ALSO
100              
101             =over
102              
103             =item * L<Catmandu::Fix::marc_copy>
104              
105             =item * L<Catmandu::Fix::marc_cut>
106              
107             =back
108              
109             =head1 LICENSE AND COPYRIGHT
110              
111             This program is free software; you can redistribute it and/or modify it
112             under the terms of either: the GNU General Public License as published
113             by the Free Software Foundation; or the Artistic License.
114              
115             See http://dev.perl.org/licenses/ for more information.
116              
117             =cut