← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:48 2015

Filename/usr/share/perl5/MARC/File.pm
StatementsExecuted 11 statements in 592µs
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11111µs22µsMARC::File::::BEGIN@9MARC::File::BEGIN@9
1117µs17µsMARC::File::::BEGIN@62MARC::File::BEGIN@62
1117µs10µsMARC::File::::BEGIN@10MARC::File::BEGIN@10
1116µs8µsMARC::File::::BEGIN@11MARC::File::BEGIN@11
1116µs22µsMARC::File::::BEGIN@13MARC::File::BEGIN@13
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
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package MARC::File;
2
3=head1 NAME
4
5MARC::File - Base class for files of MARC records
6
7=cut
8
9222µs233µs
# spent 22µs (11+11) within MARC::File::BEGIN@9 which was called: # once (11µs+11µs) by MARC::File::USMARC::BEGIN@16 at line 9
use strict;
# spent 22µs making 1 call to MARC::File::BEGIN@9 # spent 11µs making 1 call to strict::import
10218µs214µs
# spent 10µs (7+4) within MARC::File::BEGIN@10 which was called: # once (7µs+4µs) by MARC::File::USMARC::BEGIN@16 at line 10
use warnings;
# spent 10µs making 1 call to MARC::File::BEGIN@10 # spent 4µs making 1 call to warnings::import
11226µs29µs
# spent 8µs (6+2) within MARC::File::BEGIN@11 which was called: # once (6µs+2µs) by MARC::File::USMARC::BEGIN@16 at line 11
use integer;
# spent 8µs making 1 call to MARC::File::BEGIN@11 # spent 2µs making 1 call to integer::import
12
13262µs238µs
# spent 22µs (6+16) within MARC::File::BEGIN@13 which was called: # once (6µs+16µs) by MARC::File::USMARC::BEGIN@16 at line 13
use vars qw( $ERROR );
# spent 22µs making 1 call to MARC::File::BEGIN@13 # spent 16µs making 1 call to vars::import
14
15=head1 SYNOPSIS
16
17 use MARC::File::USMARC;
18
19 # If you have weird control fields...
20 use MARC::Field;
21 MARC::Field->allow_controlfield_tags('FMT', 'LDX');
22
23 my $file = MARC::File::USMARC->in( $filename );
24
25 while ( my $marc = $file->next() ) {
26 # Do something
27 }
28 $file->close();
29 undef $file;
30
31=head1 EXPORT
32
33None.
34
35=head1 METHODS
36
37=head2 in()
38
39Opens a file for import. Ordinarily you will use C<MARC::File::USMARC>
40or C<MARC::File::MicroLIF> to do this.
41
42 my $file = MARC::File::USMARC->in( 'file.marc' );
43
44Returns a C<MARC::File> object, or C<undef> on failure. If you
45encountered an error the error message will be stored in
46C<$MARC::File::ERROR>.
47
48Optionally you can also pass in a filehandle, and C<MARC::File>.
49will "do the right thing".
50
51 my $handle = IO::File->new( 'gunzip -c file.marc.gz |' );
52 my $file = MARC::File::USMARC->in( $handle );
53
54=cut
55
56sub in {
57 my $class = shift;
58 my $arg = shift;
59 my ( $filename, $fh );
60
61 ## if a valid filehandle was passed in
622462µs228µs
# spent 17µs (7+11) within MARC::File::BEGIN@62 which was called: # once (7µs+11µs) by MARC::File::USMARC::BEGIN@16 at line 62
my $ishandle = do { no strict; defined fileno($arg); };
# spent 17µs making 1 call to MARC::File::BEGIN@62 # spent 10µs making 1 call to strict::unimport
63 if ( $ishandle ) {
64 $filename = scalar( $arg );
65 $fh = $arg;
66 }
67
68 ## otherwise check if it's a filename, and
69 ## return undef if we weren't able to open it
70 else {
71 $filename = $arg;
72 $fh = eval { local *FH; open( FH, '<', $arg ) or die; *FH{IO}; };
73 if ( $@ ) {
74 $MARC::File::ERROR = "Couldn't open $filename: $@";
75 return;
76 }
77 }
78
79 my $self = {
80 filename => $filename,
81 fh => $fh,
82 recnum => 0,
83 warnings => [],
84 };
85
86 return( bless $self, $class );
87
88} # new()
89
90sub out {
91 die "Not yet written";
92}
93
94=head2 next( [\&filter_func] )
95
96Reads the next record from the file handle passed in.
97
98The C<$filter_func> is a reference to a filtering function. Currently,
99only USMARC records support this. See L<MARC::File::USMARC>'s C<decode()>
100function for details.
101
102Returns a MARC::Record reference, or C<undef> on error.
103
104=cut
105
106sub next {
107 my $self = shift;
108 $self->{recnum}++;
109 my $rec = $self->_next() or return;
110 return $self->decode($rec, @_);
111}
112
113=head2 skip()
114
115Skips over the next record in the file. Same as C<next()>,
116without the overhead of parsing a record you're going to throw away
117anyway.
118
119Returns 1 or undef.
120
121=cut
122
123sub skip {
124 my $self = shift;
125 my $rec = $self->_next() or return;
126 return 1;
127}
128
129=head2 warnings()
130
131Simlilar to the methods in L<MARC::Record> and L<MARC::Batch>,
132C<warnings()> will return any warnings that have accumulated while
133processing this file; and as a side-effect will clear the warnings buffer.
134
135=cut
136
137sub warnings {
138 my $self = shift;
139 my @warnings = @{ $self->{warnings} };
140 $self->{warnings} = [];
141 return(@warnings);
142}
143
144=head2 close()
145
146Closes the file, both from the object's point of view, and the actual file.
147
148=cut
149
150sub close {
151 my $self = shift;
152 close( $self->{fh} );
153 delete $self->{fh};
154 delete $self->{filename};
155 return;
156}
157
158sub _unimplemented {
159 my $self = shift;
160 my $method = shift;
161 warn "Method $method must be overridden";
162}
163
164=head2 write()
165
166Writes a record to the output file. This method must be overridden
167in your subclass.
168
169=head2 decode()
170
171Decodes a record into a USMARC format. This method must be overridden
172in your subclass.
173
174=cut
175
176sub write { $_[0]->_unimplemented("write"); }
177sub decode { $_[0]->_unimplemented("decode"); }
178
179# NOTE: _warn must be called as an object method
180
181sub _warn {
182 my ($self,$warning) = @_;
183 push( @{ $self->{warnings} }, "$warning in record ".$self->{recnum} );
184 return( $self );
185}
186
187# NOTE: _gripe can be called as an object method, or not. Your choice.
188# NOTE: it's use is now deprecated use _warn instead
189sub _gripe {
190 my @parms = @_;
191 if ( @parms ) {
192 my $self = shift @parms;
193
194 if ( ref($self) =~ /^MARC::File/ ) {
195 push( @parms, " at byte ", tell($self->{fh}) )
196 if $self->{fh};
197 push( @parms, " in file ", $self->{filename} ) if $self->{filename};
198 } else {
199 unshift( @parms, $self );
200 }
201
202 $ERROR = join( "", @parms );
203 warn $ERROR;
204 }
205
206 return;
207}
208
20912µs1;
210
211__END__
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.