← Index
Performance Profile   « block view • line view • sub view »
For t/test-parsing
  Run on Sun Nov 14 09:49:57 2010
Reported on Sun Nov 14 09:50:08 2010

File /usr/share/perl5/MARC/File.pm
Statements Executed 13
Total Time 0.0009534 seconds
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sMARC::File::::BEGINMARC::File::BEGIN
0000s0sMARC::File::::_gripeMARC::File::_gripe
0000s0sMARC::File::::_unimplementedMARC::File::_unimplemented
0000s0sMARC::File::::_warnMARC::File::_warn
0000s0sMARC::File::::closeMARC::File::close
0000s0sMARC::File::::decodeMARC::File::decode
0000s0sMARC::File::::inMARC::File::in
0000s0sMARC::File::::nextMARC::File::next
0000s0sMARC::File::::outMARC::File::out
0000s0sMARC::File::::skipMARC::File::skip
0000s0sMARC::File::::warningsMARC::File::warnings
0000s0sMARC::File::::writeMARC::File::write
LineStmts.Exclusive
Time
Avg.Code
1package MARC::File;
2
3=head1 NAME
4
5MARC::File - Base class for files of MARC records
6
7=cut
8
9324µs8µsuse strict;
# spent 7µs making 1 call to strict::import
103175µs58µsuse integer;
# spent 7µs making 1 call to integer::import
11
12361µs20µsuse 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
28None.
29
30=head1 METHODS
31
32=head2 in()
33
34Opens a file for import. Ordinarily you will use C<MARC::File::USMARC>
35or C<MARC::File::MicroLIF> to do this.
36
37 my $file = MARC::File::USMARC->in( 'file.marc' );
38
39Returns a C<MARC::File> object, or C<undef> on failure. If you
40encountered an error the error message will be stored in
41C<$MARC::File::ERROR>.
42
43Optionally you can also pass in a filehandle, and C<MARC::File>.
44will "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
51sub in {
52 my $class = shift;
53 my $arg = shift;
54 my ( $filename, $fh );
55
56 ## if a valid filehandle was passed in
573692µs231µ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
85sub out {
86 die "Not yet written";
87}
88
89=head2 next( [\&filter_func] )
90
91Reads the next record from the file handle passed in.
92
93The C<$filter_func> is a reference to a filtering function. Currently,
94only USMARC records support this. See L<MARC::File::USMARC>'s C<decode()>
95function for details.
96
97Returns a MARC::Record reference, or C<undef> on error.
98
99=cut
100
101sub 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
110Skips over the next record in the file. Same as C<next()>,
111without the overhead of parsing a record you're going to throw away
112anyway.
113
114Returns 1 or undef.
115
116=cut
117
118sub skip {
119 my $self = shift;
120 my $rec = $self->_next() or return;
121 return 1;
122}
123
124=head2 warnings()
125
126Simlilar to the methods in L<MARC::Record> and L<MARC::Batch>,
127C<warnings()> will return any warnings that have accumulated while
128processing this file; and as a side-effect will clear the warnings buffer.
129
130=cut
131
132sub warnings {
133 my $self = shift;
134 my @warnings = @{ $self->{warnings} };
135 $self->{warnings} = [];
136 return(@warnings);
137}
138
139=head2 close()
140
141Closes the file, both from the object's point of view, and the actual file.
142
143=cut
144
145sub close {
146 my $self = shift;
147 close( $self->{fh} );
148 delete $self->{fh};
149 delete $self->{filename};
150 return;
151}
152
153sub _unimplemented() {
154 my $self = shift;
155 my $method = shift;
156 warn "Method $method must be overridden";
157}
158
159=head2 write()
160
161Writes a record to the output file. This method must be overridden
162in your subclass.
163
164=head2 decode()
165
166Decodes a record into a USMARC format. This method must be overridden
167in your subclass.
168
169=cut
170
171sub write { $_[0]->_unimplemented("write"); }
172sub decode { $_[0]->_unimplemented("decode"); }
173
174# NOTE: _warn must be called as an object method
175
176sub _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
184sub _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
20413µs3µs1;
205
206__END__
207
208=head1 RELATED MODULES
209
210L<MARC::Record>
211
212=head1 TODO
213
214=over 4
215
216=item * C<out()> method
217
218We only handle files for input right now.
219
220=back
221
222=cut
223
224=head1 LICENSE
225
226This code may be distributed under the same terms as Perl itself.
227
228Please note that these modules are not products of or supported by the
229employers of the various contributors to the code.
230
231=head1 AUTHOR
232
233Andy Lester, C<< <andy@petdance.com> >>
234
235=cut
236