use Text::Wrap;
use Algorithm::CheckDigits;
use Text::CSV_XS;
+use Data::Dumper;
use C4::Context;
use C4::Debug;
$_ = $ddcn;
s/\///g; # in theory we should be able to simply remove all segmentation markers and arrive at the correct call number...
my (@parts) = m/
- ^([a-zA-Z-]+(?:$possible_decimal)?) # R220.3 # BIO # first example will require extra splitting
+ ^([-a-zA-Z]*\s?(?:$possible_decimal)?) # R220.3 CD-ROM 787.87 # will require extra splitting
\s+
- (.+) # H2793Z H32 c.2 # R5c.1 # everything else (except bracketing spaces)
+ (.+) # H2793Z H32 c.2 EAS # everything else (except bracketing spaces)
\s*
/x;
unless (scalar @parts) {
push @parts, $_; # if no match, just push the whole string.
}
- if ($parts[ 0] =~ /^([a-zA-Z]+)($possible_decimal)$/) {
+ if ($parts[0] =~ /^([-a-zA-Z]+)\s?($possible_decimal)$/) {
shift @parts; # pull off the mathching first element, like example 1
unshift @parts, $1, $2; # replace it with the two pieces
}
push @parts, split /\s+/, pop @parts; # split the last piece into an arbitrary number of pieces at spaces
-
- if ($parts[-1] !~ /^.*\d-\d.*$/ && $parts[-1] =~ /^(.*\d+)(\D.*)$/) {
- pop @parts; # pull off the mathching last element, like example 2
- push @parts, $1, $2; # replace it with the two pieces
- }
-
$debug and print STDERR "split_ddcn array: ", join(" | ", @parts), "\n";
return @parts;
}
-sub _split_fcn {
+## NOTE: Custom call number types go here. It may be necessary to create additional splitting algorithms if some custom call numbers
+## cannot be made to work here. Presently this splits standard non-ddcn, non-lccn fiction and biography call numbers.
+
+sub _split_ccn {
my ($fcn) = @_;
- my @fcn_split = ();
- # Split fiction call numbers based on spaces
- SPLIT_FCN:
- while ($fcn) {
- if ($fcn =~ m/([A-Za-z0-9]+\.?[0-9]?)(\W?).*?/x) {
- push (@fcn_split, $1);
- $fcn = $';
- }
- else {
- last SPLIT_FCN; # No match, break out of the loop
- }
+ my @parts = ();
+ # Split call numbers based on spaces
+ push @parts, split /\s+/, $fcn; # split the call number into an arbitrary number of pieces at spaces
+ if ($parts[-1] !~ /^.*\d-\d.*$/ && $parts[-1] =~ /^(.*\d+)(\D.*)$/) {
+ pop @parts; # pull off the matching last element
+ push @parts, $1, $2; # replace it with the two pieces
}
- unless (scalar @fcn_split) {
+ unless (scalar @parts) {
warn sprintf('regexp failed to match string: %s', $_);
- push (@fcn_split, $_);
+ push (@parts, $_);
}
- return @fcn_split;
+ $debug and print STDERR "split_ccn array: ", join(" | ", @parts), "\n";
+ return @parts;
}
sub _get_barcode_data {
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
if ($cn_source eq 'lcc') {
@label_lines = _split_lccn($field_data);
- @label_lines = _split_fcn($field_data) if !@label_lines; # If it was not a true lccn, try it as a fiction call number
+ @label_lines = _split_ccn($field_data) if !@label_lines; # If it was not a true lccn, try it as a custom call number
push (@label_lines, $field_data) if !@label_lines; # If it was not that, send it on unsplit
} elsif ($cn_source eq 'ddc') {
@label_lines = _split_ddcn($field_data);
- @label_lines = _split_fcn($field_data) if !@label_lines;
+ @label_lines = _split_ccn($field_data) if !@label_lines;
push (@label_lines, $field_data) if !@label_lines;
} else {
warn sprintf('Call number splitting failed for: %s. Please add this call number to bug #2500 at bugs.koha.org', $field_data);
--- /dev/null
+#!/usr/bin/perl
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+#
+# for context, see http://bugs.koha.org
+
+use strict;
+use warnings;
+
+use Test::More;
+
+BEGIN {
+ our $ccns = {};
+ if ($ARGV[0]) {
+ BAIL_OUT("USAGE: perl Labels_split_ccn.t 'BIO JP2 R5c.1' 'BIO,JP2,R5c.1'") unless $ARGV[1];
+ $ccns = {$ARGV[0] => [split (/,/,$ARGV[1])],};
+ }
+ else {
+ $ccns = {
+ 'BIO JP2 R5c.1' => [qw(BIO JP2 R5 c.1)],
+ 'FIC GIR J5c.1' => [qw(FIC GIR J5 c.1)],
+ 'J DAR G7c.11' => [qw( J DAR G7 c.11)],
+ 'MP3-CD F PARKER' => [qw(MP3-CD F PARKER)],
+ };
+ }
+ my $test_num = 1;
+ foreach (keys(%$ccns)) {
+ my $split_num += scalar(@{$ccns->{$_}});
+ $test_num += 2 * $split_num;
+ $test_num += 4;
+ }
+ plan tests => $test_num;
+ use_ok('C4::Labels::Label');
+ use vars qw($ccns);
+}
+
+foreach my $ccn (sort keys %$ccns) {
+ my (@parts, @expected);
+ ok($ccn, "ddcn: $ccn");
+ ok(@expected = @{$ccns->{$ccn}}, "split expected to produce " . scalar(@expected) . " pieces");
+ ok(@parts = C4::Labels::Label::_split_ccn($ccn), "C4::Labels::Label::_split_ccn($ccn)");
+ ok(scalar(@expected) == scalar(@parts), sprintf("%d of %d pieces produced", scalar(@parts), scalar(@expected)));
+ my $i = 0;
+ foreach my $unit (@expected) {
+ my $part;
+ ok($part = $parts[$i], "($ccn)[$i] populated: " . (defined($part) ? $part : 'UNDEF'));
+ ok((defined($part) and $part eq $unit), "($ccn)[$i] matches: $unit");
+ $i++;
+ }
+}
#!/usr/bin/perl
#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+#
# for context, see http://bugs.koha.org
use strict;
use warnings;
-use Test::More tests => 82;
+use Test::More;
BEGIN {
- use_ok('C4::Labels');
+ our $ddcns = {};
+ if ($ARGV[0]) {
+ BAIL_OUT("USAGE: perl Labels_split_ddcn.t '621.3828 J28l' '621.3828,J28l'") unless $ARGV[1];
+ $ddcns = {$ARGV[0] => [split (/,/,$ARGV[1])],};
+ }
+ else {
+ $ddcns = {
+ 'R220.3 H2793Z H32 c.2' => [qw(R 220.3 H2793Z H32 c.2)],
+ 'CD-ROM 787.87 EAS' => [qw(CD-ROM 787.87 EAS)],
+ '252.051 T147 v.1-2' => [qw(252.051 T147 v.1-2)],
+ };
+ }
+ my $test_num = 1;
+ foreach (keys(%$ddcns)) {
+ my $split_num += scalar(@{$ddcns->{$_}});
+ $test_num += 2 * $split_num;
+ $test_num += 4;
+ }
+ plan tests => $test_num;
+ use_ok('C4::Labels::Label');
+ use vars qw($ddcns);
}
-ok(defined C4::Labels::split_ddcn, 'C4::Labels::split_ddcn defined');
-
-my $ddcns = {
- 'BIO JP2 R5c.1' => [qw(BIO JP2 R5 c.1 )],
- 'FIC GIR J5c.1' => [qw(FIC GIR J5 c.1 )],
- 'J DAR G7c.11' => [qw( J DAR G7 c.11)],
- 'R220.3 H2793Z H32 c.2' => [qw(R 220.3 H2793Z H32 c.2)],
- 'CD-ROM 787.87 EAS' => [qw(CD-ROM 787.87 EAS)],
- 'MP3-CD F PARKER' => [qw(MP3-CD F PARKER)],
- '252.051 T147 v.1-2' => [qw(252.051 T147 v.1-2)],
-};
foreach my $ddcn (sort keys %$ddcns) {
my (@parts, @expected);
ok($ddcn, "ddcn: $ddcn");
ok(@expected = @{$ddcns->{$ddcn}}, "split expected to produce " . scalar(@expected) . " pieces");
- ok(@parts = C4::Labels::split_ddcn($ddcn), "C4::Labels::split_ddcn($ddcn)");
+ ok(@parts = C4::Labels::Label::_split_ddcn($ddcn), "C4::Labels::Label::_split_ddcn($ddcn)");
ok(scalar(@expected) == scalar(@parts), sprintf("%d of %d pieces produced", scalar(@parts), scalar(@expected)));
my $i = 0;
foreach my $unit (@expected) {
$i++;
}
}
-
#!/usr/bin/perl
#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+#
# for context, see http://bugs.koha.org/cgi-bin/bugzilla/show_bug.cgi?id=2691
use strict;
use warnings;
-use Test::More tests => 44;
+use Test::More;
BEGIN {
- use_ok('C4::Labels');
+ our $lccns = {};
+ if ($ARGV[0]) {
+ BAIL_OUT("USAGE: perl Labels_split_lccn.t 'HE 8700.7 .P6 T44 1983' 'HE,8700.7,.P6,T44,1983'") unless $ARGV[1];
+ $lccns = {$ARGV[0] => [split (/,/,$ARGV[1])],};
+ }
+ else {
+ $lccns = {
+ 'HE8700.7 .P6T44 1983' => [qw(HE 8700.7 .P6 T44 1983)],
+ 'BS2545.E8 H39 1996' => [qw(BS 2545 .E8 H39 1996)],
+ 'NX512.S85 A4 2006' => [qw(NX 512 .S85 A4 2006)],
+ };
+ }
+ my $test_num = 1;
+ foreach (keys(%$lccns)) {
+ my $split_num += scalar(@{$lccns->{$_}});
+ $test_num += 2 * $split_num;
+ $test_num += 4;
+ }
+ plan tests => $test_num;
+ use_ok('C4::Labels::Label');
+ use vars qw($lccns);
}
-ok(defined C4::Labels::split_lccn, 'C4::Labels::split_lccn defined');
-
-my $lccns = {
- 'HE8700.7 .P6T44 1983' => [qw(HE 8700.7 .P6 T44 1983)],
- 'BS2545.E8 H39 1996' => [qw(BS 2545 .E8 H39 1996)],
- 'NX512.S85 A4 2006' => [qw(NX 512 .S85 A4 2006)],
-};
foreach my $lccn (sort keys %$lccns) {
my (@parts, @expected);
ok($lccn, "lccn: $lccn");
ok(@expected = @{$lccns->{$lccn}}, "split expected to produce " . scalar(@expected) . " pieces");
- ok(@parts = C4::Labels::split_lccn($lccn), "C4::Labels::split_lccn($lccn)");
+ ok(@parts = C4::Labels::Label::_split_lccn($lccn), "C4::Labels::Label::_split_lccn($lccn)");
ok(scalar(@expected) == scalar(@parts), sprintf("%d of %d pieces produced", scalar(@parts), scalar(@expected)));
my $i = 0;
foreach my $unit (@expected) {