From: Joe Atzberger <joe.atzberger@liblime.com>
Date: Mon, 9 Mar 2009 20:19:31 +0000 (-0500)
Subject: Bug 2691 - LCCN split (for labels)
X-Git-Tag: ontop~375
X-Git-Url: http://git.rot13.org/?a=commitdiff_plain;h=9c8623fa138af0e67c6023f8ab462ed2ced42c02;p=koha.git

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 <galen.charlton@liblime.com>
---

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 {