Filename | /usr/share/perl5/MARC/File/USMARC.pm |
Statements | Executed 15667 statements in 46.4ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
25 | 1 | 1 | 43.5ms | 121ms | decode | MARC::File::USMARC::
1707 | 6 | 1 | 2.52ms | 2.52ms | CORE:match (opcode) | MARC::File::USMARC::
544 | 1 | 1 | 1.25ms | 1.25ms | CORE:unpack (opcode) | MARC::File::USMARC::
1 | 1 | 1 | 783µs | 880µs | BEGIN@15 | MARC::File::USMARC::
1 | 1 | 1 | 260µs | 627µs | BEGIN@13 | MARC::File::USMARC::
1 | 1 | 1 | 21µs | 27µs | BEGIN@9 | MARC::File::USMARC::
1 | 1 | 1 | 15µs | 17µs | BEGIN@19 | MARC::File::USMARC::
1 | 1 | 1 | 13µs | 41µs | BEGIN@16 | MARC::File::USMARC::
1 | 1 | 1 | 13µs | 65µs | BEGIN@20 | MARC::File::USMARC::
1 | 1 | 1 | 13µs | 51µs | BEGIN@18 | MARC::File::USMARC::
1 | 1 | 1 | 12µs | 16µs | BEGIN@10 | MARC::File::USMARC::
1 | 1 | 1 | 10µs | 46µs | BEGIN@22 | MARC::File::USMARC::
1 | 1 | 1 | 10µs | 48µs | BEGIN@21 | MARC::File::USMARC::
1 | 1 | 1 | 9µs | 47µs | BEGIN@12 | MARC::File::USMARC::
1 | 1 | 1 | 9µs | 41µs | BEGIN@23 | MARC::File::USMARC::
0 | 0 | 0 | 0s | 0s | _build_tag_directory | MARC::File::USMARC::
0 | 0 | 0 | 0s | 0s | _next | MARC::File::USMARC::
0 | 0 | 0 | 0s | 0s | encode | MARC::File::USMARC::
0 | 0 | 0 | 0s | 0s | update_leader | MARC::File::USMARC::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package MARC::File::USMARC; | ||||
2 | |||||
3 | =head1 NAME | ||||
4 | |||||
- - | |||||
9 | 3 | 31µs | 2 | 34µs | # spent 27µs (21+7) within MARC::File::USMARC::BEGIN@9 which was called:
# once (21µs+7µs) by C4::Biblio::BEGIN@28 at line 9 # spent 27µs making 1 call to MARC::File::USMARC::BEGIN@9
# spent 7µs making 1 call to strict::import |
10 | 3 | 31µs | 2 | 19µs | # spent 16µs (12+4) within MARC::File::USMARC::BEGIN@10 which was called:
# once (12µs+4µs) by C4::Biblio::BEGIN@28 at line 10 # spent 16µs making 1 call to MARC::File::USMARC::BEGIN@10
# spent 4µs making 1 call to integer::import |
11 | |||||
12 | 3 | 32µs | 2 | 84µs | # spent 47µs (9+37) within MARC::File::USMARC::BEGIN@12 which was called:
# once (9µs+37µs) by C4::Biblio::BEGIN@28 at line 12 # spent 47µs making 1 call to MARC::File::USMARC::BEGIN@12
# spent 37µs making 1 call to vars::import |
13 | 3 | 118µs | 2 | 675µs | # spent 627µs (260+367) within MARC::File::USMARC::BEGIN@13 which was called:
# once (260µs+367µs) by C4::Biblio::BEGIN@28 at line 13 # spent 627µs making 1 call to MARC::File::USMARC::BEGIN@13
# spent 48µs making 1 call to Exporter::import |
14 | |||||
15 | 3 | 128µs | 2 | 884µs | # spent 880µs (783+97) within MARC::File::USMARC::BEGIN@15 which was called:
# once (783µs+97µs) by C4::Biblio::BEGIN@28 at line 15 # spent 880µs making 1 call to MARC::File::USMARC::BEGIN@15
# spent 4µs making 1 call to UNIVERSAL::import |
16 | 4 | 53µs | 2 | 68µs | # spent 41µs (13+27) within MARC::File::USMARC::BEGIN@16 which was called:
# once (13µs+27µs) by C4::Biblio::BEGIN@28 at line 16 # spent 41µs making 1 call to MARC::File::USMARC::BEGIN@16
# spent 27µs making 1 call to vars::import |
17 | |||||
18 | 3 | 35µs | 2 | 90µs | # spent 51µs (13+39) within MARC::File::USMARC::BEGIN@18 which was called:
# once (13µs+39µs) by C4::Biblio::BEGIN@28 at line 18 # spent 51µs making 1 call to MARC::File::USMARC::BEGIN@18
# spent 39µs making 1 call to Exporter::import |
19 | 3 | 37µs | 2 | 19µs | # spent 17µs (15+2) within MARC::File::USMARC::BEGIN@19 which was called:
# once (15µs+2µs) by C4::Biblio::BEGIN@28 at line 19 # spent 17µs making 1 call to MARC::File::USMARC::BEGIN@19
# spent 2µs making 1 call to UNIVERSAL::import |
20 | 3 | 42µs | 2 | 118µs | # spent 65µs (13+53) within MARC::File::USMARC::BEGIN@20 which was called:
# once (13µs+53µs) by C4::Biblio::BEGIN@28 at line 20 # spent 65µs making 1 call to MARC::File::USMARC::BEGIN@20
# spent 52µs making 1 call to constant::import |
21 | 3 | 40µs | 2 | 85µs | # spent 48µs (10+38) within MARC::File::USMARC::BEGIN@21 which was called:
# once (10µs+38µs) by C4::Biblio::BEGIN@28 at line 21 # spent 48µs making 1 call to MARC::File::USMARC::BEGIN@21
# spent 38µs making 1 call to constant::import |
22 | 3 | 31µs | 2 | 80µs | # spent 46µs (10+35) within MARC::File::USMARC::BEGIN@22 which was called:
# once (10µs+35µs) by C4::Biblio::BEGIN@28 at line 22 # spent 46µs making 1 call to MARC::File::USMARC::BEGIN@22
# spent 35µs making 1 call to constant::import |
23 | 3 | 1.12ms | 2 | 72µs | # spent 41µs (9+32) within MARC::File::USMARC::BEGIN@23 which was called:
# once (9µs+32µs) by C4::Biblio::BEGIN@28 at line 23 # spent 41µs making 1 call to MARC::File::USMARC::BEGIN@23
# spent 32µs making 1 call to constant::import |
24 | |||||
25 | =head1 SYNOPSIS | ||||
26 | |||||
- - | |||||
45 | sub _next { | ||||
46 | my $self = shift; | ||||
47 | my $fh = $self->{fh}; | ||||
48 | |||||
49 | my $reclen; | ||||
50 | return if eof($fh); | ||||
51 | |||||
52 | local $/ = END_OF_RECORD; | ||||
53 | my $usmarc = <$fh>; | ||||
54 | |||||
55 | # remove illegal garbage that sometimes occurs between records | ||||
56 | $usmarc =~ s/^[ \x00\x0a\x0d\x1a]+//; | ||||
57 | |||||
58 | return $usmarc; | ||||
59 | } | ||||
60 | |||||
61 | =head2 decode( $string [, \&filter_func ] ) | ||||
62 | |||||
- - | |||||
97 | # spent 121ms (43.5+77.9) within MARC::File::USMARC::decode which was called 25 times, avg 4.85ms/call:
# 25 times (43.5ms+77.9ms) by C4::Search::searchResults at line 1701 of /usr/share/koha/lib/C4/Search.pm, avg 4.85ms/call | ||||
98 | |||||
99 | 500 | 10.4ms | my $text; | ||
100 | my $location = ''; | ||||
101 | |||||
102 | ## decode can be called in a variety of ways | ||||
103 | ## $object->decode( $string ) | ||||
104 | ## MARC::File::USMARC->decode( $string ) | ||||
105 | ## MARC::File::USMARC::decode( $string ) | ||||
106 | ## this bit of code covers all three | ||||
107 | |||||
108 | my $self = shift; | ||||
109 | 50 | 656µs | 25 | 59µs | if ( ref($self) =~ /^MARC::File/ ) { # spent 59µs making 25 calls to MARC::File::USMARC::CORE:match, avg 2µs/call |
110 | $location = 'in record '.$self->{recnum}; | ||||
111 | $text = shift; | ||||
112 | } else { | ||||
113 | $location = 'in record 1'; | ||||
114 | 25 | 88µs | $text = $self=~/MARC::File/ ? shift : $self; # spent 88µs making 25 calls to MARC::File::USMARC::CORE:match, avg 4µs/call | ||
115 | } | ||||
116 | my $filter_func = shift; | ||||
117 | |||||
118 | # ok this the empty shell we will fill | ||||
119 | 25 | 460µs | my $marc = MARC::Record->new(); # spent 460µs making 25 calls to MARC::Record::new, avg 18µs/call | ||
120 | |||||
121 | # Check for an all-numeric record length | ||||
122 | 25 | 221µs | ($text =~ /^(\d{5})/) # spent 221µs making 25 calls to MARC::File::USMARC::CORE:match, avg 9µs/call | ||
123 | or return $marc->_warn( "Record length \"", substr( $text, 0, 5 ), "\" is not numeric $location" ); | ||||
124 | |||||
125 | my $reclen = $1; | ||||
126 | 25 | 697µs | my $realLength = bytes::length( $text ); # spent 530µs making 1 call to bytes::AUTOLOAD
# spent 166µs making 24 calls to bytes::length, avg 7µs/call | ||
127 | $marc->_warn( "Invalid record length $location: Leader says $reclen " . | ||||
128 | "bytes but it's actually $realLength" ) unless $reclen == $realLength; | ||||
129 | |||||
130 | (substr($text, -1, 1) eq END_OF_RECORD) | ||||
131 | or $marc->_warn( "Invalid record terminator $location" ); | ||||
132 | |||||
133 | 25 | 286µs | $marc->leader( substr( $text, 0, LEADER_LEN ) ); # spent 286µs making 25 calls to MARC::Record::leader, avg 11µs/call | ||
134 | |||||
135 | # bytes 12 - 16 of leader give offset to the body of the record | ||||
136 | 25 | 152µs | my $data_start = 0 + bytes::substr( $text, 12, 5 ); # spent 152µs making 25 calls to bytes::substr, avg 6µs/call | ||
137 | |||||
138 | # immediately after the leader comes the directory (no separator) | ||||
139 | my $dir = substr( $text, LEADER_LEN, $data_start - LEADER_LEN - 1 ); # -1 to allow for \x1e at end of directory | ||||
140 | |||||
141 | # character after the directory must be \x1e | ||||
142 | (substr($text, $data_start-1, 1) eq END_OF_FIELD) | ||||
143 | or $marc->_warn( "No directory found $location" ); | ||||
144 | |||||
145 | # all directory entries 12 bytes long, so length % 12 must be 0 | ||||
146 | (length($dir) % DIRECTORY_ENTRY_LEN == 0) | ||||
147 | or $marc->_warn( "Invalid directory length $location" ); | ||||
148 | |||||
149 | |||||
150 | # go through all the fields | ||||
151 | my $nfields = length($dir)/DIRECTORY_ENTRY_LEN; | ||||
152 | 6528 | 18.7ms | for ( my $n = 0; $n < $nfields; $n++ ) { | ||
153 | 544 | 1.25ms | my ( $tagno, $len, $offset ) = unpack( "A3 A4 A5", substr($dir, $n*DIRECTORY_ENTRY_LEN, DIRECTORY_ENTRY_LEN) ); # spent 1.25ms making 544 calls to MARC::File::USMARC::CORE:unpack, avg 2µs/call | ||
154 | |||||
155 | # Check directory validity | ||||
156 | 544 | 1.15ms | ($tagno =~ /^[0-9A-Za-z]{3}$/) # spent 1.15ms making 544 calls to MARC::File::USMARC::CORE:match, avg 2µs/call | ||
157 | or $marc->_warn( "Invalid tag in directory $location: \"$tagno\"" ); | ||||
158 | |||||
159 | 544 | 534µs | ($len =~ /^\d{4}$/) # spent 534µs making 544 calls to MARC::File::USMARC::CORE:match, avg 981ns/call | ||
160 | or $marc->_warn( "Invalid length in directory $location tag $tagno: \"$len\"" ); | ||||
161 | |||||
162 | 544 | 463µs | ($offset =~ /^\d{5}$/) # spent 463µs making 544 calls to MARC::File::USMARC::CORE:match, avg 851ns/call | ||
163 | or $marc->_warn( "Invalid offset in directory $location tag $tagno: \"$offset\"" ); | ||||
164 | |||||
165 | ($offset + $len <= $reclen) | ||||
166 | or $marc->_warn( "Directory entry $location runs off the end of the record tag $tagno" ); | ||||
167 | |||||
168 | 544 | 1.91ms | my $tagdata = bytes::substr( $text, $data_start+$offset, $len ); # spent 1.91ms making 544 calls to bytes::substr, avg 4µs/call | ||
169 | |||||
170 | # if utf8 the we encode the string as utf8 | ||||
171 | 1088 | 31.1ms | if ( $marc->encoding() eq 'UTF-8' ) { # spent 25.7ms making 544 calls to MARC::File::Encode::marc_to_utf8, avg 47µs/call
# spent 5.37ms making 544 calls to MARC::Record::encoding, avg 10µs/call | ||
172 | $tagdata = marc_to_utf8( $tagdata ); | ||||
173 | } | ||||
174 | |||||
175 | 544 | 1.18ms | $marc->_warn( "Invalid length in directory for tag $tagno $location" ) # spent 1.18ms making 544 calls to bytes::length, avg 2µs/call | ||
176 | unless ( $len == bytes::length($tagdata) ); | ||||
177 | |||||
178 | 1088 | 1.02ms | if ( substr($tagdata, -1, 1) eq END_OF_FIELD ) { | ||
179 | # get rid of the end-of-tag character | ||||
180 | chop $tagdata; | ||||
181 | --$len; | ||||
182 | } else { | ||||
183 | $marc->_warn( "field does not end in end of field character in tag $tagno $location" ); | ||||
184 | } | ||||
185 | |||||
186 | warn "Specs: ", join( "|", $tagno, $len, $offset, $tagdata ), "\n" if $MARC::Record::DEBUG; | ||||
187 | |||||
188 | if ( $filter_func ) { | ||||
189 | next unless $filter_func->( $tagno, $tagdata ); | ||||
190 | } | ||||
191 | |||||
192 | 5120 | 10.7ms | 608 | 7.44ms | if ( MARC::Field->is_controlfield_tag($tagno) ) { # spent 5.67ms making 544 calls to MARC::Field::is_controlfield_tag, avg 10µs/call
# spent 951µs making 32 calls to MARC::Field::new, avg 30µs/call
# spent 812µs making 32 calls to MARC::Record::append_fields, avg 25µs/call |
193 | $marc->append_fields( MARC::Field->new( $tagno, $tagdata ) ); | ||||
194 | } else { | ||||
195 | my @subfields = split( SUBFIELD_INDICATOR, $tagdata ); | ||||
196 | my $indicators = shift @subfields; | ||||
197 | my ($ind1, $ind2); | ||||
198 | |||||
199 | 1024 | 697µs | if ( length( $indicators ) > 2 or length( $indicators ) == 0 ) { | ||
200 | $marc->_warn( "Invalid indicators \"$indicators\" forced to blanks $location for tag $tagno\n" ); | ||||
201 | ($ind1,$ind2) = (" ", " "); | ||||
202 | } else { | ||||
203 | $ind1 = substr( $indicators,0, 1 ); | ||||
204 | $ind2 = substr( $indicators,1, 1 ); | ||||
205 | } | ||||
206 | |||||
207 | # Split the subfield data into subfield name and data pairs | ||||
208 | my @subfield_data; | ||||
209 | for ( @subfields ) { | ||||
210 | 1319 | 2.69ms | if ( length > 0 ) { | ||
211 | push( @subfield_data, substr($_,0,1),substr($_,1) ); | ||||
212 | } else { | ||||
213 | $marc->_warn( "Entirely empty subfield found in tag $tagno" ); | ||||
214 | } | ||||
215 | } | ||||
216 | |||||
217 | if ( !@subfield_data ) { | ||||
218 | $marc->_warn( "no subfield data found $location for tag $tagno" ); | ||||
219 | next; | ||||
220 | } | ||||
221 | |||||
222 | 512 | 21.9ms | my $field = MARC::Field->new($tagno, $ind1, $ind2, @subfield_data ); # spent 21.9ms making 512 calls to MARC::Field::new, avg 43µs/call | ||
223 | 512 | 1.45ms | if ( $field->warnings() ) { # spent 1.45ms making 512 calls to MARC::Field::warnings, avg 3µs/call | ||
224 | $marc->_warn( $field->warnings() ); | ||||
225 | } | ||||
226 | 512 | 7.56ms | $marc->append_fields( $field ); # spent 7.56ms making 512 calls to MARC::Record::append_fields, avg 15µs/call | ||
227 | } | ||||
228 | } # looping through all the fields | ||||
229 | |||||
230 | |||||
231 | return $marc; | ||||
232 | } | ||||
233 | |||||
234 | =head2 update_leader() | ||||
235 | |||||
- - | |||||
243 | sub update_leader() { | ||||
244 | my $self = shift; | ||||
245 | |||||
246 | my (undef,undef,$reclen,$baseaddress) = $self->_build_tag_directory(); | ||||
247 | |||||
248 | $self->_set_leader_lengths( $reclen, $baseaddress ); | ||||
249 | } | ||||
250 | |||||
251 | =head2 _build_tag_directory() | ||||
252 | |||||
- - | |||||
262 | sub _build_tag_directory { | ||||
263 | my $marc = shift; | ||||
264 | $marc = shift if (ref($marc)||$marc) =~ /^MARC::File/; | ||||
265 | die "Wanted a MARC::Record but got a ", ref($marc) unless ref($marc) eq "MARC::Record"; | ||||
266 | |||||
267 | my @fields; | ||||
268 | my @directory; | ||||
269 | |||||
270 | my $dataend = 0; | ||||
271 | for my $field ( $marc->fields() ) { | ||||
272 | # Dump data into proper format | ||||
273 | my $str = $field->as_usmarc; | ||||
274 | push( @fields, $str ); | ||||
275 | |||||
276 | # Create directory entry | ||||
277 | my $len = bytes::length( $str ); | ||||
278 | |||||
279 | my $direntry = sprintf( "%03s%04d%05d", $field->tag, $len, $dataend ); | ||||
280 | push( @directory, $direntry ); | ||||
281 | $dataend += $len; | ||||
282 | } | ||||
283 | |||||
284 | my $baseaddress = | ||||
285 | LEADER_LEN + # better be 24 | ||||
286 | ( @directory * DIRECTORY_ENTRY_LEN ) + | ||||
287 | # all the directory entries | ||||
288 | 1; # end-of-field marker | ||||
289 | |||||
290 | |||||
291 | my $total = | ||||
292 | $baseaddress + # stuff before first field | ||||
293 | $dataend + # Length of the fields | ||||
294 | 1; # End-of-record marker | ||||
295 | |||||
- - | |||||
298 | return (\@fields, \@directory, $total, $baseaddress); | ||||
299 | } | ||||
300 | |||||
301 | =head2 encode() | ||||
302 | |||||
- - | |||||
308 | sub encode() { | ||||
309 | my $marc = shift; | ||||
310 | $marc = shift if (ref($marc)||$marc) =~ /^MARC::File/; | ||||
311 | |||||
312 | my ($fields,$directory,$reclen,$baseaddress) = _build_tag_directory($marc); | ||||
313 | $marc->set_leader_lengths( $reclen, $baseaddress ); | ||||
314 | |||||
315 | # Glomp it all together | ||||
316 | return join("",$marc->leader, @$directory, END_OF_FIELD, @$fields, END_OF_RECORD); | ||||
317 | } | ||||
318 | 1 | 4µs | 1; | ||
319 | |||||
320 | __END__ | ||||
# spent 2.52ms within MARC::File::USMARC::CORE:match which was called 1707 times, avg 1µs/call:
# 544 times (1.15ms+0s) by MARC::File::USMARC::decode at line 156, avg 2µs/call
# 544 times (534µs+0s) by MARC::File::USMARC::decode at line 159, avg 981ns/call
# 544 times (463µs+0s) by MARC::File::USMARC::decode at line 162, avg 851ns/call
# 25 times (221µs+0s) by MARC::File::USMARC::decode at line 122, avg 9µs/call
# 25 times (88µs+0s) by MARC::File::USMARC::decode at line 114, avg 4µs/call
# 25 times (59µs+0s) by MARC::File::USMARC::decode at line 109, avg 2µs/call | |||||
# spent 1.25ms within MARC::File::USMARC::CORE:unpack which was called 544 times, avg 2µs/call:
# 544 times (1.25ms+0s) by MARC::File::USMARC::decode at line 153, avg 2µs/call |