-
-sub _split_lccn {
- my ($lccn) = @_;
- $_ = $lccn;
- # lccn examples: 'HE8700.7 .P6T44 1983', 'BS2545.E8 H39 1996';
- my (@parts) = m/
- ^([a-zA-Z]+) # HE # BS
- (\d+(?:\.\d)*) # 8700.7 # 2545
- \s*
- (\.*\D+\d*) # .P6 # .E8
- \s*
- (.*) # T44 1983 # H39 1996 # everything else (except any bracketing spaces)
- \s*
- /x;
- unless (scalar @parts) {
- warn sprintf('regexp failed to match string: %s', $_);
- push @parts, $_; # if no match, just push the whole string.
- }
- push @parts, split /\s+/, pop @parts; # split the last piece into an arbitrary number of pieces at spaces
- $debug and warn "split_lccn array: ", join(" | ", @parts), "\n";
- return @parts;
-}
-
-sub _split_ddcn {
- my ($ddcn) = @_;
- $_ = $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]*\s?(?:$possible_decimal)?) # R220.3 CD-ROM 787.87 # will require extra splitting
- \s+
- (.+) # H2793Z H32 c.2 EAS # everything else (except bracketing spaces)
- \s*
- /x;
- unless (scalar @parts) {
- warn sprintf('regexp failed to match string: %s', $_);
- push @parts, $_; # if no match, just push the whole string.
- }
-
- 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
- $debug and print STDERR "split_ddcn array: ", join(" | ", @parts), "\n";
- return @parts;
-}
-
-## 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 @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 @parts) {
- warn sprintf('regexp failed to match string: %s', $_);
- push (@parts, $_);
- }
- $debug and print STDERR "split_ccn array: ", join(" | ", @parts), "\n";
- return @parts;
-}
-