|
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); |