From fd4622b31573237aeb8739e92a45309fa298b2ae Mon Sep 17 00:00:00 2001 From: Marcel de Rooy Date: Mon, 23 Feb 2026 15:21:33 +0100 Subject: [PATCH] Bug 41932: Adjust generic class sort to allow zero-padding Content-Type: text/plain; charset=utf-8 Test plan: Run t/ClassSortRoutine_Generic.t Add a few callnumber formats in ClassSortGenericFormats like: ^A:1,3;1,2;;^B:1,2 In words: callnumber starts with A, 1 or more digits (pad to 3), then 1 or more digits (pad to 2). Or callnumber starts with B, one or more digits (pad to 2). Enable generic call number sorting rules in Classification configuration. Now save a few items with callnumbers: 1 A 1, 10 A 2, B2, B11. Check if cn_sort now matches: 001_A_01, 100_A_02, B02, B11. Signed-off-by: Marcel de Rooy --- C4/ClassSortRoutine/Generic.pm | 69 +++++++++++++++++++++++++-- t/ClassSortRoutine_Generic.t | 85 +++++++++++++++++++++++++++------- 2 files changed, 133 insertions(+), 21 deletions(-) diff --git a/C4/ClassSortRoutine/Generic.pm b/C4/ClassSortRoutine/Generic.pm index 1b77b0230e..91f278940d 100644 --- a/C4/ClassSortRoutine/Generic.pm +++ b/C4/ClassSortRoutine/Generic.pm @@ -1,6 +1,6 @@ package C4::ClassSortRoutine::Generic; -# Copyright (C) 2007 LibLime +# Copyright (C) 2007 LibLime, 2026 Rijksmuseum # # This file is part of Koha. # @@ -20,7 +20,7 @@ package C4::ClassSortRoutine::Generic; use strict; use warnings; -=head1 NAME +=head1 NAME C4::ClassSortRoutine::Generic - generic call number sorting key routine @@ -51,12 +51,72 @@ sub get_class_sort_key { $cn_class = '' unless defined $cn_class; $cn_item = '' unless defined $cn_item; my $key = uc "$cn_class $cn_item"; - $key =~ s/^\s+//; - $key =~ s/\s+$//; + + # Remove leading/trailing spaces, then zero pad + # Then replace spaces and remove 'cruft' + $key =~ s/^\s+|\s+$//g; + $key = _zero_pad_callnum($key); $key =~ s/\s+/_/g; $key =~ s/[^\p{IsAlnum}_]//g; + return $key; +} + +=head2 _zero_pad_callnum + + Optionally zero pad numeric parts of a call number with zeroes + based on the preference ClassSortGenericFormats. + That pref may contain multiple formats separated by ';;'. + A format has an optional filter (regex) followed by a colon, and a + list of pairs of two numbers (separated by commas). The two numbers + represent a minimum number of digits to find and the length to pad. + So e.g. 1,4;2,3 means find at least 1 digit and pad to 4 positions, + then find at least 2 digits and pad to 3 positions. + If a format leads to a match, the remaining formats are skipped. So, + the order of the formats matters. + See also t/ClassSortRoutine_Generic.t for some examples. + +=cut + +sub _zero_pad_callnum { + my $key = shift; + return if !defined($key); + my $pref = C4::Context->preference('ClassSortGenericFormats') or return $key; + foreach my $format ( split /;;/, $pref ) { + + # a format has an optional filter and a list of min,padlength pairs + my ( $filter, $pairs ) = + $format =~ /:/ + ? split /:/, $format, 2 + : ( q{}, $format ); + if ($filter) { + my $test = eval { $key =~ /$filter/ ? 1 : 0 }; + warn "Pref ClassSortGenericFormats has bad filter: $filter\n" if !defined $test; # regex failed + next if !$test; + } + + my @pairs = map { my $p = $_; $p =~ s/\s*//g; $p } map { split /,/, $_, 2 } split /;/, $pairs; + if ( @pairs % 2 > 0 || grep { /\D|^0?$/ } @pairs ) { + + # We expect: even number, only digits, not zero or empty + warn "Pref ClassSortGenericFormats has bad format: $format\n"; + next; + } + + my ( $new_key, $pos, $digits ) = ( q{}, 0 ); + foreach ( my $j = 0 ; $j < @pairs ; $j += 2 ) { + if ( $pairs[$j] && substr( $key, $pos ) =~ /(\d{$pairs[$j],})/ ) { + $pos += $-[0] + length($1); + $digits = $pairs[ $j + 1 ]; + $new_key .= $` . sprintf( "%0${digits}d", $1 ); + return $new_key . substr( $key, $pos ) if $j + 2 >= @pairs; + } else { + last; + } + } + } + return $key; } 1; @@ -66,4 +126,3 @@ sub get_class_sort_key { Koha Development Team =cut - diff --git a/t/ClassSortRoutine_Generic.t b/t/ClassSortRoutine_Generic.t index 7f973402bc..ac767e4b1a 100755 --- a/t/ClassSortRoutine_Generic.t +++ b/t/ClassSortRoutine_Generic.t @@ -1,25 +1,78 @@ #!/usr/bin/perl -# -# This Koha test module is a stub! -# Add more tests here!!! - -use strict; -use warnings; +use Modern::Perl; +use Test::More tests => 3; use Test::NoWarnings; -use Test::More tests => 4; +use Test::Warn; +use t::lib::Mocks; +use C4::ClassSortRoutine::Generic qw( get_class_sort_key ); + +subtest 'class_sort_key' => sub { + t::lib::Mocks::mock_preference( 'ClassSortGenericFormats', q{} ); + + my $cn_class = "My class "; + my $cn_item = " hellO"; + + my $cn_sort = C4::ClassSortRoutine::Generic::get_class_sort_key( $cn_class, $cn_item ); + is( $cn_sort, "MY_CLASS_HELLO", "testing cnsort" ); + + $cn_sort = C4::ClassSortRoutine::Generic::get_class_sort_key(); + is( $cn_sort, "", "Testing with undef" ); + + $cn_sort = C4::ClassSortRoutine::Generic::get_class_sort_key(' 1 A 2 '); + is( $cn_sort, '1_A_2', 'Removed leading and trailing whitespace' ); +}; + +subtest '_zero_pad_callnum' => sub { + t::lib::Mocks::mock_preference( 'ClassSortGenericFormats', '\s[A-Z]\s:1,4;1,3' ); + + # Trivial tests + is( C4::ClassSortRoutine::Generic::_zero_pad_callnum(), undef ); + is( C4::ClassSortRoutine::Generic::_zero_pad_callnum(q{}), q{} ); + + # Filter does not match + is( C4::ClassSortRoutine::Generic::_zero_pad_callnum('1 @ 2'), '1 @ 2' ); -BEGIN { - use_ok('C4::ClassSortRoutine::Generic'); -} + # Format does not match (no two digit groups) + is( C4::ClassSortRoutine::Generic::_zero_pad_callnum('2 T (a)'), '2 T (a)' ); -my $cn_class = "My class "; -my $cn_item = " hellO"; + # Matching (two) digit groups + is( C4::ClassSortRoutine::Generic::_zero_pad_callnum('0 A 23 test 45'), '0000 A 023 test 45' ); + is( C4::ClassSortRoutine::Generic::_zero_pad_callnum('12 A 234 test 456'), '0012 A 234 test 456' ); + is( C4::ClassSortRoutine::Generic::_zero_pad_callnum('123 A 1234 test 3456'), '0123 A 1234 test 3456' ); + is( C4::ClassSortRoutine::Generic::_zero_pad_callnum('1234 A 12345 test 34567'), '1234 A 12345 test 34567' ); + is( C4::ClassSortRoutine::Generic::_zero_pad_callnum('12345 A 12345 test 34567'), '12345 A 12345 test 34567' ); -my $cn_sort = C4::ClassSortRoutine::Generic::get_class_sort_key( $cn_class, $cn_item ); + # Invalid filter, invalid format (zero or empty string, no semicolon) + t::lib::Mocks::mock_preference( 'ClassSortGenericFormats', '^BC):1,4;1,3' ); + my $result; + warning_like { $result = C4::ClassSortRoutine::Generic::_zero_pad_callnum('BC 11 A 2') } + qr/bad filter/, 'Got a warn about bad filter'; + is( $result, 'BC 11 A 2' ); + t::lib::Mocks::mock_preference( 'ClassSortGenericFormats', '^BC:1,4;0,3' ); + warning_like { $result = C4::ClassSortRoutine::Generic::_zero_pad_callnum('BC 11 A 2') } + qr/bad format/, 'Got a warn about bad format'; + is( $result, 'BC 11 A 2' ); + t::lib::Mocks::mock_preference( 'ClassSortGenericFormats', '^BC:1,4;,3' ); + warning_like { $result = C4::ClassSortRoutine::Generic::_zero_pad_callnum('BC 11 A 2') } + qr/bad format/, 'Got a warn about bad format'; + is( $result, 'BC 11 A 2' ); + t::lib::Mocks::mock_preference( 'ClassSortGenericFormats', '^BC:2,4,1,3' ); + warning_like { $result = C4::ClassSortRoutine::Generic::_zero_pad_callnum('BC 11 A 2') } + qr/bad format/, 'Got a warn about bad format'; + is( $result, 'BC 11 A 2' ); -is( $cn_sort, "MY_CLASS_HELLO", "testing cnsort" ); + # Correct the format + t::lib::Mocks::mock_preference( 'ClassSortGenericFormats', '^BC: 2,4; 1,3' ); + is( C4::ClassSortRoutine::Generic::_zero_pad_callnum('BC 11 A 2'), 'BC 0011 A 002' ); -$cn_sort = C4::ClassSortRoutine::Generic::get_class_sort_key( undef, undef ); + # First digit group too short, last group not included in format + is( C4::ClassSortRoutine::Generic::_zero_pad_callnum('BC 1 22 A 3 4'), 'BC 1 0022 A 003 4' ); -is( $cn_sort, "", "Testing blank cnsort" ); + # More formats (hitting each one once, and finally no one) + t::lib::Mocks::mock_preference( 'ClassSortGenericFormats', '^BC:2,4;2,3;;^B:2,3;;1,2;1,2;1,2' ); + is( C4::ClassSortRoutine::Generic::_zero_pad_callnum('BC 11 A 22'), 'BC 0011 A 022' ); + is( C4::ClassSortRoutine::Generic::_zero_pad_callnum('BC 11 A 2'), 'BC 011 A 2' ); + is( C4::ClassSortRoutine::Generic::_zero_pad_callnum('BC 1 A 2 3'), 'BC 01 A 02 03' ); + is( C4::ClassSortRoutine::Generic::_zero_pad_callnum('BC 1 A 2 X'), 'BC 1 A 2 X' ); +}; -- 2.39.5