← Index
NYTProf Performance Profile   « block view • line view • sub view »
For conv.pl
  Run on Sun Nov 14 22:06:10 2010
Reported on Sun Nov 14 22:07:07 2010

Filename/home/gmc/projects/marcpm/marc-xml/lib/MARC/File/XML.pm
StatementsExecuted 1533790 statements in 6.25s
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
5000114.66s9.89sMARC::File::XML::::decodeMARC::File::XML::decode
508463111972ms972msMARC::File::XML::::CORE:matchMARC::File::XML::CORE:match (opcode)
12075831369ms369msMARC::File::XML::::CORE:substMARC::File::XML::CORE:subst (opcode)
500011181ms371msMARC::File::XML::::_nextMARC::File::XML::_next
50001168.4ms85.2msMARC::File::XML::::decideMARC8BinaryMARC::File::XML::decideMARC8Binary
50001157.6ms57.6msMARC::File::XML::::CORE:readlineMARC::File::XML::CORE:readline (opcode)
5000116.75ms6.75msMARC::File::XML::::CORE:eofMARC::File::XML::CORE:eof (opcode)
1113.04ms3.18msMARC::File::XML::::BEGIN@3MARC::File::XML::BEGIN@3
1112.91ms9.44msMARC::File::XML::::BEGIN@7MARC::File::XML::BEGIN@7
1112.36ms73.7msMARC::File::XML::::BEGIN@10MARC::File::XML::BEGIN@10
1111.49ms3.01msMARC::File::XML::::BEGIN@6MARC::File::XML::BEGIN@6
111585µs1.30msMARC::File::XML::::BEGIN@5MARC::File::XML::BEGIN@5
111503µs554µsMARC::File::XML::::BEGIN@4MARC::File::XML::BEGIN@4
11128µs28µsMARC::File::XML::::closeMARC::File::XML::close
11125µs380µsMARC::File::XML::::BEGIN@11MARC::File::XML::BEGIN@11
11123µs51µsMARC::File::XML::::DESTROYMARC::File::XML::DESTROY
11113µs13µsMARC::File::XML::::importMARC::File::XML::import
11112µs68µsMARC::File::XML::::BEGIN@12MARC::File::XML::BEGIN@12
1119µs9µsMARC::File::XML::::BEGIN@8MARC::File::XML::BEGIN@8
1118µs8µsMARC::File::XML::::BEGIN@13MARC::File::XML::BEGIN@13
1118µs8µsMARC::File::XML::::CORE:qrMARC::File::XML::CORE:qr (opcode)
0000s0sMARC::File::XML::::_unimarc_encodingMARC::File::XML::_unimarc_encoding
0000s0sMARC::File::XML::::default_record_formatMARC::File::XML::default_record_format
0000s0sMARC::File::XML::::encodeMARC::File::XML::encode
0000s0sMARC::File::XML::::escapeMARC::File::XML::escape
0000s0sMARC::File::XML::::footerMARC::File::XML::footer
0000s0sMARC::File::XML::::headerMARC::File::XML::header
0000s0sMARC::File::XML::::outMARC::File::XML::out
0000s0sMARC::File::XML::::recordMARC::File::XML::record
0000s0sMARC::File::XML::::writeMARC::File::XML::write
0000s0sMARC::Record::::as_xml MARC::Record::as_xml
0000s0sMARC::Record::::as_xml_record MARC::Record::as_xml_record
0000s0sMARC::Record::::new_from_xml MARC::Record::new_from_xml
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::XML;
2
332.82ms23.23ms
# spent 3.18ms (3.04+132µs) within MARC::File::XML::BEGIN@3 which was called: # once (3.04ms+132µs) by main::BEGIN@3 at line 3
use warnings;
# spent 3.18ms making 1 call to MARC::File::XML::BEGIN@3 # spent 55µs making 1 call to warnings::import
43488µs2561µs
# spent 554µs (503+51) within MARC::File::XML::BEGIN@4 which was called: # once (503µs+51µs) by main::BEGIN@3 at line 4
use strict;
# spent 554µs making 1 call to MARC::File::XML::BEGIN@4 # spent 7µs making 1 call to strict::import
53175µs21.39ms
# spent 1.30ms (585µs+719µs) within MARC::File::XML::BEGIN@5 which was called: # once (585µs+719µs) by main::BEGIN@3 at line 5
use vars qw( $VERSION %_load_args );
# spent 1.30ms making 1 call to MARC::File::XML::BEGIN@5 # spent 82µs making 1 call to vars::import
63238µs24.44ms
# spent 3.01ms (1.49+1.53) within MARC::File::XML::BEGIN@6 which was called: # once (1.49ms+1.53ms) by main::BEGIN@3 at line 6
use base qw( MARC::File );
# spent 3.01ms making 1 call to MARC::File::XML::BEGIN@6 # spent 1.43ms making 1 call to base::import
73158µs29.48ms
# spent 9.44ms (2.91+6.54) within MARC::File::XML::BEGIN@7 which was called: # once (2.91ms+6.54ms) by main::BEGIN@3 at line 7
use MARC::Record;
# spent 9.44ms making 1 call to MARC::File::XML::BEGIN@7 # spent 41µs making 1 call to Exporter::import
8345µs19µs
# spent 9µs within MARC::File::XML::BEGIN@8 which was called: # once (9µs+0s) by main::BEGIN@3 at line 8
use MARC::Field;
# spent 9µs making 1 call to MARC::File::XML::BEGIN@8
9
103194µs273.7ms
# spent 73.7ms (2.36+71.3) within MARC::File::XML::BEGIN@10 which was called: # once (2.36ms+71.3ms) by main::BEGIN@3 at line 10
use MARC::Charset qw( marc8_to_utf8 utf8_to_marc8 );
# spent 73.7ms making 1 call to MARC::File::XML::BEGIN@10 # spent 87µs making 1 call to Exporter::import
11348µs2735µs
# spent 380µs (25+355) within MARC::File::XML::BEGIN@11 which was called: # once (25µs+355µs) by main::BEGIN@3 at line 11
use IO::File;
# spent 380µs making 1 call to MARC::File::XML::BEGIN@11 # spent 355µs making 1 call to Exporter::import
12336µs2124µs
# spent 68µs (12+56) within MARC::File::XML::BEGIN@12 which was called: # once (12µs+56µs) by main::BEGIN@3 at line 12
use Carp qw( croak );
# spent 68µs making 1 call to MARC::File::XML::BEGIN@12 # spent 56µs making 1 call to Exporter::import
1332.58ms18µs
# spent 8µs within MARC::File::XML::BEGIN@13 which was called: # once (8µs+0s) by main::BEGIN@3 at line 13
use Encode ();
# spent 8µs making 1 call to MARC::File::XML::BEGIN@13
14
1512µs$VERSION = '0.92';
16
17
# spent 13µs within MARC::File::XML::import which was called: # once (13µs+0s) by main::BEGIN@3 at line 3 of conv.pl
sub import {
18415µs my $class = shift;
19 %_load_args = @_;
20 $_load_args{ DefaultEncoding } ||= 'UTF-8';
21 $_load_args{ RecordFormat } ||= 'USMARC';
22}
23
24=head1 NAME
25
- -
96sub default_record_format {
97 my $self = shift;
98 my $format = shift;
99
100 $_load_args{RecordFormat} = $format if ($format);
101
102 return $_load_args{RecordFormat};
103}
104
105
106=head2 as_xml()
107
- -
116sub MARC::Record::as_xml {
117 my $record = shift;
118 my $format = shift || $_load_args{RecordFormat};
119 return( MARC::File::XML::encode( $record, $format ) );
120}
121
122=head2 as_xml_record([$format])
123
- -
132sub MARC::Record::as_xml_record {
133 my $record = shift;
134 my $format = shift || $_load_args{RecordFormat};
135 return( MARC::File::XML::encode( $record, $format, 1 ) );
136}
137
138=head2 new_from_xml([$encoding, $format])
139
- -
152sub MARC::Record::new_from_xml {
153 my $xml = shift;
154 ## to allow calling as MARC::Record::new_from_xml()
155 ## or MARC::Record->new_from_xml()
156 $xml = shift if ( ref($xml) || ($xml eq "MARC::Record") );
157
158 my $enc = shift || $_load_args{BinaryEncoding};
159 my $format = shift || $_load_args{RecordFormat};
160 return( MARC::File::XML::decode( $xml, $enc, $format ) );
161}
162
163=pod
164
- -
179sub out {
180 my ( $class, $filename, $enc ) = @_;
181 my $fh = IO::File->new( ">$filename" ) or croak( $! );
182 $enc ||= $_load_args{DefaultEncoding};
183
184 if ($enc =~ /^utf-?8$/oi) {
185 $fh->binmode(':utf8');
186 } else {
187 $fh->binmode(':raw');
188 }
189
190 my %self = (
191 filename => $filename,
192 fh => $fh,
193 header => 0,
194 encoding => $enc
195 );
196 return( bless \%self, ref( $class ) || $class );
197}
198
199=head2 write()
200
- -
209sub write {
210 my ( $self, $record, $enc ) = @_;
211 if ( ! $self->{ fh } ) {
212 croak( "MARC::File::XML object not open for writing" );
213 }
214 if ( ! $record ) {
215 croak( "must pass write() a MARC::Record object" );
216 }
217 ## print the XML header if we haven't already
218 if ( ! $self->{ header } ) {
219 $enc ||= $self->{ encoding } || $_load_args{DefaultEncoding};
220 $self->{ fh }->print( header( $enc ) );
221 $self->{ header } = 1;
222 }
223 ## print out the record
224 $self->{ fh }->print( record( $record ) ) || croak( $! );
225 return( 1 );
226}
227
228=head2 close()
229
- -
236
# spent 28µs within MARC::File::XML::close which was called: # once (28µs+0s) by MARC::File::XML::DESTROY at line 250
sub close {
237313µs my $self = shift;
238421µs if ( $self->{ fh } ) {
239 $self->{ fh }->print( footer() ) if $self->{ header };
240 $self->{ fh } = undef;
241 $self->{ filename } = undef;
242 $self->{ header } = undef;
243 }
244 return( 1 );
245}
246
247## makes sure that the XML file is closed off
248
249
# spent 51µs (23+28) within MARC::File::XML::DESTROY which was called: # once (23µs+28µs) by main::NULL at line 0 of conv.pl
sub DESTROY {
250119µs128µs shift->close();
# spent 28µs making 1 call to MARC::File::XML::close
251}
252
253=pod
254
- -
273sub header {
274 my $enc = shift;
275 $enc = shift if ( $enc && (ref($enc) || ($enc eq "MARC::File::XML")) );
276 $enc ||= 'UTF-8';
277 return( <<MARC_XML_HEADER );
278<?xml version="1.0" encoding="$enc"?>
279<collection
280 xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
281 xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
282 xmlns="http://www.loc.gov/MARC21/slim">
283MARC_XML_HEADER
284}
285
286=head2 footer()
287
- -
292sub footer {
293 return( "</collection>" );
294}
295
296=head2 record()
297
- -
302sub record {
303 my $record = shift;
304 my $format = shift;
305 my $include_full_record_header = shift;
306 my $enc = shift;
307
308 $format ||= $_load_args{RecordFormat};
309
310 my $_transcode = 0;
311 my $ldr = $record->leader;
312 my $original_encoding = substr($ldr,9,1);
313
314 # Does the record think it is already Unicode?
315 if ($original_encoding ne 'a' && lc($format) !~ /^unimarc/o) {
316 # If not, we'll make it so
317 $_transcode++;
318 substr($ldr,9,1,'a');
319 $record->leader( $ldr );
320 }
321
322 my @xml = ();
323
324 if ($include_full_record_header) {
325 push @xml, <<HEADER
326<?xml version="1.0" encoding="$enc"?>
327<record
328 xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
329 xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
330 xmlns="http://www.loc.gov/MARC21/slim">
331HEADER
332
333 } else {
334 push( @xml, "<record>" );
335 }
336
337 push( @xml, " <leader>" . escape( $record->leader ) . "</leader>" );
338
339 foreach my $field ( $record->fields() ) {
340 my ($tag) = escape( $field->tag() );
341 if ( $field->is_control_field() ) {
342 my $data = $field->data;
343 push( @xml, qq( <controlfield tag="$tag">) .
344 escape( ($_transcode ? marc8_to_utf8($data) : $data) ). qq(</controlfield>) );
345 } else {
346 my ($i1) = escape( $field->indicator( 1 ) );
347 my ($i2) = escape( $field->indicator( 2 ) );
348 push( @xml, qq( <datafield tag="$tag" ind1="$i1" ind2="$i2">) );
349 foreach my $subfield ( $field->subfields() ) {
350 my ( $code, $data ) = ( escape( $$subfield[0] ), $$subfield[1] );
351 push( @xml, qq( <subfield code="$code">).
352 escape( ($_transcode ? marc8_to_utf8($data) : $data) ).qq(</subfield>) );
353 }
354 push( @xml, " </datafield>" );
355 }
356 }
357 push( @xml, "</record>\n" );
358
359 if ($_transcode) {
360 substr($ldr,9,1,$original_encoding);
361 $record->leader( $ldr );
362 }
363
364 return( join( "\n", @xml ) );
365}
366
36714µsmy %ESCAPES = (
368 '&' => '&amp;',
369 '<' => '&lt;',
370 '>' => '&gt;',
371);
372my $ESCAPE_REGEX =
373 eval 'qr/' .
374455µs join( '|', map { $_ = "\Q$_\E" } keys %ESCAPES ) .
# spent 21µs executing statements in string eval
375 '/;'
376 ;
377
378sub escape {
379 my $string = shift;
380 return '' if ! defined $string or $string eq '';
381 $string =~ s/($ESCAPE_REGEX)/$ESCAPES{$1}/oge;
382 return( $string );
383}
384
385
# spent 371ms (181+190) within MARC::File::XML::_next which was called 5000 times, avg 74µs/call: # 5000 times (181ms+190ms) by MARC::File::next at line 104 of MARC/File.pm, avg 74µs/call
sub _next {
38640000377ms my $self = shift;
387 my $fh = $self->{ fh };
388
389 ## return undef at the end of the file
39050006.75ms return if eof($fh);
# spent 6.75ms making 5000 calls to MARC::File::XML::CORE:eof, avg 1µs/call
391
392 ## get a chunk of xml for a record
393 local $/ = '</record>';
394500057.6ms my $xml = <$fh>;
# spent 57.6ms making 5000 calls to MARC::File::XML::CORE:readline, avg 12µs/call
395
396 ## trim stuff before the start record element
3975000115ms $xml =~ s/.*<record.*?>/<record>/s;
# spent 115ms making 5000 calls to MARC::File::XML::CORE:subst, avg 23µs/call
398
399 ## return undef if there isn't a good chunk of xml
400500011.6ms return if ( $xml !~ m|<record>.*</record>|s );
# spent 11.6ms making 5000 calls to MARC::File::XML::CORE:match, avg 2µs/call
401
402 ## return the chunk of xml
403 return( $xml );
404}
405
406=head2 decode()
407
- -
415
# spent 9.89s (4.66+5.23) within MARC::File::XML::decode which was called 5000 times, avg 1.98ms/call: # 5000 times (4.66s+5.23s) by MARC::File::next at line 105 of MARC/File.pm, avg 1.98ms/call
sub decode {
41670000402ms my $self = shift;
417 my $text;
418 my $location = '';
419
4201000020.3ms500011.0ms if ( ref($self) =~ /^MARC::File/ ) {
# spent 11.0ms making 5000 calls to MARC::File::XML::CORE:match, avg 2µs/call
421 $location = 'in record '.$self->{recnum};
422 $text = shift;
423 } else {
424 $location = 'in record 1';
425 $text = $self=~/MARC::File/ ? shift : $self;
426 }
427
428 my $enc = shift || $_load_args{BinaryEncoding};
429 my $format = shift || $_load_args{RecordFormat};
430
431 my @parts = split />/, $text;
432 my ($tag, $code, $ind1, $ind2);
433500051.0ms my $rec = MARC::Record->new();
# spent 51.0ms making 5000 calls to MARC::Record::new, avg 10µs/call
434 my @fields;
435 my $transcode_to_marc8;
436 while ( @parts ) {
4374227051.97s $_ = shift @parts;
43889541128ms $_ = shift @parts if /<record/;
# spent 128ms making 89541 calls to MARC::File::XML::CORE:match, avg 1µs/call
43935000118ms8954196.9ms if ( /<leader/ ) {
# spent 96.9ms making 89541 calls to MARC::File::XML::CORE:match, avg 1µs/call
440 $_ = shift @parts;
441500013.8ms /(.*)<\/leader/;
# spent 13.8ms making 5000 calls to MARC::File::XML::CORE:match, avg 3µs/call
442 my $leader = $1;
443500085.2ms $transcode_to_marc8 = substr($leader, 9, 1) eq 'a' && decideMARC8Binary($format, $enc) ? 1 : 0;
# spent 85.2ms making 5000 calls to MARC::File::XML::decideMARC8Binary, avg 17µs/call
444 substr($leader, 9, 1) = ' ' if $transcode_to_marc8;
445500056.4ms $rec->leader($leader);
# spent 56.4ms making 5000 calls to MARC::Record::leader, avg 11µs/call
446 next;
447 }
448100000314ms84541130ms if ( /<controlfield\s*tag="(.*)"/ ) {
# spent 130ms making 84541 calls to MARC::File::XML::CORE:match, avg 2µs/call
449 my $tag = $1;
450 $_ = shift @parts;
4512000045.8ms s/<\/controlfield//;
# spent 45.8ms making 20000 calls to MARC::File::XML::CORE:subst, avg 2µs/call
45220000492ms push @fields, MARC::Field->new( $tag, $_ );
# spent 492ms making 20000 calls to MARC::Field::new, avg 25µs/call
453 next;
454 }
4553572461.22s64541222ms if ( /<datafield\s*tag="(.*?)"\s*ind1="(.*?)"\s*ind2="(.*)"/ ) {
# spent 222ms making 64541 calls to MARC::File::XML::CORE:match, avg 3µs/call
456 my ($tag, $ind1, $ind2) = ($1, $2, $3);
457 my @subf;
45859541177ms while ( @parts && $parts[0] =~ /<subfield.*code="(.*)"/ ) {
# spent 177ms making 59541 calls to MARC::File::XML::CORE:match, avg 3µs/call
4594787901.74s my $letter = $1;
460 shift @parts;
461 $_ = shift @parts;
46295758208ms s/<\/subfield//;
# spent 208ms making 95758 calls to MARC::File::XML::CORE:subst, avg 2µs/call
46395758164ms push @subf, $letter, $transcode_to_marc8 ? utf8_to_marc8($_) : $_;
# spent 164ms making 95758 calls to MARC::File::XML::CORE:match, avg 2µs/call
464 }
465595413.07s push @fields, MARC::Field->new(
# spent 3.07s making 59541 calls to MARC::Field::new, avg 52µs/call
466 $tag,
467 $ind1,
468 $ind2,
469 @subf );
470 shift @parts;
471 next;
472 }
473 last;
474 }
4755000279ms $rec->append_fields(@fields);
# spent 279ms making 5000 calls to MARC::Record::append_fields, avg 56µs/call
476 return $rec;
477
478}
479
480
# spent 85.2ms (68.4+16.8) within MARC::File::XML::decideMARC8Binary which was called 5000 times, avg 17µs/call: # 5000 times (68.4ms+16.8ms) by MARC::File::XML::decode at line 443, avg 17µs/call
sub decideMARC8Binary {
4812000087.3ms my $format = shift;
482 my $enc = shift;
483
48450005.17ms return 0 if (defined($format) && lc($format) =~ /^unimarc/o);
# spent 5.17ms making 5000 calls to MARC::File::XML::CORE:match, avg 1µs/call
485500011.6ms return 0 if (defined($enc) && lc($enc) =~ /^utf-?8/o);
# spent 11.6ms making 5000 calls to MARC::File::XML::CORE:match, avg 2µs/call
486 return 1;
487}
488
489
490=head2 encode()
491
- -
499sub encode {
500 my $record = shift;
501 my $format = shift || $_load_args{RecordFormat};
502 my $without_collection_header = shift;
503 my $enc = shift || $_load_args{DefaultEncoding};
504
505 if (lc($format) =~ /^unimarc/o) {
506 $enc = _unimarc_encoding( $format => $record );
507 }
508
509 my @xml = ();
510 push( @xml, header( $enc ) ) unless ($without_collection_header);
511 # verbose, but naming the header output flags this way to avoid
512 # the potential confusion identified in CPAN bug #34082
513 # http://rt.cpan.org/Public/Bug/Display.html?id=34082
514 my $include_full_record_header = ($without_collection_header) ? 1 : 0;
515 push( @xml, record( $record, $format, $include_full_record_header, $enc ) );
516 push( @xml, footer() ) unless ($without_collection_header);
517
518 return( join( "\n", @xml ) );
519}
520
521sub _unimarc_encoding {
522 my $f = shift;
523 my $r = shift;
524
525 my $pos = 26;
526 $pos = 13 if (lc($f) eq 'unimarcauth');
527
528 my $enc = substr( $r->subfield(100 => 'a'), $pos, 2 );
529
530 if ($enc eq '01' || $enc eq '03') {
531 return 'ISO-8859-1';
532 } elsif ($enc eq '50') {
533 return 'UTF-8';
534 } else {
535 die "Unsupported UNIMARC character encoding [$enc] for XML output for $f; 100\$a -> " . $r->subfield(100 => 'a');
536 }
537}
538
539=head1 TODO
540
- -
57319µs1;
 
# spent 6.75ms within MARC::File::XML::CORE:eof which was called 5000 times, avg 1µs/call: # 5000 times (6.75ms+0s) by MARC::File::XML::_next at line 390, avg 1µs/call
sub MARC::File::XML::CORE:eof; # opcode
# spent 972ms within MARC::File::XML::CORE:match which was called 508463 times, avg 2µs/call: # 95758 times (164ms+0s) by MARC::File::XML::decode at line 463, avg 2µs/call # 89541 times (128ms+0s) by MARC::File::XML::decode at line 438, avg 1µs/call # 89541 times (96.9ms+0s) by MARC::File::XML::decode at line 439, avg 1µs/call # 84541 times (130ms+0s) by MARC::File::XML::decode at line 448, avg 2µs/call # 64541 times (222ms+0s) by MARC::File::XML::decode at line 455, avg 3µs/call # 59541 times (177ms+0s) by MARC::File::XML::decode at line 458, avg 3µs/call # 5000 times (13.8ms+0s) by MARC::File::XML::decode at line 441, avg 3µs/call # 5000 times (11.6ms+0s) by MARC::File::XML::decideMARC8Binary at line 485, avg 2µs/call # 5000 times (11.6ms+0s) by MARC::File::XML::_next at line 400, avg 2µs/call # 5000 times (11.0ms+0s) by MARC::File::XML::decode at line 420, avg 2µs/call # 5000 times (5.17ms+0s) by MARC::File::XML::decideMARC8Binary at line 484, avg 1µs/call
sub MARC::File::XML::CORE:match; # opcode
# spent 8µs within MARC::File::XML::CORE:qr which was called: # once (8µs+0s) by main::BEGIN@3 at line 1 of (eval 8)[lib/MARC/File/XML.pm:374]
sub MARC::File::XML::CORE:qr; # opcode
# spent 57.6ms within MARC::File::XML::CORE:readline which was called 5000 times, avg 12µs/call: # 5000 times (57.6ms+0s) by MARC::File::XML::_next at line 394, avg 12µs/call
sub MARC::File::XML::CORE:readline; # opcode
# spent 369ms within MARC::File::XML::CORE:subst which was called 120758 times, avg 3µs/call: # 95758 times (208ms+0s) by MARC::File::XML::decode at line 462, avg 2µs/call # 20000 times (45.8ms+0s) by MARC::File::XML::decode at line 451, avg 2µs/call # 5000 times (115ms+0s) by MARC::File::XML::_next at line 397, avg 23µs/call
sub MARC::File::XML::CORE:subst; # opcode
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.