File | /usr/share/perl5/MARC/File.pm |
Statements Executed | 13 |
Total Time | 0.0009534 seconds |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
0 | 0 | 0 | 0s | 0s | BEGIN | MARC::File::
0 | 0 | 0 | 0s | 0s | _gripe | MARC::File::
0 | 0 | 0 | 0s | 0s | _unimplemented | MARC::File::
0 | 0 | 0 | 0s | 0s | _warn | MARC::File::
0 | 0 | 0 | 0s | 0s | close | MARC::File::
0 | 0 | 0 | 0s | 0s | decode | MARC::File::
0 | 0 | 0 | 0s | 0s | in | MARC::File::
0 | 0 | 0 | 0s | 0s | next | MARC::File::
0 | 0 | 0 | 0s | 0s | out | MARC::File::
0 | 0 | 0 | 0s | 0s | skip | MARC::File::
0 | 0 | 0 | 0s | 0s | warnings | MARC::File::
0 | 0 | 0 | 0s | 0s | write | MARC::File::
Line | Stmts. | Exclusive Time | Avg. | Code |
---|---|---|---|---|
1 | package MARC::File; | |||
2 | ||||
3 | =head1 NAME | |||
4 | ||||
5 | MARC::File - Base class for files of MARC records | |||
6 | ||||
7 | =cut | |||
8 | ||||
9 | 3 | 24µs | 8µs | use strict; # spent 7µs making 1 call to strict::import |
10 | 3 | 175µs | 58µs | use integer; # spent 7µs making 1 call to integer::import |
11 | ||||
12 | 3 | 61µs | 20µs | use vars qw( $ERROR ); # spent 24µs making 1 call to vars::import |
13 | ||||
14 | =head1 SYNOPSIS | |||
15 | ||||
16 | use MARC::File::USMARC; | |||
17 | ||||
18 | my $file = MARC::File::USMARC->in( $filename ); | |||
19 | ||||
20 | while ( my $marc = $file->next() ) { | |||
21 | # Do something | |||
22 | } | |||
23 | $file->close(); | |||
24 | undef $file; | |||
25 | ||||
26 | =head1 EXPORT | |||
27 | ||||
28 | None. | |||
29 | ||||
30 | =head1 METHODS | |||
31 | ||||
32 | =head2 in() | |||
33 | ||||
34 | Opens a file for import. Ordinarily you will use C<MARC::File::USMARC> | |||
35 | or C<MARC::File::MicroLIF> to do this. | |||
36 | ||||
37 | my $file = MARC::File::USMARC->in( 'file.marc' ); | |||
38 | ||||
39 | Returns a C<MARC::File> object, or C<undef> on failure. If you | |||
40 | encountered an error the error message will be stored in | |||
41 | C<$MARC::File::ERROR>. | |||
42 | ||||
43 | Optionally you can also pass in a filehandle, and C<MARC::File>. | |||
44 | will "do the right thing". | |||
45 | ||||
46 | my $handle = IO::File->new( 'gunzip -c file.marc.gz |' ); | |||
47 | my $file = MARC::File::USMARC->in( $handle ); | |||
48 | ||||
49 | =cut | |||
50 | ||||
51 | sub in { | |||
52 | my $class = shift; | |||
53 | my $arg = shift; | |||
54 | my ( $filename, $fh ); | |||
55 | ||||
56 | ## if a valid filehandle was passed in | |||
57 | 3 | 692µs | 231µs | my $ishandle = do { no strict; defined fileno($arg); }; # spent 12µs making 1 call to strict::unimport |
58 | if ( $ishandle ) { | |||
59 | $filename = scalar( $arg ); | |||
60 | $fh = $arg; | |||
61 | } | |||
62 | ||||
63 | ## otherwise check if it's a filename, and | |||
64 | ## return undef if we weren't able to open it | |||
65 | else { | |||
66 | $filename = $arg; | |||
67 | $fh = eval { local *FH; open( FH, $arg ) or die; *FH{IO}; }; | |||
68 | if ( $@ ) { | |||
69 | $MARC::File::ERROR = "Couldn't open $filename: $@"; | |||
70 | return; | |||
71 | } | |||
72 | } | |||
73 | ||||
74 | my $self = { | |||
75 | filename => $filename, | |||
76 | fh => $fh, | |||
77 | recnum => 0, | |||
78 | warnings => [], | |||
79 | }; | |||
80 | ||||
81 | return( bless $self, $class ); | |||
82 | ||||
83 | } # new() | |||
84 | ||||
85 | sub out { | |||
86 | die "Not yet written"; | |||
87 | } | |||
88 | ||||
89 | =head2 next( [\&filter_func] ) | |||
90 | ||||
91 | Reads the next record from the file handle passed in. | |||
92 | ||||
93 | The C<$filter_func> is a reference to a filtering function. Currently, | |||
94 | only USMARC records support this. See L<MARC::File::USMARC>'s C<decode()> | |||
95 | function for details. | |||
96 | ||||
97 | Returns a MARC::Record reference, or C<undef> on error. | |||
98 | ||||
99 | =cut | |||
100 | ||||
101 | sub next { | |||
102 | my $self = shift; | |||
103 | $self->{recnum}++; | |||
104 | my $rec = $self->_next() or return; | |||
105 | return $self->decode($rec, @_); | |||
106 | } | |||
107 | ||||
108 | =head2 skip() | |||
109 | ||||
110 | Skips over the next record in the file. Same as C<next()>, | |||
111 | without the overhead of parsing a record you're going to throw away | |||
112 | anyway. | |||
113 | ||||
114 | Returns 1 or undef. | |||
115 | ||||
116 | =cut | |||
117 | ||||
118 | sub skip { | |||
119 | my $self = shift; | |||
120 | my $rec = $self->_next() or return; | |||
121 | return 1; | |||
122 | } | |||
123 | ||||
124 | =head2 warnings() | |||
125 | ||||
126 | Simlilar to the methods in L<MARC::Record> and L<MARC::Batch>, | |||
127 | C<warnings()> will return any warnings that have accumulated while | |||
128 | processing this file; and as a side-effect will clear the warnings buffer. | |||
129 | ||||
130 | =cut | |||
131 | ||||
132 | sub warnings { | |||
133 | my $self = shift; | |||
134 | my @warnings = @{ $self->{warnings} }; | |||
135 | $self->{warnings} = []; | |||
136 | return(@warnings); | |||
137 | } | |||
138 | ||||
139 | =head2 close() | |||
140 | ||||
141 | Closes the file, both from the object's point of view, and the actual file. | |||
142 | ||||
143 | =cut | |||
144 | ||||
145 | sub close { | |||
146 | my $self = shift; | |||
147 | close( $self->{fh} ); | |||
148 | delete $self->{fh}; | |||
149 | delete $self->{filename}; | |||
150 | return; | |||
151 | } | |||
152 | ||||
153 | sub _unimplemented() { | |||
154 | my $self = shift; | |||
155 | my $method = shift; | |||
156 | warn "Method $method must be overridden"; | |||
157 | } | |||
158 | ||||
159 | =head2 write() | |||
160 | ||||
161 | Writes a record to the output file. This method must be overridden | |||
162 | in your subclass. | |||
163 | ||||
164 | =head2 decode() | |||
165 | ||||
166 | Decodes a record into a USMARC format. This method must be overridden | |||
167 | in your subclass. | |||
168 | ||||
169 | =cut | |||
170 | ||||
171 | sub write { $_[0]->_unimplemented("write"); } | |||
172 | sub decode { $_[0]->_unimplemented("decode"); } | |||
173 | ||||
174 | # NOTE: _warn must be called as an object method | |||
175 | ||||
176 | sub _warn { | |||
177 | my ($self,$warning) = @_; | |||
178 | push( @{ $self->{warnings} }, "$warning in record ".$self->{recnum} ); | |||
179 | return( $self ); | |||
180 | } | |||
181 | ||||
182 | # NOTE: _gripe can be called as an object method, or not. Your choice. | |||
183 | # NOTE: it's use is now depracated use _warn instead | |||
184 | sub _gripe(@) { | |||
185 | my @parms = @_; | |||
186 | if ( @parms ) { | |||
187 | my $self = shift @parms; | |||
188 | ||||
189 | if ( ref($self) =~ /^MARC::File/ ) { | |||
190 | push( @parms, " at byte ", tell($self->{fh}) ) | |||
191 | if $self->{fh}; | |||
192 | push( @parms, " in file ", $self->{filename} ) if $self->{filename}; | |||
193 | } else { | |||
194 | unshift( @parms, $self ); | |||
195 | } | |||
196 | ||||
197 | $ERROR = join( "", @parms ); | |||
198 | warn $ERROR; | |||
199 | } | |||
200 | ||||
201 | return; | |||
202 | } | |||
203 | ||||
204 | 1 | 3µs | 3µs | 1; |
205 | ||||
206 | __END__ | |||
207 | ||||
208 | =head1 RELATED MODULES | |||
209 | ||||
210 | L<MARC::Record> | |||
211 | ||||
212 | =head1 TODO | |||
213 | ||||
214 | =over 4 | |||
215 | ||||
216 | =item * C<out()> method | |||
217 | ||||
218 | We only handle files for input right now. | |||
219 | ||||
220 | =back | |||
221 | ||||
222 | =cut | |||
223 | ||||
224 | =head1 LICENSE | |||
225 | ||||
226 | This code may be distributed under the same terms as Perl itself. | |||
227 | ||||
228 | Please note that these modules are not products of or supported by the | |||
229 | employers of the various contributors to the code. | |||
230 | ||||
231 | =head1 AUTHOR | |||
232 | ||||
233 | Andy Lester, C<< <andy@petdance.com> >> | |||
234 | ||||
235 | =cut | |||
236 |