File Coverage

blib/lib/MARC/Moose/Record.pm
Criterion Covered Total %
statement 97 114 85.0
branch 19 30 63.3
condition 3 3 100.0
subroutine 20 24 83.3
pod 6 8 75.0
total 145 179 81.0


line stmt bran cond sub pod time code
1             package MARC::Moose::Record;
2             # ABSTRACT: MARC::Moose bibliographic record
3             $MARC::Moose::Record::VERSION = '1.0.45';
4 4     4   325581 use Moose;
  4         1548755  
  4         30  
5              
6 4     4   31855 use Modern::Perl;
  4         32483  
  4         29  
7 4     4   853 use Carp;
  4         9  
  4         225  
8 4     4   2169 use MARC::Moose::Formater::Iso2709;
  4         14  
  4         169  
9 4     4   2151 use MARC::Moose::Formater::Json;
  4         65  
  4         165  
10 4     4   2051 use MARC::Moose::Formater::Legacy;
  4         14  
  4         152  
11 4     4   2012 use MARC::Moose::Formater::Marcxml;
  4         15  
  4         152  
12 4     4   2356 use MARC::Moose::Formater::Text;
  4         18  
  4         140  
13 4     4   2024 use MARC::Moose::Formater::Yaml;
  4         13  
  4         140  
14 4     4   2718 use MARC::Moose::Formater::UnimarcToMarc21;
  4         11  
  4         159  
15 4     4   2292 use MARC::Moose::Formater::AuthorityUnimarcToMarc21;
  4         24  
  4         148  
16 4     4   1567 use MARC::Moose::Parser::Iso2709;
  4         21  
  4         157  
17 4     4   2252 use MARC::Moose::Parser::MarcxmlSax;
  4         16  
  4         161  
18 4     4   2340 use MARC::Moose::Parser::Legacy;
  4         24  
  4         144  
19 4     4   2087 use MARC::Moose::Parser::Yaml;
  4         13  
  4         178  
20 4     4   2273 use MARC::Moose::Parser::Json;
  4         11  
  4         5305  
21              
22             with 'MARC::Moose::Lint::Checker';
23              
24             has lint => (
25             is => 'rw',
26             );
27              
28             has leader => (
29             is => 'ro',
30             isa => 'Str',
31             writer => '_leader',
32             default => ' ' x 24,
33             );
34              
35             has fields => (
36             is => 'rw',
37             isa => 'ArrayRef',
38             default => sub { [] }
39             );
40              
41              
42             # Global
43              
44             # Les formater standards
45             my $formater = {
46             iso2709 => MARC::Moose::Formater::Iso2709->new(),
47             json => MARC::Moose::Formater::Json->new(),
48             legacy => MARC::Moose::Formater::Legacy->new(),
49             marcxml => MARC::Moose::Formater::Marcxml->new(),
50             text => MARC::Moose::Formater::Text->new(),
51             yaml => MARC::Moose::Formater::Yaml->new(),
52             unimarctomarc21 => MARC::Moose::Formater::UnimarcToMarc21->new(),
53             authorityunimarctomarc21 => MARC::Moose::Formater::AuthorityUnimarcToMarc21->new(),
54             };
55              
56             # Les parser standards
57             my $parser = {
58             iso2709 => MARC::Moose::Parser::Iso2709->new(),
59             marcxml => MARC::Moose::Parser::MarcxmlSax->new(),
60             legacy => MARC::Moose::Parser::Legacy->new(),
61             yaml => MARC::Moose::Parser::Yaml->new(),
62             json => MARC::Moose::Parser::Json->new(),
63             };
64              
65              
66             {
67             $MARC::Moose::Record::formater = $formater;
68             $MARC::Moose::Record::parser = $parser;
69             }
70              
71              
72              
73             sub clone {
74 0     0 1 0 my $self = shift;
75              
76 0         0 my $record = MARC::Moose::Record->new();
77 0         0 $record->_leader( $self->leader );
78 0         0 $record->fields( [ map { $_->clone(); } @{$self->fields} ] );
  0         0  
  0         0  
79 0         0 return $record;
80             }
81              
82              
83             sub set_leader_length {
84 1     1 1 3 my ($self, $length, $offset) = @_;
85              
86 1 50       5 carp "Record length of $length is larger than the MARC spec allows 99999"
87             if $length > 99999;
88              
89 1         33 my $leader = $self->leader;
90 1         7 substr($leader, 0, 5) = sprintf("%05d", $length);
91 1         5 substr($leader, 12, 5) = sprintf("%05d", $offset);
92              
93             # Default leader various pseudo variable fields
94             # Force UNICODE MARC21: substr($leader, 9, 1) = 'a';
95 1         3 substr($leader, 10, 2) = '22';
96 1         3 substr($leader, 20, 4) = '4500';
97              
98 1         30 $self->_leader( $leader );
99             }
100              
101              
102             sub append {
103 4     4 1 667 my $self = shift;
104              
105 4         9 my @fields = @_;
106 4 50       13 return unless @fields;
107            
108             # Control field correctness
109 4         9 for my $field (@fields) {
110 4 50       21 unless ( ref($field) =~ /^MARC::Moose::Field/ ) {
111 0         0 carp "Append a non MARC::Moose::Field";
112 0         0 return;
113             }
114             }
115              
116 4         122 my $tag = $fields[0]->tag;
117 4         8 my @sf;
118 4         7 my $notdone = 1;
119 4         7 for my $field ( @{$self->fields} ) {
  4         102  
120 6 100 100     125 if ( $notdone && $field->tag gt $tag ) {
121 2         6 push @sf, @fields;
122 2         4 $notdone = 0;
123             }
124 6         15 push @sf, $field;
125             }
126 4 100       11 push @sf, @fields if $notdone;
127 4         101 $self->fields( \@sf );
128             }
129              
130              
131             my %_field_regex;
132              
133              
134             sub field {
135 13     13 1 38 my $self = shift;
136 13         31 my @specs = @_;
137              
138 13         21 my @list;
139 13         29 for my $tag ( @specs ) {
140 13         29 my $regex = $_field_regex{ $tag };
141             # Compile & stash it if necessary
142 13 100       31 unless ( $regex ) {
143 10         155 $regex = qr/^$tag$/;
144 10         39 $_field_regex{ $tag } = $regex;
145             }
146 13         31 for my $field ( @{$self->fields} ) {
  13         510  
147 65 100       1526 if ( $field->tag =~ $regex ) {
148 15 100       117 return $field unless wantarray;
149 7         15 push @list, $field;
150             }
151             }
152             }
153             wantarray
154             ? @list
155 5 50       32 : @list ? $list[0] : undef;
    100          
156             }
157              
158              
159             sub delete {
160 1     1 1 6 my $self = shift;
161              
162 1 50       6 return unless @_;
163              
164             $self->fields( [ grep {
165 4         97 my $tag = $_->tag;
166 4         6 my $keep = 1;
167 4         9 for my $tag_spec ( @_ ) {
168 4 100       25 if ( $tag =~ $tag_spec ) { $keep = 0; last; }
  3         8  
  3         4  
169             }
170 4         33 $keep;
171 1         2 } @{$self->fields} ] );
  1         27  
172             }
173              
174              
175             sub as {
176 0     0 1   my ($self, $format) = @_;
177 0           my $f = $formater->{ lc($format) };
178 0 0         return $f ? $f->format($self) : undef;
179             }
180              
181              
182             sub new_from {
183 0     0 0   my ($record, $type) = @_;
184 0           my $p = $parser->{ lc($type) };
185 0 0         $p ? $p->parse($record) : undef;
186             }
187              
188              
189             sub check {
190 0     0 0   my $self = shift;
191 0 0         $self->lint ? $self->lint->check($self) : ();
192             }
193              
194              
195             __PACKAGE__->meta->make_immutable;
196              
197             1;
198              
199             __END__
200              
201             =pod
202              
203             =encoding UTF-8
204              
205             =head1 NAME
206              
207             MARC::Moose::Record - MARC::Moose bibliographic record
208              
209             =head1 VERSION
210              
211             version 1.0.45
212              
213             =head1 DESCRIPTION
214              
215             MARC::Moose::Record is an object, Moose based object, representing a MARC::Moose
216             bibliographic record. It can be a MARC21, UNIMARC, or whatever biblio record.
217              
218             =head1 ATTRIBUTES
219              
220             =head2 lint
221              
222             A L<MARC::Moose::Lint::Checker> object which allow to check record based on a
223             set of validation rules. Generally, the 'lint' attribute of record is inherited
224             from the reader used to get the record.
225              
226             =head2 leader
227              
228             Read-only string. The leader is fixed by set_leader_length method.
229              
230             =head2 fields
231              
232             ArrayRef on MARC::Moose::Field objects: MARC::Moose:Fields::Control and
233             MARC::Moose::Field::Std.
234              
235             =head1 METHODS
236              
237             =head2 clone()
238              
239             Clone the record. Create a new record containing exactly the same data.
240              
241             =head2 set_leader_length( I<length>, I<offset> )
242              
243             This method is called to reset leader length of record and offset of data
244             section. This means something only for ISO2709 formated records. So this method
245             is exlusively called by any formater which has to build a valid ISO2709 data
246             stream. It also forces leader position 10 and 20-23 since this variable values
247             aren't variable at all for any ordinary MARC record.
248              
249             Called by L<MARC::Moose::Formater::Iso2709>.
250              
251             $record->set_leader_length( $length, $offset );
252              
253             =head2 append( I<field> )
254              
255             Append a MARC::Moose::Field in the record. The record is appended at the end of
256             numerical section, ie if you append for example a 710 field, it will be placed
257             at the end of the 7xx fields section, just before 8xx section or at the end of
258             fields list.
259              
260             $record->append(
261             MARC::Moose::Field::Std->new(
262             tag => '100',
263             subf => [ [ a => 'Poe, Edgar Allan' ],
264             [ u => 'Translation' ] ]
265             ) );
266              
267             You can also append an array of MARC::Moose::Field. In this case, the array
268             will be appended as for a unique field at the position of the first field of
269             the array.
270              
271             =head2 field( I<tag> )
272              
273             Returns a list of tags that match the field specifier, or an empty list if
274             nothing matched. In scalar context, returns the first matching tag, or undef
275             if nothing matched.
276              
277             The field specifier can be a simple number (i.e. "245"), or use the "."
278             notation of wildcarding (i.e. subject tags are "6.."). All fields are returned
279             if "..." is specified.
280              
281             =head2 delete(spec1, spec2, ...)
282              
283             Delete all fields with tags matching the given specification. For example:
284              
285             $record->delete('11.', '\d\d9');
286              
287             will delete all fields with tag begining by '11' and ending with '9'.
288              
289             =head2 as( I<format> )
290              
291             Returns a formated version of the record as defined by I<format>. Format are standard
292             formater provided by the MARC::Moose::Record package: Iso2709, Text, Marcxml,
293             Json, Yaml, Legacy.
294              
295             =head1 SYNOPSYS
296              
297             use MARC::Moose::Record;
298             use MARC::Moose::Field::Control;
299             use MARC::Moose::Field::Std;
300             use MARC::Moose::Formater::Text;
301            
302             my $record = MARC::Moose::Record->new(
303             fields => [
304             MARC::Moose::Field::Control->new(
305             tag => '001',
306             value => '1234' ),
307             MARC::Moose::Field::Std->new(
308             tag => '245',
309             subf => [ [ a => 'MARC is dying for ever:' ], [ b => 'will it ever happen?' ] ] ),
310             MARC::Moose::Field::Std->new(
311             tag => '260',
312             subf => [
313             [ a => 'Paris:' ],
314             [ b => 'Usefull Press,' ],
315             [ c => '2010.' ],
316             ] ),
317             MARC::Moose::Field::Std->new(
318             tag => '600',
319             subf => [ [ a => 'Library' ], [ b => 'Standards' ] ] ),
320             MARC::Moose::Field::Std->new(
321             tag => '900',
322             subf => [ [ a => 'My local field 1' ] ] ),
323             MARC::Moose::Field::Std->new(
324             tag => '901',
325             subf => [ [ a => 'My local field 1' ] ] ),
326             ]
327             );
328            
329             my $formater = MARC::Moose::Formater::Text->new();
330             print $formater->format( $record );
331             # Shortcut:
332             print $record->as('Text');
333            
334             $record->fields( [ grep { $_->tag < 900 } @{$record->fields} ] );
335             print "After local fields removing:\n", $formater->format($record);
336              
337             =head1 SEE ALSO
338              
339             =over 4
340              
341             =item *
342              
343             L<MARC::Moose>
344              
345             =item *
346              
347             L<MARC::Moose::Field>
348              
349             =back
350              
351             =head1 AUTHOR
352              
353             Frédéric Demians <f.demians@tamil.fr>
354              
355             =head1 COPYRIGHT AND LICENSE
356              
357             This software is copyright (c) 2022 by Frédéric Demians.
358              
359             This is free software; you can redistribute it and/or modify it under
360             the same terms as the Perl 5 programming language system itself.
361              
362             =cut