| Filename | /usr/share/perl5/MARC/File/USMARC.pm |
| Statements | Executed 552281 statements in 2.12s |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 5000 | 1 | 1 | 2.09s | 7.38s | MARC::File::USMARC::_build_tag_directory |
| 5000 | 1 | 1 | 273ms | 7.80s | MARC::File::USMARC::encode |
| 10000 | 2 | 1 | 15.4ms | 15.4ms | MARC::File::USMARC::CORE:match (opcode) |
| 1 | 1 | 1 | 365µs | 811µs | MARC::File::USMARC::BEGIN@13 |
| 1 | 1 | 1 | 22µs | 29µs | MARC::File::USMARC::BEGIN@9 |
| 1 | 1 | 1 | 17µs | 59µs | MARC::File::USMARC::BEGIN@16 |
| 1 | 1 | 1 | 17µs | 62µs | MARC::File::USMARC::BEGIN@12 |
| 1 | 1 | 1 | 17µs | 97µs | MARC::File::USMARC::BEGIN@19 |
| 1 | 1 | 1 | 17µs | 21µs | MARC::File::USMARC::BEGIN@10 |
| 1 | 1 | 1 | 17µs | 80µs | MARC::File::USMARC::BEGIN@18 |
| 1 | 1 | 1 | 14µs | 75µs | MARC::File::USMARC::BEGIN@22 |
| 1 | 1 | 1 | 14µs | 83µs | MARC::File::USMARC::BEGIN@20 |
| 1 | 1 | 1 | 13µs | 13µs | MARC::File::USMARC::BEGIN@15 |
| 1 | 1 | 1 | 12µs | 81µs | MARC::File::USMARC::BEGIN@21 |
| 0 | 0 | 0 | 0s | 0s | MARC::File::USMARC::_next |
| 0 | 0 | 0 | 0s | 0s | MARC::File::USMARC::decode |
| 0 | 0 | 0 | 0s | 0s | MARC::File::USMARC::update_leader |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package MARC::File::USMARC; | ||||
| 2 | |||||
| 3 | =head1 NAME | ||||
| 4 | |||||
| - - | |||||
| 9 | 3 | 40µs | 2 | 36µs | # spent 29µs (22+7) within MARC::File::USMARC::BEGIN@9 which was called:
# once (22µs+7µs) by MARC::Record::as_usmarc at line 9 # spent 29µs making 1 call to MARC::File::USMARC::BEGIN@9
# spent 7µs making 1 call to strict::import |
| 10 | 3 | 47µs | 2 | 25µs | # spent 21µs (17+4) within MARC::File::USMARC::BEGIN@10 which was called:
# once (17µs+4µs) by MARC::Record::as_usmarc at line 10 # spent 21µs making 1 call to MARC::File::USMARC::BEGIN@10
# spent 4µs making 1 call to integer::import |
| 11 | |||||
| 12 | 3 | 45µs | 2 | 107µs | # spent 62µs (17+45) within MARC::File::USMARC::BEGIN@12 which was called:
# once (17µs+45µs) by MARC::Record::as_usmarc at line 12 # spent 62µs making 1 call to MARC::File::USMARC::BEGIN@12
# spent 45µs making 1 call to vars::import |
| 13 | 3 | 223µs | 2 | 885µs | # spent 811µs (365+446) within MARC::File::USMARC::BEGIN@13 which was called:
# once (365µs+446µs) by MARC::Record::as_usmarc at line 13 # spent 811µs making 1 call to MARC::File::USMARC::BEGIN@13
# spent 74µs making 1 call to Exporter::import |
| 14 | |||||
| 15 | 3 | 43µs | 1 | 13µs | # spent 13µs within MARC::File::USMARC::BEGIN@15 which was called:
# once (13µs+0s) by MARC::Record::as_usmarc at line 15 # spent 13µs making 1 call to MARC::File::USMARC::BEGIN@15 |
| 16 | 4 | 64µs | 2 | 101µs | # spent 59µs (17+42) within MARC::File::USMARC::BEGIN@16 which was called:
# once (17µs+42µs) by MARC::Record::as_usmarc at line 16 # spent 59µs making 1 call to MARC::File::USMARC::BEGIN@16
# spent 42µs making 1 call to vars::import |
| 17 | |||||
| 18 | 3 | 51µs | 2 | 143µs | # spent 80µs (17+63) within MARC::File::USMARC::BEGIN@18 which was called:
# once (17µs+63µs) by MARC::Record::as_usmarc at line 18 # spent 80µs making 1 call to MARC::File::USMARC::BEGIN@18
# spent 63µs making 1 call to Exporter::import |
| 19 | 3 | 50µs | 2 | 177µs | # spent 97µs (17+80) within MARC::File::USMARC::BEGIN@19 which was called:
# once (17µs+80µs) by MARC::Record::as_usmarc at line 19 # spent 97µs making 1 call to MARC::File::USMARC::BEGIN@19
# spent 80µs making 1 call to constant::import |
| 20 | 3 | 46µs | 2 | 152µs | # spent 83µs (14+69) within MARC::File::USMARC::BEGIN@20 which was called:
# once (14µs+69µs) by MARC::Record::as_usmarc at line 20 # spent 83µs making 1 call to MARC::File::USMARC::BEGIN@20
# spent 69µs making 1 call to constant::import |
| 21 | 3 | 40µs | 2 | 150µs | # spent 81µs (12+69) within MARC::File::USMARC::BEGIN@21 which was called:
# once (12µs+69µs) by MARC::Record::as_usmarc at line 21 # spent 81µs making 1 call to MARC::File::USMARC::BEGIN@21
# spent 69µs making 1 call to constant::import |
| 22 | 3 | 1.49ms | 2 | 136µs | # spent 75µs (14+61) within MARC::File::USMARC::BEGIN@22 which was called:
# once (14µs+61µs) by MARC::Record::as_usmarc at line 22 # spent 75µs making 1 call to MARC::File::USMARC::BEGIN@22
# spent 61µs making 1 call to constant::import |
| 23 | |||||
| 24 | =head1 SYNOPSIS | ||||
| 25 | |||||
| - - | |||||
| 44 | sub _next { | ||||
| 45 | my $self = shift; | ||||
| 46 | my $fh = $self->{fh}; | ||||
| 47 | |||||
| 48 | my $reclen; | ||||
| 49 | return if eof($fh); | ||||
| 50 | |||||
| 51 | local $/ = END_OF_RECORD; | ||||
| 52 | my $usmarc = <$fh>; | ||||
| 53 | |||||
| 54 | # remove illegal garbage that sometimes occurs between records | ||||
| 55 | $usmarc =~ s/^[ \x00\x0a\x0d\x1a]+//; | ||||
| 56 | |||||
| 57 | return $usmarc; | ||||
| 58 | } | ||||
| 59 | |||||
| 60 | =head2 decode( $string [, \&filter_func ] ) | ||||
| 61 | |||||
| - - | |||||
| 96 | sub decode { | ||||
| 97 | |||||
| 98 | my $text; | ||||
| 99 | my $location = ''; | ||||
| 100 | |||||
| 101 | ## decode can be called in a variety of ways | ||||
| 102 | ## $object->decode( $string ) | ||||
| 103 | ## MARC::File::USMARC->decode( $string ) | ||||
| 104 | ## MARC::File::USMARC::decode( $string ) | ||||
| 105 | ## this bit of code covers all three | ||||
| 106 | |||||
| 107 | my $self = shift; | ||||
| 108 | if ( ref($self) =~ /^MARC::File/ ) { | ||||
| 109 | $location = 'in record '.$self->{recnum}; | ||||
| 110 | $text = shift; | ||||
| 111 | } else { | ||||
| 112 | $location = 'in record 1'; | ||||
| 113 | $text = $self=~/MARC::File/ ? shift : $self; | ||||
| 114 | } | ||||
| 115 | my $filter_func = shift; | ||||
| 116 | |||||
| 117 | # ok this the empty shell we will fill | ||||
| 118 | my $marc = MARC::Record->new(); | ||||
| 119 | |||||
| 120 | # Check for an all-numeric record length | ||||
| 121 | ($text =~ /^(\d{5})/) | ||||
| 122 | or return $marc->_warn( "Record length \"", substr( $text, 0, 5 ), "\" is not numeric $location" ); | ||||
| 123 | |||||
| 124 | my $reclen = $1; | ||||
| 125 | my $realLength = bytes::length( $text ); | ||||
| 126 | $marc->_warn( "Invalid record length $location: Leader says $reclen " . | ||||
| 127 | "bytes but it's actually $realLength" ) unless $reclen == $realLength; | ||||
| 128 | |||||
| 129 | (substr($text, -1, 1) eq END_OF_RECORD) | ||||
| 130 | or $marc->_warn( "Invalid record terminator $location" ); | ||||
| 131 | |||||
| 132 | $marc->leader( substr( $text, 0, LEADER_LEN ) ); | ||||
| 133 | |||||
| 134 | # bytes 12 - 16 of leader give offset to the body of the record | ||||
| 135 | my $data_start = 0 + bytes::substr( $text, 12, 5 ); | ||||
| 136 | |||||
| 137 | # immediately after the leader comes the directory (no separator) | ||||
| 138 | my $dir = substr( $text, LEADER_LEN, $data_start - LEADER_LEN - 1 ); # -1 to allow for \x1e at end of directory | ||||
| 139 | |||||
| 140 | # character after the directory must be \x1e | ||||
| 141 | (substr($text, $data_start-1, 1) eq END_OF_FIELD) | ||||
| 142 | or $marc->_warn( "No directory found $location" ); | ||||
| 143 | |||||
| 144 | # all directory entries 12 bytes long, so length % 12 must be 0 | ||||
| 145 | (length($dir) % DIRECTORY_ENTRY_LEN == 0) | ||||
| 146 | or $marc->_warn( "Invalid directory length $location" ); | ||||
| 147 | |||||
| 148 | |||||
| 149 | # go through all the fields | ||||
| 150 | my $nfields = length($dir)/DIRECTORY_ENTRY_LEN; | ||||
| 151 | for ( my $n = 0; $n < $nfields; $n++ ) { | ||||
| 152 | my ( $tagno, $len, $offset ) = unpack( "A3 A4 A5", substr($dir, $n*DIRECTORY_ENTRY_LEN, DIRECTORY_ENTRY_LEN) ); | ||||
| 153 | |||||
| 154 | # Check directory validity | ||||
| 155 | ($tagno =~ /^[0-9A-Za-z]{3}$/) | ||||
| 156 | or $marc->_warn( "Invalid tag in directory $location: \"$tagno\"" ); | ||||
| 157 | |||||
| 158 | ($len =~ /^\d{4}$/) | ||||
| 159 | or $marc->_warn( "Invalid length in directory $location tag $tagno: \"$len\"" ); | ||||
| 160 | |||||
| 161 | ($offset =~ /^\d{5}$/) | ||||
| 162 | or $marc->_warn( "Invalid offset in directory $location tag $tagno: \"$offset\"" ); | ||||
| 163 | |||||
| 164 | ($offset + $len <= $reclen) | ||||
| 165 | or $marc->_warn( "Directory entry $location runs off the end of the record tag $tagno" ); | ||||
| 166 | |||||
| 167 | my $tagdata = bytes::substr( $text, $data_start+$offset, $len ); | ||||
| 168 | |||||
| 169 | # if utf8 the we encode the string as utf8 | ||||
| 170 | if ( $marc->encoding() eq 'UTF-8' ) { | ||||
| 171 | $tagdata = marc_to_utf8( $tagdata ); | ||||
| 172 | } | ||||
| 173 | |||||
| 174 | $marc->_warn( "Invalid length in directory for tag $tagno $location" ) | ||||
| 175 | unless ( $len == bytes::length($tagdata) ); | ||||
| 176 | |||||
| 177 | if ( substr($tagdata, -1, 1) eq END_OF_FIELD ) { | ||||
| 178 | # get rid of the end-of-tag character | ||||
| 179 | chop $tagdata; | ||||
| 180 | --$len; | ||||
| 181 | } else { | ||||
| 182 | $marc->_warn( "field does not end in end of field character in tag $tagno $location" ); | ||||
| 183 | } | ||||
| 184 | |||||
| 185 | warn "Specs: ", join( "|", $tagno, $len, $offset, $tagdata ), "\n" if $MARC::Record::DEBUG; | ||||
| 186 | |||||
| 187 | if ( $filter_func ) { | ||||
| 188 | next unless $filter_func->( $tagno, $tagdata ); | ||||
| 189 | } | ||||
| 190 | |||||
| 191 | if ( ($tagno =~ /^\d+$/) && ($tagno < 10) ) { | ||||
| 192 | $marc->append_fields( MARC::Field->new( $tagno, $tagdata ) ); | ||||
| 193 | } else { | ||||
| 194 | my @subfields = split( SUBFIELD_INDICATOR, $tagdata ); | ||||
| 195 | my $indicators = shift @subfields; | ||||
| 196 | my ($ind1, $ind2); | ||||
| 197 | |||||
| 198 | if ( length( $indicators ) > 2 or length( $indicators ) == 0 ) { | ||||
| 199 | $marc->_warn( "Invalid indicators \"$indicators\" forced to blanks $location for tag $tagno\n" ); | ||||
| 200 | ($ind1,$ind2) = (" ", " "); | ||||
| 201 | } else { | ||||
| 202 | $ind1 = substr( $indicators,0, 1 ); | ||||
| 203 | $ind2 = substr( $indicators,1, 1 ); | ||||
| 204 | } | ||||
| 205 | |||||
| 206 | # Split the subfield data into subfield name and data pairs | ||||
| 207 | my @subfield_data; | ||||
| 208 | for ( @subfields ) { | ||||
| 209 | if ( length > 0 ) { | ||||
| 210 | push( @subfield_data, substr($_,0,1),substr($_,1) ); | ||||
| 211 | } else { | ||||
| 212 | $marc->_warn( "Entirely empty subfield found in tag $tagno" ); | ||||
| 213 | } | ||||
| 214 | } | ||||
| 215 | |||||
| 216 | if ( !@subfield_data ) { | ||||
| 217 | $marc->_warn( "no subfield data found $location for tag $tagno" ); | ||||
| 218 | next; | ||||
| 219 | } | ||||
| 220 | |||||
| 221 | my $field = MARC::Field->new($tagno, $ind1, $ind2, @subfield_data ); | ||||
| 222 | if ( $field->warnings() ) { | ||||
| 223 | $marc->_warn( $field->warnings() ); | ||||
| 224 | } | ||||
| 225 | $marc->append_fields( $field ); | ||||
| 226 | } | ||||
| 227 | } # looping through all the fields | ||||
| 228 | |||||
| 229 | |||||
| 230 | return $marc; | ||||
| 231 | } | ||||
| 232 | |||||
| 233 | =head2 update_leader() | ||||
| 234 | |||||
| - - | |||||
| 242 | sub update_leader() { | ||||
| 243 | my $self = shift; | ||||
| 244 | |||||
| 245 | my (undef,undef,$reclen,$baseaddress) = $self->_build_tag_directory(); | ||||
| 246 | |||||
| 247 | $self->_set_leader_lengths( $reclen, $baseaddress ); | ||||
| 248 | } | ||||
| 249 | |||||
| 250 | =head2 _build_tag_directory() | ||||
| 251 | |||||
| - - | |||||
| 261 | # spent 7.38s (2.09+5.28) within MARC::File::USMARC::_build_tag_directory which was called 5000 times, avg 1.48ms/call:
# 5000 times (2.09s+5.28s) by MARC::File::USMARC::encode at line 311, avg 1.48ms/call | ||||
| 262 | 5000 | 5.71ms | my $marc = shift; | ||
| 263 | 5000 | 27.0ms | 5000 | 6.47ms | $marc = shift if (ref($marc)||$marc) =~ /^MARC::File/; # spent 6.47ms making 5000 calls to MARC::File::USMARC::CORE:match, avg 1µs/call |
| 264 | 5000 | 6.97ms | die "Wanted a MARC::Record but got a ", ref($marc) unless ref($marc) eq "MARC::Record"; | ||
| 265 | |||||
| 266 | 5000 | 4.92ms | my @fields; | ||
| 267 | 5000 | 4.66ms | my @directory; | ||
| 268 | |||||
| 269 | 5000 | 5.69ms | my $dataend = 0; | ||
| 270 | 5000 | 33.9ms | 5000 | 29.6ms | for my $field ( $marc->fields() ) { # spent 29.6ms making 5000 calls to MARC::Record::fields, avg 6µs/call |
| 271 | # Dump data into proper format | ||||
| 272 | 79541 | 382ms | 79541 | 4.61s | my $str = $field->as_usmarc; # spent 4.61s making 79541 calls to MARC::Field::as_usmarc, avg 58µs/call |
| 273 | 79541 | 117ms | push( @fields, $str ); | ||
| 274 | |||||
| 275 | # Create directory entry | ||||
| 276 | 79541 | 338ms | 79541 | 265ms | my $len = bytes::length( $str ); # spent 264ms making 79540 calls to bytes::length, avg 3µs/call
# spent 607µs making 1 call to bytes::AUTOLOAD |
| 277 | |||||
| 278 | 79541 | 562ms | 79541 | 375ms | my $direntry = sprintf( "%03s%04d%05d", $field->tag, $len, $dataend ); # spent 375ms making 79541 calls to MARC::Field::tag, avg 5µs/call |
| 279 | 79541 | 110ms | push( @directory, $direntry ); | ||
| 280 | 79541 | 204ms | $dataend += $len; | ||
| 281 | } | ||||
| 282 | |||||
| 283 | 5000 | 8.42ms | my $baseaddress = | ||
| 284 | LEADER_LEN + # better be 24 | ||||
| 285 | ( @directory * DIRECTORY_ENTRY_LEN ) + | ||||
| 286 | # all the directory entries | ||||
| 287 | 1; # end-of-field marker | ||||
| 288 | |||||
| 289 | |||||
| 290 | 5000 | 5.90ms | my $total = | ||
| 291 | $baseaddress + # stuff before first field | ||||
| 292 | $dataend + # Length of the fields | ||||
| 293 | 1; # End-of-record marker | ||||
| 294 | |||||
| - - | |||||
| 297 | 5000 | 28.5ms | return (\@fields, \@directory, $total, $baseaddress); | ||
| 298 | } | ||||
| 299 | |||||
| 300 | =head2 encode() | ||||
| 301 | |||||
| - - | |||||
| 307 | # spent 7.80s (273ms+7.52) within MARC::File::USMARC::encode which was called 5000 times, avg 1.56ms/call:
# 5000 times (273ms+7.52s) by MARC::Record::as_usmarc at line 459 of MARC/Record.pm, avg 1.56ms/call | ||||
| 308 | 5000 | 5.32ms | my $marc = shift; | ||
| 309 | 5000 | 32.1ms | 5000 | 8.95ms | $marc = shift if (ref($marc)||$marc) =~ /^MARC::File/; # spent 8.95ms making 5000 calls to MARC::File::USMARC::CORE:match, avg 2µs/call |
| 310 | |||||
| 311 | 5000 | 31.7ms | 5000 | 7.38s | my ($fields,$directory,$reclen,$baseaddress) = _build_tag_directory($marc); # spent 7.38s making 5000 calls to MARC::File::USMARC::_build_tag_directory, avg 1.48ms/call |
| 312 | 5000 | 23.8ms | 5000 | 98.4ms | $marc->set_leader_lengths( $reclen, $baseaddress ); # spent 98.4ms making 5000 calls to MARC::Record::set_leader_lengths, avg 20µs/call |
| 313 | |||||
| 314 | # Glomp it all together | ||||
| 315 | 5000 | 177ms | 5000 | 38.1ms | return join("",$marc->leader, @$directory, END_OF_FIELD, @$fields, END_OF_RECORD); # spent 38.1ms making 5000 calls to MARC::Record::leader, avg 8µs/call |
| 316 | } | ||||
| 317 | 1 | 5µs | 1; | ||
| 318 | |||||
| 319 | __END__ | ||||
sub MARC::File::USMARC::CORE:match; # opcode |