Lines 6-11
use warnings;
Link Here
|
6 |
use Text::Wrap; |
6 |
use Text::Wrap; |
7 |
use Algorithm::CheckDigits; |
7 |
use Algorithm::CheckDigits; |
8 |
use Text::CSV_XS; |
8 |
use Text::CSV_XS; |
|
|
9 |
use Data::Dumper; |
9 |
|
10 |
|
10 |
use C4::Context; |
11 |
use C4::Context; |
11 |
use C4::Debug; |
12 |
use C4::Debug; |
Lines 133-141
sub _split_ddcn {
Link Here
|
133 |
$_ = $ddcn; |
134 |
$_ = $ddcn; |
134 |
s/\///g; # in theory we should be able to simply remove all segmentation markers and arrive at the correct call number... |
135 |
s/\///g; # in theory we should be able to simply remove all segmentation markers and arrive at the correct call number... |
135 |
my (@parts) = m/ |
136 |
my (@parts) = m/ |
136 |
^([a-zA-Z-]+(?:$possible_decimal)?) # R220.3 # BIO # first example will require extra splitting |
137 |
^([-a-zA-Z]*\s?(?:$possible_decimal)?) # R220.3 CD-ROM 787.87 # will require extra splitting |
137 |
\s+ |
138 |
\s+ |
138 |
(.+) # H2793Z H32 c.2 # R5c.1 # everything else (except bracketing spaces) |
139 |
(.+) # H2793Z H32 c.2 EAS # everything else (except bracketing spaces) |
139 |
\s* |
140 |
\s* |
140 |
/x; |
141 |
/x; |
141 |
unless (scalar @parts) { |
142 |
unless (scalar @parts) { |
Lines 143-183
sub _split_ddcn {
Link Here
|
143 |
push @parts, $_; # if no match, just push the whole string. |
144 |
push @parts, $_; # if no match, just push the whole string. |
144 |
} |
145 |
} |
145 |
|
146 |
|
146 |
if ($parts[ 0] =~ /^([a-zA-Z]+)($possible_decimal)$/) { |
147 |
if ($parts[0] =~ /^([-a-zA-Z]+)\s?($possible_decimal)$/) { |
147 |
shift @parts; # pull off the mathching first element, like example 1 |
148 |
shift @parts; # pull off the mathching first element, like example 1 |
148 |
unshift @parts, $1, $2; # replace it with the two pieces |
149 |
unshift @parts, $1, $2; # replace it with the two pieces |
149 |
} |
150 |
} |
150 |
|
151 |
|
151 |
push @parts, split /\s+/, pop @parts; # split the last piece into an arbitrary number of pieces at spaces |
152 |
push @parts, split /\s+/, pop @parts; # split the last piece into an arbitrary number of pieces at spaces |
152 |
|
|
|
153 |
if ($parts[-1] !~ /^.*\d-\d.*$/ && $parts[-1] =~ /^(.*\d+)(\D.*)$/) { |
154 |
pop @parts; # pull off the mathching last element, like example 2 |
155 |
push @parts, $1, $2; # replace it with the two pieces |
156 |
} |
157 |
|
158 |
$debug and print STDERR "split_ddcn array: ", join(" | ", @parts), "\n"; |
153 |
$debug and print STDERR "split_ddcn array: ", join(" | ", @parts), "\n"; |
159 |
return @parts; |
154 |
return @parts; |
160 |
} |
155 |
} |
161 |
|
156 |
|
162 |
sub _split_fcn { |
157 |
## NOTE: Custom call number types go here. It may be necessary to create additional splitting algorithms if some custom call numbers |
|
|
158 |
## cannot be made to work here. Presently this splits standard non-ddcn, non-lccn fiction and biography call numbers. |
159 |
|
160 |
sub _split_ccn { |
163 |
my ($fcn) = @_; |
161 |
my ($fcn) = @_; |
164 |
my @fcn_split = (); |
162 |
my @parts = (); |
165 |
# Split fiction call numbers based on spaces |
163 |
# Split call numbers based on spaces |
166 |
SPLIT_FCN: |
164 |
push @parts, split /\s+/, $fcn; # split the call number into an arbitrary number of pieces at spaces |
167 |
while ($fcn) { |
165 |
if ($parts[-1] !~ /^.*\d-\d.*$/ && $parts[-1] =~ /^(.*\d+)(\D.*)$/) { |
168 |
if ($fcn =~ m/([A-Za-z0-9]+\.?[0-9]?)(\W?).*?/x) { |
166 |
pop @parts; # pull off the matching last element |
169 |
push (@fcn_split, $1); |
167 |
push @parts, $1, $2; # replace it with the two pieces |
170 |
$fcn = $'; |
|
|
171 |
} |
172 |
else { |
173 |
last SPLIT_FCN; # No match, break out of the loop |
174 |
} |
175 |
} |
168 |
} |
176 |
unless (scalar @fcn_split) { |
169 |
unless (scalar @parts) { |
177 |
warn sprintf('regexp failed to match string: %s', $_); |
170 |
warn sprintf('regexp failed to match string: %s', $_); |
178 |
push (@fcn_split, $_); |
171 |
push (@parts, $_); |
179 |
} |
172 |
} |
180 |
return @fcn_split; |
173 |
$debug and print STDERR "split_ccn array: ", join(" | ", @parts), "\n"; |
|
|
174 |
return @parts; |
181 |
} |
175 |
} |
182 |
|
176 |
|
183 |
sub _get_barcode_data { |
177 |
sub _get_barcode_data { |
Lines 414-424
sub draw_label_text {
Link Here
|
414 |
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 |
408 |
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 |
415 |
if ($cn_source eq 'lcc') { |
409 |
if ($cn_source eq 'lcc') { |
416 |
@label_lines = _split_lccn($field_data); |
410 |
@label_lines = _split_lccn($field_data); |
417 |
@label_lines = _split_fcn($field_data) if !@label_lines; # If it was not a true lccn, try it as a fiction call number |
411 |
@label_lines = _split_ccn($field_data) if !@label_lines; # If it was not a true lccn, try it as a custom call number |
418 |
push (@label_lines, $field_data) if !@label_lines; # If it was not that, send it on unsplit |
412 |
push (@label_lines, $field_data) if !@label_lines; # If it was not that, send it on unsplit |
419 |
} elsif ($cn_source eq 'ddc') { |
413 |
} elsif ($cn_source eq 'ddc') { |
420 |
@label_lines = _split_ddcn($field_data); |
414 |
@label_lines = _split_ddcn($field_data); |
421 |
@label_lines = _split_fcn($field_data) if !@label_lines; |
415 |
@label_lines = _split_ccn($field_data) if !@label_lines; |
422 |
push (@label_lines, $field_data) if !@label_lines; |
416 |
push (@label_lines, $field_data) if !@label_lines; |
423 |
} else { |
417 |
} else { |
424 |
warn sprintf('Call number splitting failed for: %s. Please add this call number to bug #2500 at bugs.koha.org', $field_data); |
418 |
warn sprintf('Call number splitting failed for: %s. Please add this call number to bug #2500 at bugs.koha.org', $field_data); |