| 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 | MARC::File::BEGIN |
| 0 | 0 | 0 | 0s | 0s | MARC::File::_gripe |
| 0 | 0 | 0 | 0s | 0s | MARC::File::_unimplemented |
| 0 | 0 | 0 | 0s | 0s | MARC::File::_warn |
| 0 | 0 | 0 | 0s | 0s | MARC::File::close |
| 0 | 0 | 0 | 0s | 0s | MARC::File::decode |
| 0 | 0 | 0 | 0s | 0s | MARC::File::in |
| 0 | 0 | 0 | 0s | 0s | MARC::File::next |
| 0 | 0 | 0 | 0s | 0s | MARC::File::out |
| 0 | 0 | 0 | 0s | 0s | MARC::File::skip |
| 0 | 0 | 0 | 0s | 0s | MARC::File::warnings |
| 0 | 0 | 0 | 0s | 0s | MARC::File::write |
| 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 |