| Filename | /usr/share/perl5/MARC/Record.pm |
| Statements | Executed 28081 statements in 108ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 471 | 12 | 5 | 58.1ms | 96.5ms | MARC::Record::field |
| 1131 | 3 | 1 | 8.48ms | 10.8ms | MARC::Record::_all_parms_are_fields |
| 7840 | 2 | 1 | 8.31ms | 8.31ms | MARC::Record::CORE:regcomp (opcode) |
| 1081 | 5 | 3 | 7.92ms | 18.3ms | MARC::Record::append_fields |
| 7827 | 1 | 1 | 6.05ms | 6.05ms | MARC::Record::CORE:match (opcode) |
| 544 | 1 | 1 | 4.42ms | 6.70ms | MARC::Record::encoding |
| 596 | 6 | 5 | 3.56ms | 3.56ms | MARC::Record::fields |
| 694 | 7 | 5 | 3.44ms | 3.44ms | MARC::Record::leader |
| 25 | 1 | 1 | 2.92ms | 5.32ms | MARC::Record::insert_fields_ordered |
| 1 | 1 | 1 | 2.22ms | 2.44ms | MARC::Record::BEGIN@14 |
| 186 | 12 | 2 | 1.87ms | 28.1ms | MARC::Record::subfield |
| 75 | 3 | 3 | 1.28ms | 1.28ms | MARC::Record::new |
| 25 | 1 | 1 | 622µs | 842µs | MARC::Record::delete_fields |
| 25 | 1 | 1 | 171µs | 1.01ms | MARC::Record::delete_field |
| 13 | 1 | 1 | 58µs | 58µs | MARC::Record::CORE:qr (opcode) |
| 1 | 1 | 1 | 38µs | 45µs | MARC::Record::BEGIN@9 |
| 1 | 1 | 1 | 20µs | 46µs | MARC::Record::BEGIN@26 |
| 1 | 1 | 1 | 17µs | 63µs | MARC::Record::BEGIN@23 |
| 1 | 1 | 1 | 14µs | 18µs | MARC::Record::BEGIN@10 |
| 1 | 1 | 1 | 14µs | 62µs | MARC::Record::BEGIN@34 |
| 1 | 1 | 1 | 12µs | 56µs | MARC::Record::BEGIN@15 |
| 1 | 1 | 1 | 10µs | 34µs | MARC::Record::BEGIN@32 |
| 1 | 1 | 1 | 9µs | 60µs | MARC::Record::BEGIN@27 |
| 1 | 1 | 1 | 9µs | 34µs | MARC::Record::BEGIN@12 |
| 0 | 0 | 0 | 0s | 0s | MARC::Record::_gripe |
| 0 | 0 | 0 | 0s | 0s | MARC::Record::_warn |
| 0 | 0 | 0 | 0s | 0s | MARC::Record::add_fields |
| 0 | 0 | 0 | 0s | 0s | MARC::Record::as_formatted |
| 0 | 0 | 0 | 0s | 0s | MARC::Record::as_usmarc |
| 0 | 0 | 0 | 0s | 0s | MARC::Record::author |
| 0 | 0 | 0 | 0s | 0s | MARC::Record::clone |
| 0 | 0 | 0 | 0s | 0s | MARC::Record::edition |
| 0 | 0 | 0 | 0s | 0s | MARC::Record::insert_fields_after |
| 0 | 0 | 0 | 0s | 0s | MARC::Record::insert_fields_before |
| 0 | 0 | 0 | 0s | 0s | MARC::Record::insert_grouped_field |
| 0 | 0 | 0 | 0s | 0s | MARC::Record::new_from_usmarc |
| 0 | 0 | 0 | 0s | 0s | MARC::Record::publication_date |
| 0 | 0 | 0 | 0s | 0s | MARC::Record::set_leader_lengths |
| 0 | 0 | 0 | 0s | 0s | MARC::Record::title |
| 0 | 0 | 0 | 0s | 0s | MARC::Record::title_proper |
| 0 | 0 | 0 | 0s | 0s | MARC::Record::warnings |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package MARC::Record; | ||||
| 2 | |||||
| 3 | =head1 NAME | ||||
| 4 | |||||
| - - | |||||
| 9 | 3 | 41µs | 2 | 52µs | # spent 45µs (38+7) within MARC::Record::BEGIN@9 which was called:
# once (38µs+7µs) by C4::Biblio::BEGIN@27 at line 9 # spent 45µs making 1 call to MARC::Record::BEGIN@9
# spent 7µs making 1 call to strict::import |
| 10 | 3 | 31µs | 2 | 22µs | # spent 18µs (14+4) within MARC::Record::BEGIN@10 which was called:
# once (14µs+4µs) by C4::Biblio::BEGIN@27 at line 10 # spent 18µs making 1 call to MARC::Record::BEGIN@10
# spent 4µs making 1 call to integer::import |
| 11 | |||||
| 12 | 3 | 29µs | 2 | 59µs | # spent 34µs (9+25) within MARC::Record::BEGIN@12 which was called:
# once (9µs+25µs) by C4::Biblio::BEGIN@27 at line 12 # spent 34µs making 1 call to MARC::Record::BEGIN@12
# spent 25µs making 1 call to vars::import |
| 13 | |||||
| 14 | 3 | 136µs | 1 | 2.44ms | # spent 2.44ms (2.22+224µs) within MARC::Record::BEGIN@14 which was called:
# once (2.22ms+224µs) by C4::Biblio::BEGIN@27 at line 14 # spent 2.44ms making 1 call to MARC::Record::BEGIN@14 |
| 15 | 3 | 65µs | 2 | 101µs | # spent 56µs (12+45) within MARC::Record::BEGIN@15 which was called:
# once (12µs+45µs) by C4::Biblio::BEGIN@27 at line 15 # spent 56µs making 1 call to MARC::Record::BEGIN@15
# spent 45µs making 1 call to Exporter::import |
| 16 | |||||
| 17 | =head1 VERSION | ||||
| 18 | |||||
| - - | |||||
| 23 | 3 | 71µs | 2 | 109µs | # spent 63µs (17+46) within MARC::Record::BEGIN@23 which was called:
# once (17µs+46µs) by C4::Biblio::BEGIN@27 at line 23 # spent 63µs making 1 call to MARC::Record::BEGIN@23
# spent 46µs making 1 call to vars::import |
| 24 | 1 | 900ns | $VERSION = '2.0.2'; | ||
| 25 | |||||
| 26 | 3 | 39µs | 2 | 71µs | # spent 46µs (20+25) within MARC::Record::BEGIN@26 which was called:
# once (20µs+25µs) by C4::Biblio::BEGIN@27 at line 26 # spent 46µs making 1 call to MARC::Record::BEGIN@26
# spent 25µs making 1 call to Exporter::import |
| 27 | 3 | 51µs | 2 | 112µs | # spent 60µs (9+51) within MARC::Record::BEGIN@27 which was called:
# once (9µs+51µs) by C4::Biblio::BEGIN@27 at line 27 # spent 60µs making 1 call to MARC::Record::BEGIN@27
# spent 52µs making 1 call to vars::import |
| 28 | 1 | 11µs | @ISA = qw( Exporter ); | ||
| 29 | 1 | 400ns | @EXPORTS = qw(); | ||
| 30 | 1 | 600ns | @EXPORT_OK = qw( LEADER_LEN ); | ||
| 31 | |||||
| 32 | 4 | 36µs | 2 | 58µs | # spent 34µs (10+24) within MARC::Record::BEGIN@32 which was called:
# once (10µs+24µs) by C4::Biblio::BEGIN@27 at line 32 # spent 34µs making 1 call to MARC::Record::BEGIN@32
# spent 24µs making 1 call to vars::import |
| 33 | |||||
| 34 | 3 | 2.19ms | 2 | 110µs | # spent 62µs (14+48) within MARC::Record::BEGIN@34 which was called:
# once (14µs+48µs) by C4::Biblio::BEGIN@27 at line 34 # spent 62µs making 1 call to MARC::Record::BEGIN@34
# spent 48µs making 1 call to constant::import |
| 35 | |||||
| 36 | =head1 DESCRIPTION | ||||
| 37 | |||||
| - - | |||||
| 56 | # spent 1.28ms within MARC::Record::new which was called 75 times, avg 17µs/call:
# 25 times (569µs+0s) by MARC::File::USMARC::decode at line 119 of MARC/File/USMARC.pm, avg 23µs/call
# 25 times (449µs+0s) by C4::Biblio::GetMarcBiblio at line 1260 of /usr/share/koha/lib/C4/Biblio.pm, avg 18µs/call
# 25 times (263µs+0s) by MARC::File::SAX::start_element at line 51 of MARC/File/SAX.pm, avg 11µs/call | ||||
| 57 | 75 | 119µs | my $class = shift; | ||
| 58 | 75 | 542µs | my $self = { | ||
| 59 | _leader => ' ' x 24, | ||||
| 60 | _fields => [], | ||||
| 61 | _warnings => [], | ||||
| 62 | }; | ||||
| 63 | 75 | 704µs | return bless $self, $class; | ||
| 64 | } # new() | ||||
| 65 | |||||
| 66 | =head2 new_from_usmarc( $marcblob [, \&filter_func($tagno,$tagdata)] ) | ||||
| 67 | |||||
| - - | |||||
| 75 | sub new_from_usmarc { | ||||
| 76 | my $blob = shift; | ||||
| 77 | $blob = shift if (ref($blob) || ($blob eq "MARC::Record")); | ||||
| 78 | |||||
| 79 | require MARC::File::USMARC; | ||||
| 80 | |||||
| 81 | return MARC::File::USMARC::decode( $blob, @_ ); | ||||
| 82 | } | ||||
| 83 | |||||
| 84 | =head1 COMMON FIELD RETRIEVAL METHODS | ||||
| 85 | |||||
| - - | |||||
| 104 | sub title() { | ||||
| 105 | my $self = shift; | ||||
| 106 | |||||
| 107 | my $field = $self->field(245); | ||||
| 108 | return $field ? $field->as_string : ""; | ||||
| 109 | } | ||||
| 110 | |||||
| 111 | =head2 title_proper() | ||||
| 112 | |||||
| - - | |||||
| 117 | sub title_proper() { | ||||
| 118 | my $self = shift; | ||||
| 119 | |||||
| 120 | my $field = $self->field(245); | ||||
| 121 | |||||
| 122 | if ( $field ) { | ||||
| 123 | return $field->as_string('anp'); | ||||
| 124 | } else { | ||||
| 125 | return ""; | ||||
| 126 | } | ||||
| 127 | } | ||||
| 128 | |||||
| 129 | =head2 author() | ||||
| 130 | |||||
| - - | |||||
| 135 | sub author() { | ||||
| 136 | my $self = shift; | ||||
| 137 | |||||
| 138 | my $field = $self->field('100|110|111'); | ||||
| 139 | return $field ? $field->as_string : ""; | ||||
| 140 | } | ||||
| 141 | |||||
| 142 | =head2 edition() | ||||
| 143 | |||||
| - - | |||||
| 148 | sub edition() { | ||||
| 149 | my $self = shift; | ||||
| 150 | |||||
| 151 | my $str = $self->subfield(250,'a'); | ||||
| 152 | return defined $str ? $str : ""; | ||||
| 153 | } | ||||
| 154 | |||||
| 155 | =head2 publication_date() | ||||
| 156 | |||||
| - - | |||||
| 161 | sub publication_date() { | ||||
| 162 | my $self = shift; | ||||
| 163 | |||||
| 164 | my $str = $self->subfield(260,'c'); | ||||
| 165 | return defined $str ? $str : ""; | ||||
| 166 | } | ||||
| 167 | |||||
| 168 | =head1 FIELD & SUBFIELD ACCESS METHODS | ||||
| 169 | |||||
| - - | |||||
| 177 | # spent 3.56ms within MARC::Record::fields which was called 596 times, avg 6µs/call:
# 471 times (2.19ms+0s) by MARC::Record::field at line 209, avg 5µs/call
# 25 times (509µs+0s) by C4::XSLT::transformMARCXML4XSLT at line 82 of /usr/share/koha/lib/C4/XSLT.pm, avg 20µs/call
# 25 times (285µs+0s) by MARC::File::XML::record at line 344 of MARC/File/XML.pm, avg 11µs/call
# 25 times (244µs+0s) by C4::Biblio::TransformMarcToKoha at line 2510 of /usr/share/koha/lib/C4/Biblio.pm, avg 10µs/call
# 25 times (166µs+0s) by C4::Charset::SetUTF8Flag at line 136 of /usr/share/koha/lib/C4/Charset.pm, avg 7µs/call
# 25 times (165µs+0s) by C4::Charset::SetUTF8Flag at line 135 of /usr/share/koha/lib/C4/Charset.pm, avg 7µs/call | ||||
| 178 | 596 | 386µs | my $self = shift; | ||
| 179 | 596 | 4.12ms | return @{$self->{_fields}}; | ||
| 180 | } | ||||
| 181 | |||||
| 182 | =head2 field( I<tagspec(s)> ) | ||||
| 183 | |||||
| - - | |||||
| 193 | 1 | 300ns | my %field_regex; | ||
| 194 | |||||
| 195 | # spent 96.5ms (58.1+38.4) within MARC::Record::field which was called 471 times, avg 205µs/call:
# 186 times (14.1ms+9.48ms) by MARC::Record::subfield at line 238, avg 127µs/call
# 50 times (10.4ms+6.88ms) by C4::XSLT::transformMARCXML4XSLT at line 87 of /usr/share/koha/lib/C4/XSLT.pm, avg 346µs/call
# 34 times (3.22ms+2.11ms) by C4::Biblio::GetCOinSBiblio at line 1402 of /usr/share/koha/lib/C4/Biblio.pm, avg 157µs/call
# 25 times (4.52ms+3.65ms) by C4::Koha::GetNormalizedUPC at line 1309 of /usr/share/koha/lib/C4/Koha.pm, avg 327µs/call
# 25 times (3.92ms+2.55ms) by C4::Koha::GetNormalizedOCLCNumber at line 1389 of /usr/share/koha/lib/C4/Koha.pm, avg 259µs/call
# 25 times (4.06ms+2.40ms) by C4::Koha::GetNormalizedISBN at line 1345 of /usr/share/koha/lib/C4/Koha.pm, avg 259µs/call
# 25 times (3.80ms+2.66ms) by C4::Biblio::_koha_marc_update_bib_ids at line 2861 of /usr/share/koha/lib/C4/Biblio.pm, avg 258µs/call
# 25 times (4.00ms+2.30ms) by C4::Koha::GetNormalizedEAN at line 1371 of /usr/share/koha/lib/C4/Koha.pm, avg 252µs/call
# 25 times (3.88ms+2.37ms) by C4::Search::searchResults at line 1777 of /usr/share/koha/lib/C4/Search.pm, avg 250µs/call
# 25 times (3.79ms+2.35ms) by C4::Search::searchResults at line 1786 of /usr/share/koha/lib/C4/Search.pm, avg 246µs/call
# 25 times (2.17ms+1.50ms) by C4::Biblio::GetCOinSBiblio at line 1397 of /usr/share/koha/lib/C4/Biblio.pm, avg 147µs/call
# once (158µs+184µs) by C4::Biblio::GetCOinSBiblio at line 1411 of /usr/share/koha/lib/C4/Biblio.pm | ||||
| 196 | 471 | 346µs | my $self = shift; | ||
| 197 | 471 | 574µs | my @specs = @_; | ||
| 198 | |||||
| 199 | 471 | 201µs | my @list = (); | ||
| 200 | 471 | 535µs | for my $tag ( @specs ) { | ||
| 201 | 471 | 513µs | my $regex = $field_regex{ $tag }; | ||
| 202 | |||||
| 203 | # Compile & stash it if necessary | ||||
| 204 | 471 | 271µs | if ( not defined $regex ) { | ||
| 205 | 13 | 305µs | 26 | 220µs | $regex = qr/^$tag$/; # spent 162µs making 13 calls to MARC::Record::CORE:regcomp, avg 12µs/call
# spent 58µs making 13 calls to MARC::Record::CORE:qr, avg 4µs/call |
| 206 | 13 | 25µs | $field_regex{ $tag } = $regex; | ||
| 207 | } # not defined | ||||
| 208 | |||||
| 209 | 471 | 1.91ms | 471 | 2.19ms | for my $maybe ( $self->fields ) { # spent 2.19ms making 471 calls to MARC::Record::fields, avg 5µs/call |
| 210 | 7827 | 60.1ms | 23481 | 36.0ms | if ( $maybe->tag =~ $regex ) { # spent 21.8ms making 7827 calls to MARC::Field::tag, avg 3µs/call
# spent 8.15ms making 7827 calls to MARC::Record::CORE:regcomp, avg 1µs/call
# spent 6.05ms making 7827 calls to MARC::Record::CORE:match, avg 773ns/call |
| 211 | 342 | 858µs | return $maybe unless wantarray; | ||
| 212 | |||||
| 213 | 143 | 173µs | push( @list, $maybe ); | ||
| 214 | } # if | ||||
| 215 | } # for $maybe | ||||
| 216 | } # for $tag | ||||
| 217 | |||||
| 218 | 272 | 313µs | return unless wantarray; | ||
| 219 | 200 | 846µs | return @list; | ||
| 220 | } | ||||
| 221 | |||||
| 222 | =head2 subfield( $tag, $subfield ) | ||||
| 223 | |||||
| - - | |||||
| 233 | # spent 28.1ms (1.87+26.2) within MARC::Record::subfield which was called 186 times, avg 151µs/call:
# 25 times (458µs+7.37ms) by C4::Search::searchResults at line 1702 of /usr/share/koha/lib/C4/Search.pm, avg 313µs/call
# 25 times (299µs+2.05ms) by C4::Biblio::GetCOinSBiblio at line 1407 of /usr/share/koha/lib/C4/Biblio.pm, avg 94µs/call
# 25 times (220µs+1.93ms) by C4::Biblio::GetCOinSBiblio at line 1408 of /usr/share/koha/lib/C4/Biblio.pm, avg 86µs/call
# 24 times (123µs+4.92ms) by C4::Biblio::GetCOinSBiblio at line 1429 of /usr/share/koha/lib/C4/Biblio.pm, avg 210µs/call
# 24 times (170µs+4.25ms) by C4::Biblio::GetCOinSBiblio at line 1430 of /usr/share/koha/lib/C4/Biblio.pm, avg 184µs/call
# 24 times (208µs+2.08ms) by C4::Biblio::GetCOinSBiblio at line 1427 of /usr/share/koha/lib/C4/Biblio.pm, avg 96µs/call
# 24 times (198µs+1.98ms) by C4::Biblio::GetCOinSBiblio at line 1428 of /usr/share/koha/lib/C4/Biblio.pm, avg 91µs/call
# 11 times (160µs+906µs) by C4::Biblio::GetCOinSBiblio at line 1397 of /usr/share/koha/lib/C4/Biblio.pm, avg 97µs/call
# once (9µs+196µs) by C4::Biblio::GetCOinSBiblio at line 1413 of /usr/share/koha/lib/C4/Biblio.pm
# once (8µs+184µs) by C4::Biblio::GetCOinSBiblio at line 1414 of /usr/share/koha/lib/C4/Biblio.pm
# once (7µs+183µs) by C4::Biblio::GetCOinSBiblio at line 1415 of /usr/share/koha/lib/C4/Biblio.pm
# once (7µs+183µs) by C4::Biblio::GetCOinSBiblio at line 1420 of /usr/share/koha/lib/C4/Biblio.pm | ||||
| 234 | 186 | 99µs | my $self = shift; | ||
| 235 | 186 | 91µs | my $tag = shift; | ||
| 236 | 186 | 88µs | my $subfield = shift; | ||
| 237 | |||||
| 238 | 186 | 654µs | 186 | 23.6ms | my $field = $self->field($tag) or return; # spent 23.6ms making 186 calls to MARC::Record::field, avg 127µs/call |
| 239 | 145 | 877µs | 145 | 2.62ms | return $field->subfield($subfield); # spent 2.62ms making 145 calls to MARC::Field::subfield, avg 18µs/call |
| 240 | } # subfield() | ||||
| 241 | |||||
| 242 | =for internal | ||||
| 243 | |||||
| - - | |||||
| 246 | # spent 10.8ms (8.48+2.31) within MARC::Record::_all_parms_are_fields which was called 1131 times, avg 10µs/call:
# 1081 times (8.16ms+2.24ms) by MARC::Record::append_fields at line 268, avg 10µs/call
# 25 times (173µs+47µs) by MARC::Record::delete_fields at line 438, avg 9µs/call
# 25 times (139µs+30µs) by MARC::Record::insert_fields_ordered at line 358, avg 7µs/call | ||||
| 247 | 1131 | 1.69ms | for ( @_ ) { | ||
| 248 | 1131 | 7.01ms | 1131 | 2.31ms | return 0 unless UNIVERSAL::isa($_, 'MARC::Field'); # spent 2.31ms making 1131 calls to UNIVERSAL::isa, avg 2µs/call |
| 249 | } | ||||
| 250 | 1131 | 2.89ms | return 1; | ||
| 251 | } | ||||
| 252 | |||||
| 253 | =head2 append_fields( @fields ) | ||||
| 254 | |||||
| - - | |||||
| 265 | # spent 18.3ms (7.92+10.4) within MARC::Record::append_fields which was called 1081 times, avg 17µs/call:
# 512 times (3.64ms+4.97ms) by MARC::File::USMARC::decode at line 226 of MARC/File/USMARC.pm, avg 17µs/call
# 480 times (3.31ms+4.37ms) by MARC::File::SAX::end_element at line 92 of MARC/File/SAX.pm, avg 16µs/call
# 32 times (505µs+485µs) by MARC::File::USMARC::decode at line 192 of MARC/File/USMARC.pm, avg 31µs/call
# 32 times (310µs+373µs) by MARC::File::SAX::end_element at line 83 of MARC/File/SAX.pm, avg 21µs/call
# 25 times (148µs+205µs) by MARC::Record::insert_fields_ordered at line 374, avg 14µs/call | ||||
| 266 | 1081 | 564µs | my $self = shift; | ||
| 267 | |||||
| 268 | 1081 | 2.44ms | 1081 | 10.4ms | _all_parms_are_fields(@_) or croak('Arguments must be MARC::Field objects'); # spent 10.4ms making 1081 calls to MARC::Record::_all_parms_are_fields, avg 10µs/call |
| 269 | |||||
| 270 | 1081 | 2.01ms | push(@{ $self->{_fields} }, @_); | ||
| 271 | 1081 | 2.91ms | return scalar @_; | ||
| 272 | } | ||||
| 273 | |||||
| 274 | =head2 insert_fields_before( $before_field, @new_fields ) | ||||
| 275 | |||||
| - - | |||||
| 287 | sub insert_fields_before { | ||||
| 288 | my $self = shift; | ||||
| 289 | |||||
| 290 | _all_parms_are_fields(@_) | ||||
| 291 | or croak('All arguments must be MARC::Field objects'); | ||||
| 292 | |||||
| 293 | my ($before,@new) = @_; | ||||
| 294 | |||||
| 295 | ## find position of $before | ||||
| 296 | my $fields = $self->{_fields}; | ||||
| 297 | my $pos = 0; | ||||
| 298 | foreach my $f (@$fields) { | ||||
| 299 | last if ($f == $before); | ||||
| 300 | $pos++; | ||||
| 301 | } | ||||
| 302 | |||||
| 303 | ## insert before $before | ||||
| 304 | if ($pos >= @$fields) { | ||||
| 305 | $self->_warn("Couldn't find field to insert before"); | ||||
| 306 | return; | ||||
| 307 | } | ||||
| 308 | splice(@$fields,$pos,0,@new); | ||||
| 309 | return scalar @new; | ||||
| 310 | |||||
| 311 | } | ||||
| 312 | |||||
| 313 | =head2 insert_fields_after( $after_field, @new_fields ) | ||||
| 314 | |||||
| - - | |||||
| 321 | sub insert_fields_after { | ||||
| 322 | my $self = shift; | ||||
| 323 | |||||
| 324 | _all_parms_are_fields(@_) or croak('All arguments must be MARC::Field objects'); | ||||
| 325 | my ($after,@new) = @_; | ||||
| 326 | |||||
| 327 | ## find position of $after | ||||
| 328 | my $fields = $self->{_fields}; | ||||
| 329 | my $pos = 0; | ||||
| 330 | my $found = 0; | ||||
| 331 | foreach my $f (@$fields) { | ||||
| 332 | if ($f == $after) { | ||||
| 333 | $found = 1; | ||||
| 334 | last; | ||||
| 335 | } | ||||
| 336 | $pos++; | ||||
| 337 | } | ||||
| 338 | |||||
| 339 | ## insert after $after | ||||
| 340 | unless ($found) { | ||||
| 341 | $self->_warn("Couldn't find field to insert after"); | ||||
| 342 | return; | ||||
| 343 | } | ||||
| 344 | splice(@$fields,$pos+1,0,@new); | ||||
| 345 | return scalar @new; | ||||
| 346 | } | ||||
| 347 | |||||
| 348 | =head2 insert_fields_ordered( @new_fields ) | ||||
| 349 | |||||
| - - | |||||
| 355 | # spent 5.32ms (2.92+2.40) within MARC::Record::insert_fields_ordered which was called 25 times, avg 213µs/call:
# 25 times (2.92ms+2.40ms) by C4::Biblio::_koha_marc_update_bib_ids at line 2863 of /usr/share/koha/lib/C4/Biblio.pm, avg 213µs/call | ||||
| 356 | 25 | 52µs | my ( $self, @new ) = @_; | ||
| 357 | |||||
| 358 | 25 | 57µs | 25 | 170µs | _all_parms_are_fields(@new) # spent 170µs making 25 calls to MARC::Record::_all_parms_are_fields, avg 7µs/call |
| 359 | or croak('All arguments must be MARC::Field objects'); | ||||
| 360 | |||||
| 361 | ## go through each new field | ||||
| 362 | 25 | 39µs | NEW_FIELD: foreach my $newField ( @new ) { | ||
| 363 | |||||
| 364 | ## find location before which it should be inserted | ||||
| 365 | 25 | 51µs | EXISTING_FIELD: foreach my $field ( @{ $self->{_fields} } ) { | ||
| 366 | 487 | 1.75ms | 974 | 1.88ms | if ( $field->tag() >= $newField->tag() ) { # spent 1.88ms making 974 calls to MARC::Field::tag, avg 2µs/call |
| 367 | $self->insert_fields_before( $field, $newField ); | ||||
| 368 | next NEW_FIELD; | ||||
| 369 | } | ||||
| 370 | } | ||||
| 371 | |||||
| 372 | ## if we fell through then this new field is higher than | ||||
| 373 | ## all the existing fields, so we append. | ||||
| 374 | 25 | 82µs | 25 | 353µs | $self->append_fields( $newField ); # spent 353µs making 25 calls to MARC::Record::append_fields, avg 14µs/call |
| 375 | |||||
| 376 | } | ||||
| 377 | 25 | 104µs | return( scalar( @new ) ); | ||
| 378 | } | ||||
| 379 | |||||
| 380 | =head2 insert_grouped_field( $field ) | ||||
| 381 | |||||
| - - | |||||
| 398 | sub insert_grouped_field { | ||||
| 399 | my ($self,$new) = @_; | ||||
| 400 | _all_parms_are_fields($new) or croak('Argument must be MARC::Field object'); | ||||
| 401 | |||||
| 402 | ## try to find the end of the field group and insert it there | ||||
| 403 | my $limit = int($new->tag() / 100); | ||||
| 404 | my $found = 0; | ||||
| 405 | foreach my $field ($self->fields()) { | ||||
| 406 | if ( int($field->tag() / 100) > $limit ) { | ||||
| 407 | $self->insert_fields_before($field,$new); | ||||
| 408 | $found = 1; | ||||
| 409 | last; | ||||
| 410 | } | ||||
| 411 | } | ||||
| 412 | |||||
| 413 | ## if we couldn't find the end of the group, then we must not have | ||||
| 414 | ## any tags this high yet, so just append it | ||||
| 415 | if (!$found) { | ||||
| 416 | $self->append_fields($new); | ||||
| 417 | } | ||||
| 418 | |||||
| 419 | return(1); | ||||
| 420 | |||||
| 421 | } | ||||
| 422 | |||||
| 423 | |||||
| 424 | =head2 delete_fields( $field ) | ||||
| 425 | |||||
| - - | |||||
| 436 | # spent 842µs (622+220) within MARC::Record::delete_fields which was called 25 times, avg 34µs/call:
# 25 times (622µs+220µs) by MARC::Record::delete_field at line 458, avg 34µs/call | ||||
| 437 | 25 | 19µs | my $self = shift; | ||
| 438 | 25 | 57µs | 25 | 220µs | _all_parms_are_fields(@_) or croak('Arguments must be MARC::Field object'); # spent 220µs making 25 calls to MARC::Record::_all_parms_are_fields, avg 9µs/call |
| 439 | 25 | 89µs | my @fields = @{$self->{_fields}}; | ||
| 440 | 25 | 20µs | my $original_count = @fields; | ||
| 441 | |||||
| 442 | 25 | 44µs | foreach my $deleter (@_) { | ||
| 443 | 25 | 196µs | @fields = grep { $_ != $deleter } @fields; | ||
| 444 | } | ||||
| 445 | 25 | 56µs | $self->{_fields} = \@fields; | ||
| 446 | |||||
| 447 | 25 | 120µs | return $original_count - @fields; | ||
| 448 | } | ||||
| 449 | |||||
| 450 | =head2 delete_field() | ||||
| 451 | |||||
| - - | |||||
| 457 | # spent 1.01ms (171µs+842µs) within MARC::Record::delete_field which was called 25 times, avg 41µs/call:
# 25 times (171µs+842µs) by C4::Biblio::_koha_marc_update_bib_ids at line 2862 of /usr/share/koha/lib/C4/Biblio.pm, avg 41µs/call | ||||
| 458 | 25 | 171µs | 25 | 842µs | return delete_fields(@_); # spent 842µs making 25 calls to MARC::Record::delete_fields, avg 34µs/call |
| 459 | } | ||||
| 460 | |||||
| 461 | =head2 as_usmarc() | ||||
| 462 | |||||
| - - | |||||
| 468 | sub as_usmarc() { | ||||
| 469 | my $self = shift; | ||||
| 470 | |||||
| 471 | require MARC::File::USMARC; | ||||
| 472 | |||||
| 473 | return MARC::File::USMARC::encode( $self ); | ||||
| 474 | } | ||||
| 475 | |||||
| 476 | =head2 as_formatted() | ||||
| 477 | |||||
| - - | |||||
| 482 | sub as_formatted() { | ||||
| 483 | my $self = shift; | ||||
| 484 | |||||
| 485 | my @lines = ( "LDR " . ($self->{_leader} || "") ); | ||||
| 486 | for my $field ( @{$self->{_fields}} ) { | ||||
| 487 | push( @lines, $field->as_formatted() ); | ||||
| 488 | } | ||||
| 489 | |||||
| 490 | return join( "\n", @lines ); | ||||
| 491 | } # as_formatted | ||||
| 492 | |||||
| 493 | |||||
| 494 | =head2 leader() | ||||
| 495 | |||||
| - - | |||||
| 501 | # spent 3.44ms within MARC::Record::leader which was called 694 times, avg 5µs/call:
# 544 times (2.28ms+0s) by MARC::Record::encoding at line 538, avg 4µs/call
# 25 times (370µs+0s) by MARC::File::USMARC::decode at line 133 of MARC/File/USMARC.pm, avg 15µs/call
# 25 times (272µs+0s) by MARC::File::SAX::end_element at line 108 of MARC/File/SAX.pm, avg 11µs/call
# 25 times (208µs+0s) by MARC::File::XML::record at line 316 of MARC/File/XML.pm, avg 8µs/call
# 25 times (128µs+0s) by C4::Biblio::GetCOinSBiblio at line 1309 of /usr/share/koha/lib/C4/Biblio.pm, avg 5µs/call
# 25 times (114µs+0s) by MARC::File::XML::record at line 342 of MARC/File/XML.pm, avg 5µs/call
# 25 times (67µs+0s) by C4::Biblio::GetCOinSBiblio at line 1310 of /usr/share/koha/lib/C4/Biblio.pm, avg 3µs/call | ||||
| 502 | 694 | 465µs | my $self = shift; | ||
| 503 | 694 | 381µs | my $text = shift; | ||
| 504 | |||||
| 505 | 694 | 313µs | if ( defined $text ) { | ||
| 506 | 50 | 109µs | (length($text) eq 24) | ||
| 507 | or $self->_warn( "Leader must be 24 bytes long" ); | ||||
| 508 | 50 | 107µs | $self->{_leader} = $text; | ||
| 509 | } # set the leader | ||||
| 510 | |||||
| 511 | 694 | 3.18ms | return $self->{_leader}; | ||
| 512 | } # leader() | ||||
| 513 | |||||
| 514 | =head2 encoding() | ||||
| 515 | |||||
| - - | |||||
| 535 | # spent 6.70ms (4.42+2.28) within MARC::Record::encoding which was called 544 times, avg 12µs/call:
# 544 times (4.42ms+2.28ms) by MARC::File::USMARC::decode at line 171 of MARC/File/USMARC.pm, avg 12µs/call | ||||
| 536 | 544 | 478µs | my ($self,$arg) = @_; | ||
| 537 | # we basically report from and modify the leader directly | ||||
| 538 | 544 | 1.26ms | 544 | 2.28ms | my $leader = $self->leader(); # spent 2.28ms making 544 calls to MARC::Record::leader, avg 4µs/call |
| 539 | |||||
| 540 | # when setting | ||||
| 541 | 544 | 188µs | if ( defined($arg) ) { | ||
| 542 | if ( $arg =~ /UTF-?8/i ) { | ||||
| 543 | substr($leader,9,1) = 'a'; | ||||
| 544 | } | ||||
| 545 | elsif ( $arg =~ /MARC-?8/i ) { | ||||
| 546 | substr($leader,9,1) = ' '; | ||||
| 547 | } | ||||
| 548 | $self->leader($leader); | ||||
| 549 | } | ||||
| 550 | |||||
| 551 | 544 | 2.05ms | return substr($leader,9,1) eq 'a' ? 'UTF-8' : 'MARC-8'; | ||
| 552 | } | ||||
| 553 | |||||
| 554 | =head2 set_leader_lengths( $reclen, $baseaddr ) | ||||
| 555 | |||||
| - - | |||||
| 560 | sub set_leader_lengths { | ||||
| 561 | my $self = shift; | ||||
| 562 | my $reclen = shift; | ||||
| 563 | my $baseaddr = shift; | ||||
| 564 | if ($reclen > 99999) { | ||||
| 565 | carp( "Record length of $reclen is larger than the MARC spec allows (99999 bytes)." ); | ||||
| 566 | } | ||||
| 567 | substr($self->{_leader},0,5) = sprintf("%05d",$reclen); | ||||
| 568 | substr($self->{_leader},12,5) = sprintf("%05d",$baseaddr); | ||||
| 569 | # MARC21 defaults: http://www.loc.gov/marc/bibliographic/ecbdldrd.html | ||||
| 570 | substr($self->{_leader},10,2) = '22'; | ||||
| 571 | substr($self->{_leader},20,4) = '4500'; | ||||
| 572 | } | ||||
| 573 | |||||
| 574 | =head2 clone() | ||||
| 575 | |||||
| - - | |||||
| 596 | sub clone { | ||||
| 597 | my $self = shift; | ||||
| 598 | my @keeper_tags = @_; | ||||
| 599 | |||||
| 600 | # create a new object of whatever type we happen to be | ||||
| 601 | my $class = ref( $self ); | ||||
| 602 | my $clone = $class->new(); | ||||
| 603 | |||||
| 604 | $clone->{_leader} = $self->{_leader}; | ||||
| 605 | |||||
| 606 | my $filtered = @keeper_tags ? [$self->field( @keeper_tags )] : undef; | ||||
| 607 | |||||
| 608 | for my $field ( $self->fields() ) { | ||||
| 609 | if ( !$filtered || (grep {$field eq $_} @$filtered ) ) { | ||||
| 610 | $clone->append_fields( $field->clone ); | ||||
| 611 | } | ||||
| 612 | } | ||||
| 613 | |||||
| 614 | # XXX FIX THIS $clone->update_leader(); | ||||
| 615 | |||||
| 616 | return $clone; | ||||
| 617 | } | ||||
| 618 | |||||
| 619 | =head2 warnings() | ||||
| 620 | |||||
| - - | |||||
| 635 | sub warnings() { | ||||
| 636 | my $self = shift; | ||||
| 637 | my @warnings = @{$self->{_warnings}}; | ||||
| 638 | $self->{_warnings} = []; | ||||
| 639 | return @warnings; | ||||
| 640 | } | ||||
| 641 | |||||
| 642 | =head2 add_fields() | ||||
| 643 | |||||
| - - | |||||
| 682 | sub add_fields { | ||||
| 683 | my $self = shift; | ||||
| 684 | |||||
| 685 | my $nfields = 0; | ||||
| 686 | my $fields = $self->{_fields}; | ||||
| 687 | |||||
| 688 | while ( my $parm = shift ) { | ||||
| 689 | # User handed us a list of data (most common possibility) | ||||
| 690 | if ( ref($parm) eq "" ) { | ||||
| 691 | my $field = MARC::Field->new( $parm, @_ ) | ||||
| 692 | or return _gripe( $MARC::Field::ERROR ); | ||||
| 693 | push( @$fields, $field ); | ||||
| 694 | ++$nfields; | ||||
| 695 | last; # Bail out, we're done eating parms | ||||
| 696 | |||||
| 697 | # User handed us an object. | ||||
| 698 | } elsif ( UNIVERSAL::isa($parm, 'MARC::Field') ) { | ||||
| 699 | push( @$fields, $parm ); | ||||
| 700 | ++$nfields; | ||||
| 701 | |||||
| 702 | # User handed us an anonymous list of parms | ||||
| 703 | } elsif ( ref($parm) eq "ARRAY" ) { | ||||
| 704 | my $field = MARC::Field->new(@$parm) | ||||
| 705 | or return _gripe( $MARC::Field::ERROR ); | ||||
| 706 | push( @$fields, $field ); | ||||
| 707 | ++$nfields; | ||||
| 708 | |||||
| 709 | } else { | ||||
| 710 | croak( "Unknown parm of type", ref($parm), " passed to add_fields()" ); | ||||
| 711 | } # if | ||||
| 712 | |||||
| 713 | } # while | ||||
| 714 | |||||
| 715 | return $nfields; | ||||
| 716 | } | ||||
| 717 | |||||
| 718 | # NOTE: _warn is an object method | ||||
| 719 | sub _warn { | ||||
| 720 | my $self = shift; | ||||
| 721 | push( @{$self->{_warnings}}, join( "", @_ ) ); | ||||
| 722 | return( $self ); | ||||
| 723 | } | ||||
| 724 | |||||
| 725 | |||||
| 726 | # NOTE: _gripe is NOT an object method | ||||
| 727 | sub _gripe { | ||||
| 728 | $ERROR = join( "", @_ ); | ||||
| 729 | |||||
| 730 | warn $ERROR; | ||||
| 731 | |||||
| 732 | return; | ||||
| 733 | } | ||||
| 734 | |||||
| 735 | |||||
| 736 | 1 | 6µs | 1; | ||
| 737 | |||||
| 738 | __END__ | ||||
# spent 6.05ms within MARC::Record::CORE:match which was called 7827 times, avg 773ns/call:
# 7827 times (6.05ms+0s) by MARC::Record::field at line 210, avg 773ns/call | |||||
# spent 58µs within MARC::Record::CORE:qr which was called 13 times, avg 4µs/call:
# 13 times (58µs+0s) by MARC::Record::field at line 205, avg 4µs/call | |||||
sub MARC::Record::CORE:regcomp; # opcode |