View | Details | Raw Unified | Return to bug 15836
Collapse All | Expand All

(-)a/C4/ClassSplitRoutine.pm (+63 lines)
Line 0 Link Here
1
package C4::ClassSplitRoutine;
2
3
# Copyright 2018 Koha Development Team
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
22
require Exporter;
23
use Class::Factory::Util;
24
25
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
26
27
28
=head1 NAME
29
30
C4::ClassSplitRoutine - base object for creation of classification splitting routines
31
32
=head1 SYNOPSIS
33
34
use C4::ClassSplitRoutine;
35
36
=head1 FUNCTIONS
37
38
=cut
39
40
@ISA    = qw(Exporter);
41
@EXPORT = qw(
42
   &GetSplitRoutineNames
43
);
44
45
=head2 GetSplitRoutineNames
46
47
  my @routines = GetSplitRoutineNames();
48
49
Get names of all modules under C4::ClassSplitRoutine::*.
50
51
=cut
52
53
sub GetSplitRoutineNames {
54
    return C4::ClassSplitRoutine->subclasses();
55
}
56
57
1;
58
59
=head1 AUTHOR
60
61
Koha Development Team <http://koha-community.org/>
62
63
=cut
(-)a/C4/ClassSplitRoutine/Dewey.pm (+79 lines)
Line 0 Link Here
1
package C4::ClassSplitRoutine::Dewey;
2
3
# Copyright 2018 Koha Development Team
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
22
use C4::Debug;
23
24
=head1 NAME
25
26
C4::ClassSplitRoutine::Dewey - Dewey call number split method
27
28
=head1 SYNOPSIS
29
30
use C4::ClassSplitRoutine;
31
32
my $cn_split = C4::ClassSplitRoutine::Dewey::split_callnumber($cn_item);
33
34
=head1 FUNCTIONS
35
36
=head2 split_callnumber
37
38
  my $cn_split = C4::ClassSplitRoutine::Dewey::split_callnumber($cn_item);
39
40
=cut
41
42
sub split_callnumber {
43
    my ($cn_item) = @_;
44
45
    my $possible_decimal =
46
      qr/\d{3,}(?:\.\d+)?/;    # at least three digits for a DDCN
47
48
    $cn_item =~ s/\///g
49
      ; # in theory we should be able to simply remove all segmentation markers and arrive at the correct call number...
50
    my (@lines) = $cn_item =~ m/
51
        ^([-a-zA-Z]*\s?(?:$possible_decimal)?) # R220.3  CD-ROM 787.87 # will require extra splitting
52
        \s+
53
        (.+)                               # H2793Z H32 c.2 EAS # everything else (except bracketing spaces)
54
        \s*
55
        /x;
56
    unless (@lines) {
57
        warn sprintf( 'regexp failed to match string: %s', $cn_item );
58
        push @lines, $cn_item;    # if no match, just push the whole string.
59
    }
60
61
    if ( $lines[0] =~ /^([-a-zA-Z]+)\s?($possible_decimal)$/ ) {
62
        shift @lines;    # pull off the mathching first element, like example 1
63
        unshift @lines, $1, $2;    # replace it with the two pieces
64
    }
65
66
    push @lines, split /\s+/,
67
      pop @lines
68
      ;    # split the last piece into an arbitrary number of pieces at spaces
69
    $debug and print STDERR "split_ddcn array: ", join( " | ", @lines ), "\n";
70
    return @lines;
71
}
72
73
1;
74
75
=head1 AUTHOR
76
77
Koha Development Team <http://koha-community.org/>
78
79
=cut
(-)a/C4/ClassSplitRoutine/Generic.pm (+72 lines)
Line 0 Link Here
1
package C4::ClassSplitRoutine::Generic;
2
3
# Copyright 2018 Koha Development Team
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
22
use C4::Debug;
23
24
=head1 NAME
25
26
C4::ClassSplitRoutine::Generic - generic call number sorting key routine
27
28
=head1 SYNOPSIS
29
30
use C4::ClassSplitRoutine;
31
32
=head1 FUNCTIONS
33
34
35
=head2 split_callnumber
36
37
  my $cn_split = C4::ClassSplitRoutine::Generic::split_callnumber($cn_item);
38
39
  NOTE: Custom call number types go here. It may be necessary to create additional
40
  splitting algorithms if some custom call numbers cannot be made to work here.
41
  Presently this splits standard non-ddcn, non-lccn fiction and biography call numbers.
42
43
=cut
44
45
sub split_callnumber {
46
    my ($cn_item) = @_;
47
48
    my @lines;
49
50
    # Split call numbers based on spaces
51
    push @lines, split /\s+/, $cn_item
52
      ;    # split the call number into an arbitrary number of pieces at spaces
53
    if ( $lines[-1] !~ /^.*\d-\d.*$/ && $lines[-1] =~ /^(.*\d+)(\D.*)$/ ) {
54
        pop @lines;    # pull off the matching last element
55
        push @lines, $1, $2;    # replace it with the two pieces
56
    }
57
    unless ( scalar @lines ) {
58
        warn sprintf( 'regexp failed to match string: %s', $cn_item );
59
        push( @lines, $cn_item );
60
    }
61
    $debug and print STDERR "split_ccn array: ", join( " | ", @lines ), "\n";
62
63
    return @lines;
64
}
65
66
1;
67
68
=head1 AUTHOR
69
70
Koha Development Team <http://koha-community.org/>
71
72
=cut
(-)a/C4/ClassSplitRoutine/LCC.pm (+63 lines)
Line 0 Link Here
1
package C4::ClassSplitRoutine::LCC;
2
3
# Copyright 2018 Koha Development Team
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
use Library::CallNumber::LC;
22
23
use C4::Debug;
24
25
=head1 NAME
26
27
C4::ClassSplitRoutine::LCC - LCC call number split method
28
29
=head1 SYNOPSIS
30
31
use C4::ClassSplitRoutine;
32
33
my $cn_split = C4::ClassSplitRoutine::LCC::split_callnumber($cn_item);
34
35
=head1 FUNCTIONS
36
37
=head2 split_callnumber
38
39
  my $cn_split = C4::ClassSplitRoutine::LCC::split_callnumber($cn_item);
40
41
=cut
42
43
sub split_callnumber {
44
    my ($cn_item) = @_;
45
    # lccn examples: 'HE8700.7 .P6T44 1983', 'BS2545.E8 H39 1996';
46
    my @lines = Library::CallNumber::LC->new($cn_item)->components();
47
    unless (scalar @lines && defined $lines[0])  {
48
        $debug and warn sprintf('regexp failed to match string: %s', $cn_item);
49
        @lines = $cn_item;     # if no match, just use the whole string.
50
    }
51
    my $LastPiece = pop @lines;
52
    push @lines, split /\s+/, $LastPiece if $LastPiece;   # split the last piece into an arbitrary number of pieces at spaces
53
    $debug and warn "split LCC array: ", join(" | ", @lines), "\n";
54
    return @lines;
55
}
56
57
1;
58
59
=head1 AUTHOR
60
61
Koha Development Team <http://koha-community.org/>
62
63
=cut
(-)a/C4/ClassSplitRoutine/RegEx.pm (+59 lines)
Line 0 Link Here
1
package C4::ClassSplitRoutine::RegEx;
2
3
# Copyright 2018 Koha Development Team
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
22
use C4::Debug;
23
24
=head1 NAME
25
26
C4::ClassSplitRoutine::RegEx - regex call number sorting key routine
27
28
=head1 SYNOPSIS
29
30
use C4::ClassSplitRoutine;
31
32
my $cn_sort = C4::ClassSplitRoutine::RegEx::split_callnumber($cn_item, $regexs);
33
34
=head1 FUNCTIONS
35
36
=head2 split_callnumber
37
38
  my $cn_split = C4::ClassSplitRoutine::RegEx::split_callnumber($cn_item, $regexs);
39
40
=cut
41
42
sub split_callnumber {
43
    my ($cn_item, $regexs) = @_;
44
45
    for my $regex ( @$regexs ) {
46
        eval "\$cn_item =~ $regex";
47
    }
48
    my @lines = split "\n", $cn_item;
49
50
    return @lines;
51
}
52
53
1;
54
55
=head1 AUTHOR
56
57
Koha Development Team <http://koha-community.org/>
58
59
=cut
(-)a/C4/Labels/Label.pm (-73 / +27 lines)
Lines 7-21 use Text::Wrap; Link Here
7
use Algorithm::CheckDigits;
7
use Algorithm::CheckDigits;
8
use Text::CSV_XS;
8
use Text::CSV_XS;
9
use Data::Dumper;
9
use Data::Dumper;
10
use Library::CallNumber::LC;
11
use Text::Bidi qw( log2vis );
10
use Text::Bidi qw( log2vis );
12
11
13
use C4::Context;
12
use C4::Context;
14
use C4::Debug;
13
use C4::Debug;
15
use C4::Biblio;
14
use C4::Biblio;
16
15
use Koha::ClassSources;
17
16
use Koha::ClassSortRules;
18
my $possible_decimal = qr/\d{3,}(?:\.\d+)?/; # at least three digits for a DDCN
17
use Koha::ClassSplitRules;
18
use C4::ClassSplitRoutine::Dewey;
19
use C4::ClassSplitRoutine::LCC;
20
use C4::ClassSplitRoutine::Generic;
21
use C4::ClassSplitRoutine::RegEx;
19
22
20
sub _check_params {
23
sub _check_params {
21
    my $given_params = {};
24
    my $given_params = {};
Lines 121-187 sub _get_text_fields { Link Here
121
    return \@sorted_fields;
124
    return \@sorted_fields;
122
}
125
}
123
126
124
125
sub _split_lccn {
126
    my ($lccn) = @_;
127
    $_ = $lccn;
128
    # lccn examples: 'HE8700.7 .P6T44 1983', 'BS2545.E8 H39 1996';
129
    my @parts = Library::CallNumber::LC->new($lccn)->components();
130
    unless (scalar @parts && defined $parts[0])  {
131
        $debug and warn sprintf('regexp failed to match string: %s', $_);
132
        @parts = $_;     # if no match, just use the whole string.
133
    }
134
    my $LastPiece = pop @parts;
135
    push @parts, split /\s+/, $LastPiece if $LastPiece;   # split the last piece into an arbitrary number of pieces at spaces
136
    $debug and warn "split_lccn array: ", join(" | ", @parts), "\n";
137
    return @parts;
138
}
139
140
sub _split_ddcn {
141
    my ($ddcn) = @_;
142
    $_ = $ddcn;
143
    s/\///g;   # in theory we should be able to simply remove all segmentation markers and arrive at the correct call number...
144
    my (@parts) = m/
145
        ^([-a-zA-Z]*\s?(?:$possible_decimal)?) # R220.3  CD-ROM 787.87 # will require extra splitting
146
        \s+
147
        (.+)                               # H2793Z H32 c.2 EAS # everything else (except bracketing spaces)
148
        \s*
149
        /x;
150
    unless (scalar @parts)  {
151
        warn sprintf('regexp failed to match string: %s', $_);
152
        push @parts, $_;     # if no match, just push the whole string.
153
    }
154
155
    if ($parts[0] =~ /^([-a-zA-Z]+)\s?($possible_decimal)$/) {
156
          shift @parts;         # pull off the mathching first element, like example 1
157
        unshift @parts, $1, $2; # replace it with the two pieces
158
    }
159
160
    push @parts, split /\s+/, pop @parts;   # split the last piece into an arbitrary number of pieces at spaces
161
    $debug and print STDERR "split_ddcn array: ", join(" | ", @parts), "\n";
162
    return @parts;
163
}
164
165
## NOTE: Custom call number types go here. It may be necessary to create additional splitting algorithms if some custom call numbers
166
##      cannot be made to work here. Presently this splits standard non-ddcn, non-lccn fiction and biography call numbers.
167
168
sub _split_ccn {
169
    my ($fcn) = @_;
170
    my @parts = ();
171
    # Split call numbers based on spaces
172
    push @parts, split /\s+/, $fcn;   # split the call number into an arbitrary number of pieces at spaces
173
    if ($parts[-1] !~ /^.*\d-\d.*$/ && $parts[-1] =~ /^(.*\d+)(\D.*)$/) {
174
        pop @parts;            # pull off the matching last element
175
        push @parts, $1, $2;    # replace it with the two pieces
176
    }
177
    unless (scalar @parts) {
178
        warn sprintf('regexp failed to match string: %s', $_);
179
        push (@parts, $_);
180
    }
181
    $debug and print STDERR "split_ccn array: ", join(" | ", @parts), "\n";
182
    return @parts;
183
}
184
185
sub _get_barcode_data {
127
sub _get_barcode_data {
186
    my ( $f, $item, $record ) = @_;
128
    my ( $f, $item, $record ) = @_;
187
    my $kohatables = _desc_koha_tables();
129
    my $kohatables = _desc_koha_tables();
Lines 400-405 sub draw_label_text { Link Here
400
    # FIXME - returns all items, so you can't get data from an embedded holdings field.
342
    # FIXME - returns all items, so you can't get data from an embedded holdings field.
401
    # TODO - add a GetMarcBiblio1item(bibnum,itemnum) or a GetMarcItem(itemnum).
343
    # TODO - add a GetMarcBiblio1item(bibnum,itemnum) or a GetMarcItem(itemnum).
402
    my $cn_source = ($item->{'cn_source'} ? $item->{'cn_source'} : C4::Context->preference('DefaultClassificationSource'));
344
    my $cn_source = ($item->{'cn_source'} ? $item->{'cn_source'} : C4::Context->preference('DefaultClassificationSource'));
345
    my $class_source = Koha::ClassSources->find( $cn_source );
346
    my ( $split_routine, $regexs );
347
    if ($class_source) {
348
        my $class_split_rule = Koha::ClassSplitRules->find( $class_source->class_split_rule );
349
        $split_routine = $class_split_rule->split_routine;
350
        $regexs        = $class_split_rule->regexs;
351
    }
352
    else { $split_routine = $cn_source }
403
    LABEL_FIELDS:       # process data for requested fields on current label
353
    LABEL_FIELDS:       # process data for requested fields on current label
404
    for my $field (@$label_fields) {
354
    for my $field (@$label_fields) {
405
        if ($field->{'code'} eq 'itemtype') {
355
        if ($field->{'code'} eq 'itemtype') {
Lines 429-442 sub draw_label_text { Link Here
429
        # Fields which hold call number data  FIXME: ( 060? 090? 092? 099? )
379
        # Fields which hold call number data  FIXME: ( 060? 090? 092? 099? )
430
        my @callnumber_list = qw(itemcallnumber 050a 050b 082a 952o 995k);
380
        my @callnumber_list = qw(itemcallnumber 050a 050b 082a 952o 995k);
431
        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
381
        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
432
            if ($cn_source eq 'lcc' || $cn_source eq 'nlm') { # NLM and LCC should be split the same way
382
            if ($split_routine eq 'LCC' || $split_routine eq 'nlm') { # NLM and LCC should be split the same way
433
                @label_lines = _split_lccn($field_data);
383
                @label_lines = C4::ClassSplitRoutine::LCC::split_callnumber($field_data);
434
                @label_lines = _split_ccn($field_data) if !@label_lines;    # If it was not a true lccn, try it as a custom call number
384
                @label_lines = C4::ClassSplitRoutine::Generic::split_callnumber($field_data) unless @label_lines; # If it was not a true lccn, try it as a custom call number
435
                push (@label_lines, $field_data) if !@label_lines;         # If it was not that, send it on unsplit
385
                push (@label_lines, $field_data) unless @label_lines;         # If it was not that, send it on unsplit
436
            } elsif ($cn_source eq 'ddc') {
386
            } elsif ($split_routine eq 'Dewey') {
437
                @label_lines = _split_ddcn($field_data);
387
                @label_lines = C4::ClassSplitRoutine::Dewey::split_callnumber($field_data);
438
                @label_lines = _split_ccn($field_data) if !@label_lines;
388
                @label_lines = C4::ClassSplitRoutine::Generic::split_callnumber($field_data) unless @label_lines;
439
                push (@label_lines, $field_data) if !@label_lines;
389
                push (@label_lines, $field_data) unless @label_lines;
390
            } elsif ($split_routine eq 'RegEx' ) {
391
                @label_lines = C4::ClassSplitRoutine::RegEx::split_callnumber($field_data, $regexs);
392
                @label_lines = C4::ClassSplitRoutine::Generic::split_callnumber($field_data) unless @label_lines;
393
                push (@label_lines, $field_data) unless @label_lines;
440
            } else {
394
            } else {
441
                warn sprintf('Call number splitting failed for: %s. Please add this call number to bug #2500 at bugs.koha-community.org', $field_data);
395
                warn sprintf('Call number splitting failed for: %s. Please add this call number to bug #2500 at bugs.koha-community.org', $field_data);
442
                push @label_lines, $field_data;
396
                push @label_lines, $field_data;
(-)a/Koha/ClassSplitRule.pm (+78 lines)
Line 0 Link Here
1
package Koha::ClassSplitRule;
2
3
# This file is part of Koha.
4
#
5
# Koha is free software; you can redistribute it and/or modify it under the
6
# terms of the GNU General Public License as published by the Free Software
7
# Foundation; either version 3 of the License, or (at your option) any later
8
# version.
9
#
10
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
11
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13
#
14
# You should have received a copy of the GNU General Public License along
15
# with Koha; if not, write to the Free Software Foundation, Inc.,
16
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
17
18
use Modern::Perl;
19
20
use JSON qw(to_json from_json);
21
22
use Koha::Database;
23
24
use base qw(Koha::Object);
25
26
=head1 NAME
27
28
Koha::ClassSplitRule Koha Classfication Spliting Rule Object class
29
30
=head1 API
31
32
=head2 Class Methods
33
34
=cut
35
36
=head3 new
37
38
Accept 'regexs' as a valid attribute.
39
It should be an arrayref that will be serialized in JSON before stored in DB.
40
41
=cut
42
43
sub new {
44
    my ($class, $attributes) = @_;
45
46
    if ( exists $attributes->{regexs} ) {
47
        $attributes->{split_regex} = to_json($attributes->{regexs});
48
        delete $attributes->{regexs};
49
    }
50
    return $class->SUPER::new($attributes);
51
}
52
53
=head3 regexs
54
55
my $regexs = $rule->regexs
56
57
$rule->regex(\@regexs);
58
59
Getter or setter for split_regex
60
61
=cut
62
63
sub regexs {
64
    my ( $self, $regexs ) = @_;
65
    return $regexs
66
      ? $self->split_regex( to_json($regexs) )
67
      : from_json( $self->split_regex );
68
}
69
70
=head3 type
71
72
=cut
73
74
sub _type {
75
    return 'ClassSplitRule';
76
}
77
78
1;
(-)a/Koha/ClassSplitRules.pm (+56 lines)
Line 0 Link Here
1
package Koha::ClassSplitRules;
2
3
# This file is part of Koha.
4
#
5
# Koha is free software; you can redistribute it and/or modify it under the
6
# terms of the GNU General Public License as published by the Free Software
7
# Foundation; either version 3 of the License, or (at your option) any later
8
# version.
9
#
10
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
11
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13
#
14
# You should have received a copy of the GNU General Public License along
15
# with Koha; if not, write to the Free Software Foundation, Inc.,
16
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
17
18
use Modern::Perl;
19
20
use Koha::Database;
21
22
use Koha::ClassSplitRule;
23
24
use base qw(Koha::Objects);
25
26
=head1 NAME
27
28
Koha::ClassSplitRules - Koha Classification Split Rules Object set class
29
30
=head1 API
31
32
=head2 Class Methods
33
34
=cut
35
36
=head3 _type
37
38
Returns name of corresponding DBIC resultset
39
40
=cut
41
42
sub _type {
43
    return 'ClassSplitRule';
44
}
45
46
=head3 object_class
47
48
Returns name of corresponding Koha object class
49
50
=cut
51
52
sub object_class {
53
    return 'Koha::ClassSplitRule';
54
}
55
56
1;
(-)a/admin/classsources.pl (-12 / +11 lines)
Lines 27-32 use C4::Output; Link Here
27
use C4::Koha;
27
use C4::Koha;
28
use C4::ClassSource;
28
use C4::ClassSource;
29
use C4::ClassSortRoutine;
29
use C4::ClassSortRoutine;
30
use C4::ClassSplitRoutine;
30
use Koha::ClassSources;
31
use Koha::ClassSources;
31
use Koha::ClassSortRules;
32
use Koha::ClassSortRules;
32
use Koha::ClassSplitRules;
33
use Koha::ClassSplitRules;
Lines 40-46 my $class_sort_rule = $input->param('class_sort_rule'); Link Here
40
my $class_split_rule = $input->param('class_split_rule');
41
my $class_split_rule = $input->param('class_split_rule');
41
my $sort_routine     = $input->param('sort_routine');
42
my $sort_routine     = $input->param('sort_routine');
42
my $split_routine    = $input->param('split_routine');
43
my $split_routine    = $input->param('split_routine');
43
my $split_regex      = $input->param('split_regex');
44
my @split_regex      = $input->multi_param('split_regex');
44
my $description      = $input->param('description');
45
my $description      = $input->param('description');
45
my $used             = $input->param('used');
46
my $used             = $input->param('used');
46
47
Lines 194-209 elsif ( $op eq "add_split_rule" ) { Link Here
194
}
195
}
195
elsif ( $op eq "add_split_rule_validate" ) {
196
elsif ( $op eq "add_split_rule_validate" ) {
196
    my $split_rule = Koha::ClassSplitRules->find($class_split_rule);
197
    my $split_rule = Koha::ClassSplitRules->find($class_split_rule);
198
199
    @split_regex =  grep {!/^$/} @split_regex; # Remove empty
197
    if ($split_rule) {
200
    if ($split_rule) {
198
        $split_rule->set(
201
        $split_rule->set(
199
            {
202
            {
200
                description   => $description,
203
                description   => $description,
201
                split_routine => $split_routine,
204
                split_routine => $split_routine,
202
                split_regex =>
203
                  ( $split_routine eq 'RegEx' ? $split_regex : '' ),
204
            }
205
            }
205
        );
206
        );
206
        eval { $split_rule->store; };
207
        eval {
208
            $split_rule->regexs(\@split_regex)
209
                if $split_routine eq 'RegEx';
210
            $split_rule->store;
211
        };
207
        if ($@) {
212
        if ($@) {
208
            push @messages,
213
            push @messages,
209
              { type => 'error', code => 'error_on_update_split_rule' };
214
              { type => 'error', code => 'error_on_update_split_rule' };
Lines 220-227 elsif ( $op eq "add_split_rule_validate" ) { Link Here
220
                class_split_rule => $class_split_rule,
225
                class_split_rule => $class_split_rule,
221
                description      => $description,
226
                description      => $description,
222
                split_routine    => $split_routine,
227
                split_routine    => $split_routine,
223
                split_regex =>
228
                regexs           => \@split_regex,
224
                  ( $split_routine eq 'RegEx' ? $split_regex : '' ),
225
            }
229
            }
226
        );
230
        );
227
        eval { $split_rule->store; };
231
        eval { $split_rule->store; };
Lines 273-283 sub get_class_sort_routines { Link Here
273
}
277
}
274
278
275
sub get_class_split_routines {
279
sub get_class_split_routines {
276
    my @split_routines = qw(
280
    my @split_routines = GetSplitRoutineNames();
277
      Dewey
278
      Generic
279
      LCC
280
      RegEx
281
    );
282
    return \@split_routines;
281
    return \@split_routines;
283
}
282
}
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/admin-home.tt (-1 / +1 lines)
Lines 113-119 Link Here
113
                    [% END %]
113
                    [% END %]
114
                    [% IF ( CAN_user_parameters_manage_classifications ) %]
114
                    [% IF ( CAN_user_parameters_manage_classifications ) %]
115
                        <dt><a href="/cgi-bin/koha/admin/classsources.pl">Classification sources</a></dt>
115
                        <dt><a href="/cgi-bin/koha/admin/classsources.pl">Classification sources</a></dt>
116
                        <dd>Define classification sources (i.e., call number schemes) used by your collection.  Also define filing rules used for sorting call numbers.</dd>
116
                        <dd>Define classification sources (i.e., call number schemes) used by your collection.  Also define filing rules used for sorting call numbers and splitting rules for splitting them.</dd>
117
                    [% END %]
117
                    [% END %]
118
                    [% IF ( CAN_user_parameters_manage_matching_rules ) %]
118
                    [% IF ( CAN_user_parameters_manage_matching_rules ) %]
119
                        <dt><a href="/cgi-bin/koha/admin/matching-rules.pl">Record matching rules</a></dt>
119
                        <dt><a href="/cgi-bin/koha/admin/matching-rules.pl">Record matching rules</a></dt>
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/classsources.tt (-6 / +84 lines)
Lines 16-21 Link Here
16
16
17
</title>
17
</title>
18
[% INCLUDE 'doc-head-close.inc' %]
18
[% INCLUDE 'doc-head-close.inc' %]
19
<style type="text/css">
20
    #button_add,
21
    .split_regex,
22
    .split_callnumber
23
    {
24
        padding-left: 10em;
25
    }
26
</style>
19
</head>
27
</head>
20
28
21
<body id="admin_classsources" class="admin">
29
<body id="admin_classsources" class="admin">
Lines 233-244 Link Here
233
           </select>
241
           </select>
234
           <span class="required">Required</span>
242
           <span class="required">Required</span>
235
       </li>
243
       </li>
236
       <li id="regex_block">
244
        <li id="regex_block">
237
           <label for="split_regex" class="required">Regular expression: </label>
245
            <label for="split_regex" class="required">Regular expression: </label>
238
           <input type="text" name="split_regex" id="split_regex" value="[% split_rule.split_regex | html %]" />
246
            <div>
239
           <span class="required">Required</span>
247
                [% IF split_rule %]
240
       </li>
248
                    [% FOR re IN split_rule.regexs %]
241
249
                        <div class="split_regex">
250
                            <input type="text" name="split_regex" id="split_regex" value="[% re | html %]" />
251
                            <a href="#" title="Delete" class="del_regex"><i class="fa fa-fw fa-trash"></i>Delete</a>
252
                        </div>
253
                    [% END %]
254
                [% ELSE %]
255
                    <div class="split_regex">
256
                        <input type="text" name="split_regex" id="split_regex" value="" />
257
                    </div>
258
                [% END %]
259
            </div>
260
            <div id="button_add">
261
                <a href="#" class="add_regex" title="Add a new regular expression"><i class="fa fa-fw fa-plus"></i> New</a>
262
                <span class="required">Required</span>
263
            </div>
264
            <label for="callnumbers">Test the regular expressions:</label>
265
            <div id="test_split">
266
                <textarea name="callnumbers"></textarea>
267
                <button name="test_split_cns">Test</button>
268
                <div id="result_split_callnumbers"></div>
269
            </div>
270
        </li>
242
    </ol>
271
    </ol>
243
  </fieldset>
272
  </fieldset>
244
    <fieldset class="action">
273
    <fieldset class="action">
Lines 349-354 Link Here
349
                $("#split_regex").removeAttr('required');
378
                $("#split_regex").removeAttr('required');
350
            }
379
            }
351
        };
380
        };
381
        function update_delete_links_visibility() {
382
            if( $("div.split_regex").length > 1 ) {
383
                $("div.split_regex").find('a.del_regex').show();
384
            } else {
385
                $("div.split_regex").find('a.del_regex').hide();
386
            }
387
        }
388
389
        function add_regex() {
390
            var div_node = $("div.split_regex:last");
391
            var div_clone = $(div_node).clone(true);
392
            $(div_clone).find("input").val("");
393
            $(div_node).after(div_clone);
394
            update_delete_links_visibility();
395
        }
396
        function del_regex(a_node) {
397
            $(a_node).parent('div').remove();
398
            update_delete_links_visibility();
399
        }
400
352
        $(document).ready(function(){
401
        $(document).ready(function(){
353
            update_regex_block();
402
            update_regex_block();
354
            $("#split_routine").on("change", function(){
403
            $("#split_routine").on("change", function(){
Lines 364-369 Link Here
364
            $(".delete_split_rule").on("click", function(e){
413
            $(".delete_split_rule").on("click", function(e){
365
                return confirm(_("Are you sure you want to delete this splitting rule?"));
414
                return confirm(_("Are you sure you want to delete this splitting rule?"));
366
            });
415
            });
416
417
            $(".add_regex").on("click", function(e){
418
                e.preventDefault();
419
                add_regex();
420
            });
421
            $(".del_regex").on("click", function(e){
422
                e.preventDefault();
423
                del_regex(this);
424
            });
425
426
            $("button[name='test_split_cns']").on("click", function(e){
427
                e.preventDefault();
428
                var regexs = [];
429
                $("input[name='split_regex']").each(function(){
430
                    regexs.push($(this).val());
431
                });
432
                var callnumbers = $("textarea[name='callnumbers']").val();
433
                $.getJSON('/cgi-bin/koha/svc/split_callnumbers', {regexs: JSON.stringify(regexs), callnumbers: callnumbers}, function(answer){
434
                    var callnumbers = answer['split_callnumbers'];
435
                    $("#result_split_callnumbers").html('');
436
                    var list_node = $('<ol></ol>');
437
                    $(callnumbers).each(function(){
438
                        var split_cn = this['split'].join('<br/>');
439
                        var li_node = $('<li><label>'+this['inline']+'</label><div class="split_callnumber">'+split_cn+'</div></li>');
440
                        $(list_node).append(li_node);
441
                    });
442
                    $("#result_split_callnumbers").append(list_node);
443
                }).fail(function(){alert("Something went wrong.")});
444
            });
367
        });
445
        });
368
446
369
    </script>
447
    </script>
(-)a/t/Labels.t (-1 / +2 lines)
Lines 20-25 Link Here
20
use strict;
20
use strict;
21
use warnings;
21
use warnings;
22
22
23
use C4::ClassSplitRoutine::LCC;
23
use Test::More tests => 11;
24
use Test::More tests => 11;
24
25
25
BEGIN {
26
BEGIN {
Lines 62-65 Q Link Here
62
63
63
ok(C4::Labels::Label::_get_text_fields(), 'test getting textx fields');
64
ok(C4::Labels::Label::_get_text_fields(), 'test getting textx fields');
64
65
65
is(C4::Labels::Label::_split_lccn(),"0", 'test when _split_lccn is null');
66
is(C4::ClassSplitRoutine::LCC::split_callnumber(),"0", 'test when split LCC is null');
(-)a/t/Labels_split_Regex.t (+38 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
#
3
# This file is part of Koha.
4
#
5
# Koha is free software; you can redistribute it and/or modify it
6
# under the terms of the GNU General Public License as published by
7
# the Free Software Foundation; either version 3 of the License, or
8
# (at your option) any later version.
9
#
10
# Koha is distributed in the hope that it will be useful, but
11
# WITHOUT ANY WARRANTY; without even the implied warranty of
12
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13
# GNU General Public License for more details.
14
#
15
# You should have received a copy of the GNU General Public License
16
# along with Koha; if not, see <http://www.gnu.org/licenses>.
17
18
use Modern::Perl;
19
20
use Test::More tests => 5;
21
use C4::ClassSplitRoutine::RegEx;
22
23
my $callnumbers = {
24
    '830 Han'          => [qw{830 Han}],
25
    '159.9 (091) Gesh' => [qw{159.9 (091) Gesh}],
26
    'J 3 Kin =774'     => ['J 3', 'Kin', '=774'],
27
    '830 Hil =774 4'   => [qw{830 Hil =774 4}],
28
    '830 Las=20 4'     => [qw{830 Las =20 4}],
29
};
30
31
# Split on spaces and before =
32
# If starts with J or K then do not split the first 2 groups
33
my @regexs = ('s/\s/\n/g', 's/(\s?=)/\n=/g', 's/^(J|K)\n/$1 /');
34
foreach my $cn (sort keys %$callnumbers) {
35
    my @parts = C4::ClassSplitRoutine::RegEx::split_callnumber($cn, \@regexs);
36
    my @expected = @{$callnumbers->{$cn}};
37
    is_deeply(\@parts, \@expected);
38
}
(-)a/t/Labels_split_ddcn.t (-2 / +3 lines)
Lines 42-48 BEGIN { Link Here
42
        $test_num += 4;
42
        $test_num += 4;
43
    }
43
    }
44
    plan tests => $test_num;
44
    plan tests => $test_num;
45
    use_ok('C4::Labels::Label');
45
    use_ok('C4::ClassSplitRoutine::Dewey');
46
    use vars qw($ddcns);
46
    use vars qw($ddcns);
47
}
47
}
48
48
Lines 50-56 foreach my $ddcn (sort keys %$ddcns) { Link Here
50
    my (@parts, @expected);
50
    my (@parts, @expected);
51
    ok($ddcn, "ddcn: $ddcn");
51
    ok($ddcn, "ddcn: $ddcn");
52
    ok(@expected = @{$ddcns->{$ddcn}}, "split expected to produce " . scalar(@expected) . " pieces");
52
    ok(@expected = @{$ddcns->{$ddcn}}, "split expected to produce " . scalar(@expected) . " pieces");
53
    ok(@parts = C4::Labels::Label::_split_ddcn($ddcn), "C4::Labels::Label::_split_ddcn($ddcn)");
53
    ok(@parts = C4::ClassSplitRoutine::Dewey::split_callnumber($ddcn), "Dewey::split_callnumber($ddcn)");
54
54
    ok(scalar(@expected) == scalar(@parts), sprintf("%d of %d pieces produced", scalar(@parts), scalar(@expected)));
55
    ok(scalar(@expected) == scalar(@parts), sprintf("%d of %d pieces produced", scalar(@parts), scalar(@expected)));
55
    my $i = 0;
56
    my $i = 0;
56
    foreach my $unit (@expected) {
57
    foreach my $unit (@expected) {
(-)a/t/Labels_split_lccn.t (-2 / +2 lines)
Lines 20-25 Link Here
20
use strict;
20
use strict;
21
use warnings;
21
use warnings;
22
22
23
use C4::ClassSplitRoutine::LCC;
23
use Test::More;
24
use Test::More;
24
25
25
BEGIN {
26
BEGIN {
Lines 52-58 foreach my $lccn (sort keys %$lccns) { Link Here
52
    my (@parts, @expected);
53
    my (@parts, @expected);
53
    ok($lccn, "lccn: $lccn");
54
    ok($lccn, "lccn: $lccn");
54
    ok(@expected = @{$lccns->{$lccn}}, "split expected to produce " . scalar(@expected) . " pieces");
55
    ok(@expected = @{$lccns->{$lccn}}, "split expected to produce " . scalar(@expected) . " pieces");
55
    ok(@parts = C4::Labels::Label::_split_lccn($lccn), "C4::Labels::Label::_split_lccn($lccn)");
56
    ok(@parts = C4::ClassSplitRoutine::LCC::split_callnumber($lccn), "split LCC ($lccn)");
56
    ok(scalar(@expected) == scalar(@parts), sprintf("%d of %d pieces produced", scalar(@parts), scalar(@expected)));
57
    ok(scalar(@expected) == scalar(@parts), sprintf("%d of %d pieces produced", scalar(@parts), scalar(@expected)));
57
    my $i = 0;
58
    my $i = 0;
58
    foreach my $unit (@expected) {
59
    foreach my $unit (@expected) {
59
- 

Return to bug 15836