|
Lines 7-21
use Text::Wrap;
Link Here
|
| 7 |
use Algorithm::CheckDigits; |
7 |
use Algorithm::CheckDigits; |
| 8 |
use Text::CSV_XS; |
8 |
use Text::CSV_XS; |
| 9 |
use Data::Dumper; |
9 |
use Data::Dumper; |
| 10 |
use Library::CallNumber::LC; |
|
|
| 11 |
use Text::Bidi qw( log2vis ); |
10 |
use Text::Bidi qw( log2vis ); |
| 12 |
|
11 |
|
| 13 |
use C4::Context; |
12 |
use C4::Context; |
| 14 |
use C4::Debug; |
13 |
use C4::Debug; |
| 15 |
use C4::Biblio; |
14 |
use C4::Biblio; |
| 16 |
|
15 |
use Koha::ClassSources; |
| 17 |
|
16 |
use Koha::ClassSortRules; |
| 18 |
my $possible_decimal = qr/\d{3,}(?:\.\d+)?/; # at least three digits for a DDCN |
17 |
use Koha::ClassSplitRules; |
|
|
18 |
use C4::ClassSplitRoutine::Dewey; |
| 19 |
use C4::ClassSplitRoutine::LCC; |
| 20 |
use C4::ClassSplitRoutine::Generic; |
| 21 |
use C4::ClassSplitRoutine::RegEx; |
| 19 |
|
22 |
|
| 20 |
sub _check_params { |
23 |
sub _check_params { |
| 21 |
my $given_params = {}; |
24 |
my $given_params = {}; |
|
Lines 121-187
sub _get_text_fields {
Link Here
|
| 121 |
return \@sorted_fields; |
124 |
return \@sorted_fields; |
| 122 |
} |
125 |
} |
| 123 |
|
126 |
|
| 124 |
|
|
|
| 125 |
sub _split_lccn { |
| 126 |
my ($lccn) = @_; |
| 127 |
$_ = $lccn; |
| 128 |
# lccn examples: 'HE8700.7 .P6T44 1983', 'BS2545.E8 H39 1996'; |
| 129 |
my @parts = Library::CallNumber::LC->new($lccn)->components(); |
| 130 |
unless (scalar @parts && defined $parts[0]) { |
| 131 |
$debug and warn sprintf('regexp failed to match string: %s', $_); |
| 132 |
@parts = $_; # if no match, just use the whole string. |
| 133 |
} |
| 134 |
my $LastPiece = pop @parts; |
| 135 |
push @parts, split /\s+/, $LastPiece if $LastPiece; # split the last piece into an arbitrary number of pieces at spaces |
| 136 |
$debug and warn "split_lccn array: ", join(" | ", @parts), "\n"; |
| 137 |
return @parts; |
| 138 |
} |
| 139 |
|
| 140 |
sub _split_ddcn { |
| 141 |
my ($ddcn) = @_; |
| 142 |
$_ = $ddcn; |
| 143 |
s/\///g; # in theory we should be able to simply remove all segmentation markers and arrive at the correct call number... |
| 144 |
my (@parts) = m/ |
| 145 |
^([-a-zA-Z]*\s?(?:$possible_decimal)?) # R220.3 CD-ROM 787.87 # will require extra splitting |
| 146 |
\s+ |
| 147 |
(.+) # H2793Z H32 c.2 EAS # everything else (except bracketing spaces) |
| 148 |
\s* |
| 149 |
/x; |
| 150 |
unless (scalar @parts) { |
| 151 |
warn sprintf('regexp failed to match string: %s', $_); |
| 152 |
push @parts, $_; # if no match, just push the whole string. |
| 153 |
} |
| 154 |
|
| 155 |
if ($parts[0] =~ /^([-a-zA-Z]+)\s?($possible_decimal)$/) { |
| 156 |
shift @parts; # pull off the mathching first element, like example 1 |
| 157 |
unshift @parts, $1, $2; # replace it with the two pieces |
| 158 |
} |
| 159 |
|
| 160 |
push @parts, split /\s+/, pop @parts; # split the last piece into an arbitrary number of pieces at spaces |
| 161 |
$debug and print STDERR "split_ddcn array: ", join(" | ", @parts), "\n"; |
| 162 |
return @parts; |
| 163 |
} |
| 164 |
|
| 165 |
## NOTE: Custom call number types go here. It may be necessary to create additional splitting algorithms if some custom call numbers |
| 166 |
## cannot be made to work here. Presently this splits standard non-ddcn, non-lccn fiction and biography call numbers. |
| 167 |
|
| 168 |
sub _split_ccn { |
| 169 |
my ($fcn) = @_; |
| 170 |
my @parts = (); |
| 171 |
# Split call numbers based on spaces |
| 172 |
push @parts, split /\s+/, $fcn; # split the call number into an arbitrary number of pieces at spaces |
| 173 |
if ($parts[-1] !~ /^.*\d-\d.*$/ && $parts[-1] =~ /^(.*\d+)(\D.*)$/) { |
| 174 |
pop @parts; # pull off the matching last element |
| 175 |
push @parts, $1, $2; # replace it with the two pieces |
| 176 |
} |
| 177 |
unless (scalar @parts) { |
| 178 |
warn sprintf('regexp failed to match string: %s', $_); |
| 179 |
push (@parts, $_); |
| 180 |
} |
| 181 |
$debug and print STDERR "split_ccn array: ", join(" | ", @parts), "\n"; |
| 182 |
return @parts; |
| 183 |
} |
| 184 |
|
| 185 |
sub _get_barcode_data { |
127 |
sub _get_barcode_data { |
| 186 |
my ( $f, $item, $record ) = @_; |
128 |
my ( $f, $item, $record ) = @_; |
| 187 |
my $kohatables = _desc_koha_tables(); |
129 |
my $kohatables = _desc_koha_tables(); |
|
Lines 400-405
sub draw_label_text {
Link Here
|
| 400 |
# FIXME - returns all items, so you can't get data from an embedded holdings field. |
342 |
# FIXME - returns all items, so you can't get data from an embedded holdings field. |
| 401 |
# TODO - add a GetMarcBiblio1item(bibnum,itemnum) or a GetMarcItem(itemnum). |
343 |
# TODO - add a GetMarcBiblio1item(bibnum,itemnum) or a GetMarcItem(itemnum). |
| 402 |
my $cn_source = ($item->{'cn_source'} ? $item->{'cn_source'} : C4::Context->preference('DefaultClassificationSource')); |
344 |
my $cn_source = ($item->{'cn_source'} ? $item->{'cn_source'} : C4::Context->preference('DefaultClassificationSource')); |
|
|
345 |
my $class_source = Koha::ClassSources->find( $cn_source ); |
| 346 |
my ( $split_routine, $regexs ); |
| 347 |
if ($class_source) { |
| 348 |
my $class_split_rule = Koha::ClassSplitRules->find( $class_source->class_split_rule ); |
| 349 |
$split_routine = $class_split_rule->split_routine; |
| 350 |
$regexs = $class_split_rule->regexs; |
| 351 |
} |
| 352 |
else { $split_routine = $cn_source } |
| 403 |
LABEL_FIELDS: # process data for requested fields on current label |
353 |
LABEL_FIELDS: # process data for requested fields on current label |
| 404 |
for my $field (@$label_fields) { |
354 |
for my $field (@$label_fields) { |
| 405 |
if ($field->{'code'} eq 'itemtype') { |
355 |
if ($field->{'code'} eq 'itemtype') { |
|
Lines 429-442
sub draw_label_text {
Link Here
|
| 429 |
# Fields which hold call number data FIXME: ( 060? 090? 092? 099? ) |
379 |
# Fields which hold call number data FIXME: ( 060? 090? 092? 099? ) |
| 430 |
my @callnumber_list = qw(itemcallnumber 050a 050b 082a 952o 995k); |
380 |
my @callnumber_list = qw(itemcallnumber 050a 050b 082a 952o 995k); |
| 431 |
if ((grep {$field->{'code'} =~ m/$_/} @callnumber_list) and ($self->{'printing_type'} eq 'BIB') and ($self->{'callnum_split'})) { # If the field contains the call number, we do some sp |
381 |
if ((grep {$field->{'code'} =~ m/$_/} @callnumber_list) and ($self->{'printing_type'} eq 'BIB') and ($self->{'callnum_split'})) { # If the field contains the call number, we do some sp |
| 432 |
if ($cn_source eq 'lcc' || $cn_source eq 'nlm') { # NLM and LCC should be split the same way |
382 |
if ($split_routine eq 'LCC' || $split_routine eq 'nlm') { # NLM and LCC should be split the same way |
| 433 |
@label_lines = _split_lccn($field_data); |
383 |
@label_lines = C4::ClassSplitRoutine::LCC::split_callnumber($field_data); |
| 434 |
@label_lines = _split_ccn($field_data) if !@label_lines; # If it was not a true lccn, try it as a custom call number |
384 |
@label_lines = C4::ClassSplitRoutine::Generic::split_callnumber($field_data) unless @label_lines; # If it was not a true lccn, try it as a custom call number |
| 435 |
push (@label_lines, $field_data) if !@label_lines; # If it was not that, send it on unsplit |
385 |
push (@label_lines, $field_data) unless @label_lines; # If it was not that, send it on unsplit |
| 436 |
} elsif ($cn_source eq 'ddc') { |
386 |
} elsif ($split_routine eq 'Dewey') { |
| 437 |
@label_lines = _split_ddcn($field_data); |
387 |
@label_lines = C4::ClassSplitRoutine::Dewey::split_callnumber($field_data); |
| 438 |
@label_lines = _split_ccn($field_data) if !@label_lines; |
388 |
@label_lines = C4::ClassSplitRoutine::Generic::split_callnumber($field_data) unless @label_lines; |
| 439 |
push (@label_lines, $field_data) if !@label_lines; |
389 |
push (@label_lines, $field_data) unless @label_lines; |
|
|
390 |
} elsif ($split_routine eq 'RegEx' ) { |
| 391 |
@label_lines = C4::ClassSplitRoutine::RegEx::split_callnumber($field_data, $regexs); |
| 392 |
@label_lines = C4::ClassSplitRoutine::Generic::split_callnumber($field_data) unless @label_lines; |
| 393 |
push (@label_lines, $field_data) unless @label_lines; |
| 440 |
} else { |
394 |
} else { |
| 441 |
warn sprintf('Call number splitting failed for: %s. Please add this call number to bug #2500 at bugs.koha-community.org', $field_data); |
395 |
warn sprintf('Call number splitting failed for: %s. Please add this call number to bug #2500 at bugs.koha-community.org', $field_data); |
| 442 |
push @label_lines, $field_data; |
396 |
push @label_lines, $field_data; |