Filename | /usr/share/perl5/MARC/File/XML.pm |
Statements | Executed 24689 statements in 82.3ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
25 | 1 | 1 | 34.5ms | 103ms | record | MARC::File::XML::
4263 | 7 | 1 | 33.4ms | 42.2ms | escape | MARC::File::XML::
4107 | 1 | 1 | 6.98ms | 6.98ms | CORE:subst (opcode) | MARC::File::XML::
25 | 1 | 1 | 2.45ms | 467ms | decode | MARC::File::XML::
4107 | 1 | 1 | 1.84ms | 1.84ms | CORE:regcomp (opcode) | MARC::File::XML::
25 | 1 | 1 | 1.63ms | 105ms | encode | MARC::File::XML::
1 | 1 | 1 | 923µs | 43.1ms | BEGIN@9 | MARC::File::XML::
25 | 1 | 1 | 433µs | 468ms | new_from_xml | MARC::Record::
25 | 1 | 1 | 357µs | 540µs | decideMARC8Binary | MARC::File::XML::
125 | 5 | 1 | 351µs | 351µs | CORE:match (opcode) | MARC::File::XML::
25 | 1 | 1 | 279µs | 105ms | as_xml | MARC::Record::
25 | 1 | 1 | 256µs | 256µs | default_record_format | MARC::File::XML::
25 | 1 | 1 | 238µs | 238µs | header | MARC::File::XML::
25 | 1 | 1 | 112µs | 112µs | footer | MARC::File::XML::
6 | 1 | 1 | 21µs | 21µs | CORE:substcont (opcode) | MARC::File::XML::
1 | 1 | 1 | 20µs | 125µs | BEGIN@6 | MARC::File::XML::
1 | 1 | 1 | 19µs | 36µs | BEGIN@3 | MARC::File::XML::
1 | 1 | 1 | 17µs | 214µs | BEGIN@13 | MARC::File::XML::
1 | 1 | 1 | 16µs | 80µs | BEGIN@14 | MARC::File::XML::
1 | 1 | 1 | 13µs | 13µs | import | MARC::File::XML::
1 | 1 | 1 | 13µs | 37µs | BEGIN@7 | MARC::File::XML::
1 | 1 | 1 | 13µs | 64µs | BEGIN@10 | MARC::File::XML::
1 | 1 | 1 | 12µs | 16µs | BEGIN@4 | MARC::File::XML::
1 | 1 | 1 | 11µs | 13µs | BEGIN@8 | MARC::File::XML::
1 | 1 | 1 | 11µs | 49µs | BEGIN@12 | MARC::File::XML::
1 | 1 | 1 | 8µs | 51µs | BEGIN@5 | MARC::File::XML::
1 | 1 | 1 | 6µs | 6µs | BEGIN@15 | MARC::File::XML::
1 | 1 | 1 | 5µs | 5µs | CORE:qr (opcode) | MARC::File::XML::
0 | 0 | 0 | 0s | 0s | DESTROY | MARC::File::XML::
0 | 0 | 0 | 0s | 0s | _next | MARC::File::XML::
0 | 0 | 0 | 0s | 0s | _unimarc_encoding | MARC::File::XML::
0 | 0 | 0 | 0s | 0s | close | MARC::File::XML::
0 | 0 | 0 | 0s | 0s | out | MARC::File::XML::
0 | 0 | 0 | 0s | 0s | write | MARC::File::XML::
0 | 0 | 0 | 0s | 0s | as_xml_record | MARC::Record::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package MARC::File::XML; | ||||
2 | |||||
3 | 3 | 32µs | 2 | 54µs | # spent 36µs (19+18) within MARC::File::XML::BEGIN@3 which was called:
# once (19µs+18µs) by C4::Biblio::BEGIN@29 at line 3 # spent 36µs making 1 call to MARC::File::XML::BEGIN@3
# spent 18µs making 1 call to warnings::import |
4 | 3 | 30µs | 2 | 19µs | # spent 16µs (12+4) within MARC::File::XML::BEGIN@4 which was called:
# once (12µs+4µs) by C4::Biblio::BEGIN@29 at line 4 # spent 16µs making 1 call to MARC::File::XML::BEGIN@4
# spent 4µs making 1 call to strict::import |
5 | 3 | 36µs | 2 | 94µs | # spent 51µs (8+43) within MARC::File::XML::BEGIN@5 which was called:
# once (8µs+43µs) by C4::Biblio::BEGIN@29 at line 5 # spent 51µs making 1 call to MARC::File::XML::BEGIN@5
# spent 43µs making 1 call to vars::import |
6 | 3 | 38µs | 2 | 230µs | # spent 125µs (20+105) within MARC::File::XML::BEGIN@6 which was called:
# once (20µs+105µs) by C4::Biblio::BEGIN@29 at line 6 # spent 125µs making 1 call to MARC::File::XML::BEGIN@6
# spent 105µs making 1 call to base::import |
7 | 3 | 27µs | 2 | 61µs | # spent 37µs (13+24) within MARC::File::XML::BEGIN@7 which was called:
# once (13µs+24µs) by C4::Biblio::BEGIN@29 at line 7 # spent 37µs making 1 call to MARC::File::XML::BEGIN@7
# spent 24µs making 1 call to Exporter::import |
8 | 3 | 25µs | 2 | 15µs | # spent 13µs (11+2) within MARC::File::XML::BEGIN@8 which was called:
# once (11µs+2µs) by C4::Biblio::BEGIN@29 at line 8 # spent 13µs making 1 call to MARC::File::XML::BEGIN@8
# spent 2µs making 1 call to UNIVERSAL::import |
9 | 3 | 150µs | 2 | 43.1ms | # spent 43.1ms (923µs+42.2) within MARC::File::XML::BEGIN@9 which was called:
# once (923µs+42.2ms) by C4::Biblio::BEGIN@29 at line 9 # spent 43.1ms making 1 call to MARC::File::XML::BEGIN@9
# spent 4µs making 1 call to UNIVERSAL::import |
10 | 3 | 37µs | 2 | 114µs | # spent 64µs (13+51) within MARC::File::XML::BEGIN@10 which was called:
# once (13µs+51µs) by C4::Biblio::BEGIN@29 at line 10 # spent 64µs making 1 call to MARC::File::XML::BEGIN@10
# spent 51µs making 1 call to Exporter::import |
11 | |||||
12 | 3 | 29µs | 2 | 87µs | # spent 49µs (11+38) within MARC::File::XML::BEGIN@12 which was called:
# once (11µs+38µs) by C4::Biblio::BEGIN@29 at line 12 # spent 49µs making 1 call to MARC::File::XML::BEGIN@12
# spent 38µs making 1 call to Exporter::import |
13 | 3 | 38µs | 2 | 412µs | # spent 214µs (17+197) within MARC::File::XML::BEGIN@13 which was called:
# once (17µs+197µs) by C4::Biblio::BEGIN@29 at line 13 # spent 214µs making 1 call to MARC::File::XML::BEGIN@13
# spent 197µs making 1 call to Exporter::import |
14 | 3 | 38µs | 2 | 144µs | # spent 80µs (16+64) within MARC::File::XML::BEGIN@14 which was called:
# once (16µs+64µs) by C4::Biblio::BEGIN@29 at line 14 # spent 80µs making 1 call to MARC::File::XML::BEGIN@14
# spent 64µs making 1 call to Exporter::import |
15 | 3 | 2.00ms | 1 | 6µs | # spent 6µs within MARC::File::XML::BEGIN@15 which was called:
# once (6µs+0s) by C4::Biblio::BEGIN@29 at line 15 # spent 6µs making 1 call to MARC::File::XML::BEGIN@15 |
16 | |||||
17 | 1 | 1µs | $VERSION = '0.92'; | ||
18 | |||||
19 | 1 | 9µs | 1 | 771µs | my $factory = XML::SAX::ParserFactory->new(); # spent 771µs making 1 call to XML::SAX::ParserFactory::new |
20 | 1 | 5µs | 1 | 10µs | $factory->require_feature(Namespaces); # spent 10µs making 1 call to XML::SAX::ParserFactory::require_feature |
21 | |||||
22 | # spent 13µs within MARC::File::XML::import which was called:
# once (13µs+0s) by C4::Biblio::BEGIN@29 at line 29 of /usr/share/koha/lib/C4/Biblio.pm | ||||
23 | 4 | 18µs | my $class = shift; | ||
24 | %_load_args = @_; | ||||
25 | $_load_args{ DefaultEncoding } ||= 'UTF-8'; | ||||
26 | $_load_args{ RecordFormat } ||= 'USMARC'; | ||||
27 | } | ||||
28 | |||||
29 | =head1 NAME | ||||
30 | |||||
- - | |||||
101 | # spent 256µs within MARC::File::XML::default_record_format which was called 25 times, avg 10µs/call:
# 25 times (256µs+0s) by C4::Biblio::GetMarcBiblio at line 1259 of /usr/share/koha/lib/C4/Biblio.pm, avg 10µs/call | ||||
102 | 100 | 290µs | my $self = shift; | ||
103 | my $format = shift; | ||||
104 | |||||
105 | $_load_args{RecordFormat} = $format if ($format); | ||||
106 | |||||
107 | return $_load_args{RecordFormat}; | ||||
108 | } | ||||
109 | |||||
110 | |||||
111 | =head2 as_xml() | ||||
112 | |||||
- - | |||||
121 | # spent 105ms (279µs+105) within MARC::Record::as_xml which was called 25 times, avg 4.19ms/call:
# 25 times (279µs+105ms) by C4::XSLT::XSLTParse4Display at line 200 of /usr/share/koha/lib/C4/XSLT.pm, avg 4.19ms/call | ||||
122 | 75 | 315µs | my $record = shift; | ||
123 | my $format = shift || $_load_args{RecordFormat}; | ||||
124 | 25 | 105ms | return( MARC::File::XML::encode( $record, $format ) ); # spent 105ms making 25 calls to MARC::File::XML::encode, avg 4.18ms/call | ||
125 | } | ||||
126 | |||||
127 | =head2 as_xml_record([$format]) | ||||
128 | |||||
- - | |||||
137 | sub MARC::Record::as_xml_record { | ||||
138 | my $record = shift; | ||||
139 | my $format = shift || $_load_args{RecordFormat}; | ||||
140 | return( MARC::File::XML::encode( $record, $format, 1 ) ); | ||||
141 | } | ||||
142 | |||||
143 | =head2 new_from_xml([$encoding, $format]) | ||||
144 | |||||
- - | |||||
157 | # spent 468ms (433µs+467) within MARC::Record::new_from_xml which was called 25 times, avg 18.7ms/call:
# 25 times (433µs+467ms) by C4::Biblio::GetMarcBiblio at line 1263 of /usr/share/koha/lib/C4/Biblio.pm, avg 18.7ms/call | ||||
158 | 125 | 341µs | my $xml = shift; | ||
159 | ## to allow calling as MARC::Record::new_from_xml() | ||||
160 | ## or MARC::Record->new_from_xml() | ||||
161 | $xml = shift if ( ref($xml) || ($xml eq "MARC::Record") ); | ||||
162 | |||||
163 | my $enc = shift || $_load_args{BinaryEncoding}; | ||||
164 | my $format = shift || $_load_args{RecordFormat}; | ||||
165 | 25 | 467ms | return( MARC::File::XML::decode( $xml, $enc, $format ) ); # spent 467ms making 25 calls to MARC::File::XML::decode, avg 18.7ms/call | ||
166 | } | ||||
167 | |||||
168 | =pod | ||||
169 | |||||
- - | |||||
184 | sub out { | ||||
185 | my ( $class, $filename, $enc ) = @_; | ||||
186 | my $fh = IO::File->new( ">$filename" ) or croak( $! ); | ||||
187 | $enc ||= $_load_args{DefaultEncoding}; | ||||
188 | |||||
189 | if ($enc =~ /^utf-?8$/oi) { | ||||
190 | $fh->binmode(':utf8'); | ||||
191 | } else { | ||||
192 | $fh->binmode(':raw'); | ||||
193 | } | ||||
194 | |||||
195 | my %self = ( | ||||
196 | filename => $filename, | ||||
197 | fh => $fh, | ||||
198 | header => 0, | ||||
199 | encoding => $enc | ||||
200 | ); | ||||
201 | return( bless \%self, ref( $class ) || $class ); | ||||
202 | } | ||||
203 | |||||
204 | =head2 write() | ||||
205 | |||||
- - | |||||
214 | sub write { | ||||
215 | my ( $self, $record, $enc ) = @_; | ||||
216 | if ( ! $self->{ fh } ) { | ||||
217 | croak( "MARC::File::XML object not open for writing" ); | ||||
218 | } | ||||
219 | if ( ! $record ) { | ||||
220 | croak( "must pass write() a MARC::Record object" ); | ||||
221 | } | ||||
222 | ## print the XML header if we haven't already | ||||
223 | if ( ! $self->{ header } ) { | ||||
224 | $enc ||= $self->{ encoding } || $_load_args{DefaultEncoding}; | ||||
225 | $self->{ fh }->print( header( $enc ) ); | ||||
226 | $self->{ header } = 1; | ||||
227 | } | ||||
228 | ## print out the record | ||||
229 | $self->{ fh }->print( record( $record ) ) || croak( $! ); | ||||
230 | return( 1 ); | ||||
231 | } | ||||
232 | |||||
233 | =head2 close() | ||||
234 | |||||
- - | |||||
241 | sub close { | ||||
242 | my $self = shift; | ||||
243 | if ( $self->{ fh } ) { | ||||
244 | $self->{ fh }->print( footer() ) if $self->{ header }; | ||||
245 | $self->{ fh } = undef; | ||||
246 | $self->{ filename } = undef; | ||||
247 | $self->{ header } = undef; | ||||
248 | } | ||||
249 | return( 1 ); | ||||
250 | } | ||||
251 | |||||
252 | ## makes sure that the XML file is closed off | ||||
253 | |||||
254 | sub DESTROY { | ||||
255 | shift->close(); | ||||
256 | } | ||||
257 | |||||
258 | =pod | ||||
259 | |||||
- - | |||||
278 | # spent 238µs within MARC::File::XML::header which was called 25 times, avg 10µs/call:
# 25 times (238µs+0s) by MARC::File::XML::encode at line 480, avg 10µs/call | ||||
279 | 100 | 238µs | my $enc = shift; | ||
280 | $enc = shift if ( $enc && (ref($enc) || ($enc eq "MARC::File::XML")) ); | ||||
281 | $enc ||= 'UTF-8'; | ||||
282 | return( <<MARC_XML_HEADER ); | ||||
283 | <?xml version="1.0" encoding="$enc"?> | ||||
284 | <collection | ||||
285 | xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" | ||||
286 | xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd" | ||||
287 | xmlns="http://www.loc.gov/MARC21/slim"> | ||||
288 | MARC_XML_HEADER | ||||
289 | } | ||||
290 | |||||
291 | =head2 footer() | ||||
292 | |||||
- - | |||||
297 | # spent 112µs within MARC::File::XML::footer which was called 25 times, avg 4µs/call:
# 25 times (112µs+0s) by MARC::File::XML::encode at line 486, avg 4µs/call | ||||
298 | 25 | 130µs | return( "</collection>" ); | ||
299 | } | ||||
300 | |||||
301 | =head2 record() | ||||
302 | |||||
- - | |||||
307 | # spent 103ms (34.5+68.1) within MARC::File::XML::record which was called 25 times, avg 4.10ms/call:
# 25 times (34.5ms+68.1ms) by MARC::File::XML::encode at line 485, avg 4.10ms/call | ||||
308 | 400 | 2.88ms | my $record = shift; | ||
309 | my $format = shift; | ||||
310 | my $include_full_record_header = shift; | ||||
311 | my $enc = shift; | ||||
312 | |||||
313 | $format ||= $_load_args{RecordFormat}; | ||||
314 | |||||
315 | my $_transcode = 0; | ||||
316 | 25 | 207µs | my $ldr = $record->leader; # spent 207µs making 25 calls to MARC::Record::leader, avg 8µs/call | ||
317 | my $original_encoding = substr($ldr,9,1); | ||||
318 | |||||
319 | # Does the record think it is already Unicode? | ||||
320 | if ($original_encoding ne 'a' && lc($format) !~ /^unimarc/o) { | ||||
321 | # If not, we'll make it so | ||||
322 | $_transcode++; | ||||
323 | substr($ldr,9,1,'a'); | ||||
324 | $record->leader( $ldr ); | ||||
325 | } | ||||
326 | |||||
327 | my @xml = (); | ||||
328 | |||||
329 | 25 | 33µs | if ($include_full_record_header) { | ||
330 | push @xml, <<HEADER | ||||
331 | <?xml version="1.0" encoding="$enc"?> | ||||
332 | <record | ||||
333 | xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" | ||||
334 | xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd" | ||||
335 | xmlns="http://www.loc.gov/MARC21/slim"> | ||||
336 | HEADER | ||||
337 | |||||
338 | } else { | ||||
339 | push( @xml, "<record>" ); | ||||
340 | } | ||||
341 | |||||
342 | 50 | 662µs | push( @xml, " <leader>" . escape( $record->leader ) . "</leader>" ); # spent 583µs making 25 calls to MARC::File::XML::escape, avg 23µs/call
# spent 79µs making 25 calls to MARC::Record::leader, avg 3µs/call | ||
343 | |||||
344 | 25 | 299µs | foreach my $field ( $record->fields() ) { # spent 299µs making 25 calls to MARC::Record::fields, avg 12µs/call | ||
345 | 1088 | 5.07ms | 1088 | 7.99ms | my ($tag) = escape( $field->tag() ); # spent 5.69ms making 544 calls to MARC::File::XML::escape, avg 10µs/call
# spent 2.29ms making 544 calls to MARC::Field::tag, avg 4µs/call |
346 | 2624 | 9.20ms | 544 | 1.84ms | if ( $field->is_control_field() ) { # spent 1.84ms making 544 calls to MARC::Field::is_control_field, avg 3µs/call |
347 | 32 | 380µs | my $data = $field->data; # spent 380µs making 32 calls to MARC::Field::data, avg 12µs/call | ||
348 | 32 | 325µs | push( @xml, qq( <controlfield tag="$tag">) . # spent 325µs making 32 calls to MARC::File::XML::escape, avg 10µs/call | ||
349 | escape( ($_transcode ? marc8_to_utf8($data) : $data) ). qq(</controlfield>) ); | ||||
350 | } else { | ||||
351 | 1024 | 10.1ms | my ($i1) = escape( $field->indicator( 1 ) ); # spent 5.15ms making 512 calls to MARC::Field::indicator, avg 10µs/call
# spent 4.99ms making 512 calls to MARC::File::XML::escape, avg 10µs/call | ||
352 | 1024 | 10.4ms | my ($i2) = escape( $field->indicator( 2 ) ); # spent 5.27ms making 512 calls to MARC::Field::indicator, avg 10µs/call
# spent 5.09ms making 512 calls to MARC::File::XML::escape, avg 10µs/call | ||
353 | push( @xml, qq( <datafield tag="$tag" ind1="$i1" ind2="$i2">) ); | ||||
354 | 512 | 10.3ms | foreach my $subfield ( $field->subfields() ) { # spent 10.3ms making 512 calls to MARC::Field::subfields, avg 20µs/call | ||
355 | 2638 | 11.4ms | 1319 | 13.1ms | my ( $code, $data ) = ( escape( $$subfield[0] ), $$subfield[1] ); # spent 13.1ms making 1319 calls to MARC::File::XML::escape, avg 10µs/call |
356 | 1319 | 12.4ms | push( @xml, qq( <subfield code="$code">). # spent 12.4ms making 1319 calls to MARC::File::XML::escape, avg 9µs/call | ||
357 | escape( ($_transcode ? marc8_to_utf8($data) : $data) ).qq(</subfield>) ); | ||||
358 | } | ||||
359 | push( @xml, " </datafield>" ); | ||||
360 | } | ||||
361 | } | ||||
362 | push( @xml, "</record>\n" ); | ||||
363 | |||||
364 | if ($_transcode) { | ||||
365 | substr($ldr,9,1,$original_encoding); | ||||
366 | $record->leader( $ldr ); | ||||
367 | } | ||||
368 | |||||
369 | return( join( "\n", @xml ) ); | ||||
370 | } | ||||
371 | |||||
372 | 1 | 9µs | my %ESCAPES = ( | ||
373 | '&' => '&', | ||||
374 | '<' => '<', | ||||
375 | '>' => '>', | ||||
376 | ); | ||||
377 | my $ESCAPE_REGEX = | ||||
378 | eval 'qr/' . | ||||
379 | 4 | 120µs | join( '|', map { $_ = "\Q$_\E" } keys %ESCAPES ) . # spent 19µs executing statements in string eval | ||
380 | '/;' | ||||
381 | ; | ||||
382 | |||||
383 | # spent 42.2ms (33.4+8.84) within MARC::File::XML::escape which was called 4263 times, avg 10µs/call:
# 1319 times (10.4ms+2.73ms) by MARC::File::XML::record at line 355, avg 10µs/call
# 1319 times (9.89ms+2.51ms) by MARC::File::XML::record at line 356, avg 9µs/call
# 544 times (4.47ms+1.22ms) by MARC::File::XML::record at line 345, avg 10µs/call
# 512 times (4.06ms+1.03ms) by MARC::File::XML::record at line 352, avg 10µs/call
# 512 times (3.94ms+1.05ms) by MARC::File::XML::record at line 351, avg 10µs/call
# 32 times (250µs+75µs) by MARC::File::XML::record at line 348, avg 10µs/call
# 25 times (369µs+214µs) by MARC::File::XML::record at line 342, avg 23µs/call | ||||
384 | 16740 | 45.1ms | my $string = shift; | ||
385 | return '' if ! defined $string or $string eq ''; | ||||
386 | 8220 | 8.84ms | $string =~ s/($ESCAPE_REGEX)/$ESCAPES{$1}/oge; # spent 6.98ms making 4107 calls to MARC::File::XML::CORE:subst, avg 2µs/call
# spent 1.84ms making 4107 calls to MARC::File::XML::CORE:regcomp, avg 447ns/call
# spent 21µs making 6 calls to MARC::File::XML::CORE:substcont, avg 4µs/call | ||
387 | return( $string ); | ||||
388 | } | ||||
389 | |||||
390 | sub _next { | ||||
391 | my $self = shift; | ||||
392 | my $fh = $self->{ fh }; | ||||
393 | |||||
394 | ## return undef at the end of the file | ||||
395 | return if eof($fh); | ||||
396 | |||||
397 | ## get a chunk of xml for a record | ||||
398 | local $/ = '</record>'; | ||||
399 | my $xml = <$fh>; | ||||
400 | |||||
401 | ## trim stuff before the start record element | ||||
402 | $xml =~ s/.*<record.*?>/<record>/s; | ||||
403 | |||||
404 | ## return undef if there isn't a good chunk of xml | ||||
405 | return if ( $xml !~ m|<record>.*</record>|s ); | ||||
406 | |||||
407 | ## return the chunk of xml | ||||
408 | return( $xml ); | ||||
409 | } | ||||
410 | |||||
411 | =head2 decode() | ||||
412 | |||||
- - | |||||
420 | # spent 467ms (2.45+465) within MARC::File::XML::decode which was called 25 times, avg 18.7ms/call:
# 25 times (2.45ms+465ms) by MARC::Record::new_from_xml at line 165, avg 18.7ms/call | ||||
421 | 275 | 2.25ms | my $text; | ||
422 | my $location = ''; | ||||
423 | my $self = shift; | ||||
424 | |||||
425 | ## see MARC::File::USMARC::decode for explanation of what's going on | ||||
426 | ## here | ||||
427 | 50 | 324µs | 25 | 45µs | if ( ref($self) =~ /^MARC::File/ ) { # spent 45µs making 25 calls to MARC::File::XML::CORE:match, avg 2µs/call |
428 | $location = 'in record '.$self->{recnum}; | ||||
429 | $text = shift; | ||||
430 | } else { | ||||
431 | $location = 'in record 1'; | ||||
432 | 25 | 93µs | $text = $self=~/MARC::File/ ? shift : $self; # spent 93µs making 25 calls to MARC::File::XML::CORE:match, avg 4µs/call | ||
433 | } | ||||
434 | |||||
435 | my $enc = shift || $_load_args{BinaryEncoding}; | ||||
436 | my $format = shift || $_load_args{RecordFormat}; | ||||
437 | |||||
438 | 25 | 385µs | my $handler = MARC::File::SAX->new(); # spent 385µs making 25 calls to MARC::File::SAX::new, avg 15µs/call | ||
439 | 25 | 12.1ms | my $parser = $factory->parser( # spent 12.1ms making 25 calls to XML::SAX::ParserFactory::parser, avg 484µs/call | ||
440 | Handler => $handler, | ||||
441 | ProtocolEncoding => $_load_args{DefaultEncoding} | ||||
442 | ); | ||||
443 | 25 | 540µs | $parser->{ Handler }{ toMARC8 } = decideMARC8Binary($format,$enc); # spent 540µs making 25 calls to MARC::File::XML::decideMARC8Binary, avg 22µs/call | ||
444 | |||||
445 | 25 | 451ms | $parser->parse_string( $text ); # spent 451ms making 25 calls to XML::SAX::Base::parse_string, avg 18.1ms/call | ||
446 | |||||
447 | 25 | 166µs | return( $handler->record() ); # spent 166µs making 25 calls to MARC::File::SAX::record, avg 7µs/call | ||
448 | } | ||||
449 | |||||
450 | # spent 540µs (357+183) within MARC::File::XML::decideMARC8Binary which was called 25 times, avg 22µs/call:
# 25 times (357µs+183µs) by MARC::File::XML::decode at line 443, avg 22µs/call | ||||
451 | 100 | 534µs | my $format = shift; | ||
452 | my $enc = shift; | ||||
453 | |||||
454 | 25 | 28µs | return 0 if (defined($format) && lc($format) =~ /^unimarc/o); # spent 28µs making 25 calls to MARC::File::XML::CORE:match, avg 1µs/call | ||
455 | 25 | 155µs | return 0 if (defined($enc) && lc($enc) =~ /^utf-?8/o); # spent 155µs making 25 calls to MARC::File::XML::CORE:match, avg 6µs/call | ||
456 | return 1; | ||||
457 | } | ||||
458 | |||||
459 | |||||
460 | =head2 encode() | ||||
461 | |||||
- - | |||||
469 | # spent 105ms (1.63+103) within MARC::File::XML::encode which was called 25 times, avg 4.18ms/call:
# 25 times (1.63ms+103ms) by MARC::Record::as_xml at line 124, avg 4.18ms/call | ||||
470 | 275 | 1.53ms | my $record = shift; | ||
471 | my $format = shift || $_load_args{RecordFormat}; | ||||
472 | my $without_collection_header = shift; | ||||
473 | my $enc = shift || $_load_args{DefaultEncoding}; | ||||
474 | |||||
475 | 25 | 31µs | if (lc($format) =~ /^unimarc/o) { # spent 31µs making 25 calls to MARC::File::XML::CORE:match, avg 1µs/call | ||
476 | $enc = _unimarc_encoding( $format => $record ); | ||||
477 | } | ||||
478 | |||||
479 | my @xml = (); | ||||
480 | 25 | 238µs | push( @xml, header( $enc ) ) unless ($without_collection_header); # spent 238µs making 25 calls to MARC::File::XML::header, avg 10µs/call | ||
481 | # verbose, but naming the header output flags this way to avoid | ||||
482 | # the potential confusion identified in CPAN bug #34082 | ||||
483 | # http://rt.cpan.org/Public/Bug/Display.html?id=34082 | ||||
484 | my $include_full_record_header = ($without_collection_header) ? 1 : 0; | ||||
485 | 25 | 103ms | push( @xml, record( $record, $format, $include_full_record_header, $enc ) ); # spent 103ms making 25 calls to MARC::File::XML::record, avg 4.10ms/call | ||
486 | 25 | 112µs | push( @xml, footer() ) unless ($without_collection_header); # spent 112µs making 25 calls to MARC::File::XML::footer, avg 4µs/call | ||
487 | |||||
488 | return( join( "\n", @xml ) ); | ||||
489 | } | ||||
490 | |||||
491 | sub _unimarc_encoding { | ||||
492 | my $f = shift; | ||||
493 | my $r = shift; | ||||
494 | |||||
495 | my $pos = 26; | ||||
496 | $pos = 13 if (lc($f) eq 'unimarcauth'); | ||||
497 | |||||
498 | my $enc = substr( $r->subfield(100 => 'a'), $pos, 2 ); | ||||
499 | |||||
500 | if ($enc eq '01' || $enc eq '03') { | ||||
501 | return 'ISO-8859-1'; | ||||
502 | } elsif ($enc eq '50') { | ||||
503 | return 'UTF-8'; | ||||
504 | } else { | ||||
505 | die "Unsupported UNIMARC character encoding [$enc] for XML output for $f; 100\$a -> " . $r->subfield(100 => 'a'); | ||||
506 | } | ||||
507 | } | ||||
508 | |||||
509 | =head1 TODO | ||||
510 | |||||
- - | |||||
543 | 1 | 14µs | 1; | ||
# spent 351µs within MARC::File::XML::CORE:match which was called 125 times, avg 3µs/call:
# 25 times (155µs+0s) by MARC::File::XML::decideMARC8Binary at line 455, avg 6µs/call
# 25 times (93µs+0s) by MARC::File::XML::decode at line 432, avg 4µs/call
# 25 times (45µs+0s) by MARC::File::XML::decode at line 427, avg 2µs/call
# 25 times (31µs+0s) by MARC::File::XML::encode at line 475, avg 1µs/call
# 25 times (28µs+0s) by MARC::File::XML::decideMARC8Binary at line 454, avg 1µs/call | |||||
# spent 5µs within MARC::File::XML::CORE:qr which was called:
# once (5µs+0s) by C4::Biblio::BEGIN@29 at line 1 of (eval 978)[MARC/File/XML.pm:379] | |||||
# spent 1.84ms within MARC::File::XML::CORE:regcomp which was called 4107 times, avg 447ns/call:
# 4107 times (1.84ms+0s) by MARC::File::XML::escape at line 386, avg 447ns/call | |||||
# spent 6.98ms within MARC::File::XML::CORE:subst which was called 4107 times, avg 2µs/call:
# 4107 times (6.98ms+0s) by MARC::File::XML::escape at line 386, avg 2µs/call | |||||
# spent 21µs within MARC::File::XML::CORE:substcont which was called 6 times, avg 4µs/call:
# 6 times (21µs+0s) by MARC::File::XML::escape at line 386, avg 4µs/call |