From 9c8623fa138af0e67c6023f8ab462ed2ced42c02 Mon Sep 17 00:00:00 2001 From: Joe Atzberger Date: Mon, 9 Mar 2009 15:19:31 -0500 Subject: [PATCH] Bug 2691 - LCCN split (for labels) This corresponds with the test I submitted earlier and essentially overrides the partial improvement from Nighswonger under Bug 2500. Signed-off-by: Galen Charlton --- C4/Labels.pm | 26 +++++++++++--------------- 1 file changed, 11 insertions(+), 15 deletions(-) diff --git a/C4/Labels.pm b/C4/Labels.pm index 5178309cda..36c8809226 100644 --- a/C4/Labels.pm +++ b/C4/Labels.pm @@ -907,24 +907,20 @@ sub deduplicate_batch { sub split_lccn { my ($lccn) = @_; - my ($ll, $wnl, $dec, $cutter, $pubdate) = (0, 0, 0, 0, 0); $_ = $lccn; - # lccn example 'HE8700.7 .P6T44 1983'; - my @splits = m/ - (^[a-zA-Z]+) # HE - ([0-9]+\.*[0-9]*) # 8700.7 + # lccn examples: 'HE8700.7 .P6T44 1983', 'BS2545.E8 H39 1996'; + my (@parts) = m/ + ^([a-zA-Z]+) # HE # BS + (\d+(?:\.\d)*) # 8700.7 # 2545 \s* - (\.*[a-zA-Z0-9]*) # P6T44 + (\.*\D+\d*) # .P6 # .E8 \s* - ([0-9]*) # 1983 - /x; - - # strip something occuring spaces too - $splits[0] =~ s/\s+$//; - $splits[1] =~ s/\s+$//; - $splits[2] =~ s/\s+$//; - - return @splits; + (.*) # T44 1983 # H39 1996 # everything else (except any trailing spaces) + \s* + /x; + push @parts, split /\s+/, pop @parts; # split the last piece into an arbitrary number of pieces at spaces + $debug and print STDERR "split_lccn array: ", join(" | ", @parts), "\n"; + return @parts; } sub split_ddcn { -- 2.39.5