Attachment #80551 for bug #15836

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




package C4::ClassSplitRoutine;

# Copyright 2018 Koha Development Team
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# Koha is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <http://www.gnu.org/licenses>.

use Modern::Perl;

require Exporter;
use Class::Factory::Util;

use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);


=head1 NAME

C4::ClassSplitRoutine - base object for creation of classification splitting routines

=head1 SYNOPSIS

use C4::ClassSplitRoutine;

=head1 FUNCTIONS

=cut

@ISA    = qw(Exporter);
@EXPORT = qw(
   &GetSplitRoutineNames
);

=head2 GetSplitRoutineNames

  my @routines = GetSplitRoutineNames();

Get names of all modules under C4::ClassSplitRoutine::*.

=cut

sub GetSplitRoutineNames {
    return C4::ClassSplitRoutine->subclasses();
}

1;

=head1 AUTHOR

Koha Development Team <http://koha-community.org/>

=cut




package C4::ClassSplitRoutine::Dewey;

# Copyright 2018 Koha Development Team
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# Koha is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <http://www.gnu.org/licenses>.

use Modern::Perl;

use C4::Debug;

=head1 NAME

C4::ClassSplitRoutine::Dewey - Dewey call number split method

=head1 SYNOPSIS

use C4::ClassSplitRoutine;

my $cn_split = C4::ClassSplitRoutine::Dewey::split_callnumber($cn_item);

=head1 FUNCTIONS

=head2 split_callnumber

  my $cn_split = C4::ClassSplitRoutine::Dewey::split_callnumber($cn_item);

=cut

sub split_callnumber {
    my ($cn_item) = @_;

    my $possible_decimal =
      qr/\d{3,}(?:\.\d+)?/;    # at least three digits for a DDCN

    $cn_item =~ s/\///g
      ; # in theory we should be able to simply remove all segmentation markers and arrive at the correct call number...
    my (@lines) = $cn_item =~ 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 (@lines) {
        warn sprintf( 'regexp failed to match string: %s', $cn_item );
        push @lines, $cn_item;    # if no match, just push the whole string.
    }

    if ( $lines[0] =~ /^([-a-zA-Z]+)\s?($possible_decimal)$/ ) {
        shift @lines;    # pull off the mathching first element, like example 1
        unshift @lines, $1, $2;    # replace it with the two pieces
    }

    push @lines, split /\s+/,
      pop @lines
      ;    # split the last piece into an arbitrary number of pieces at spaces
    $debug and print STDERR "split_ddcn array: ", join( " | ", @lines ), "\n";
    return @lines;
}

1;

=head1 AUTHOR

Koha Development Team <http://koha-community.org/>

=cut




package C4::ClassSplitRoutine::Generic;

# Copyright 2018 Koha Development Team
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# Koha is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <http://www.gnu.org/licenses>.

use Modern::Perl;

use C4::Debug;

=head1 NAME

C4::ClassSplitRoutine::Generic - generic call number sorting key routine

=head1 SYNOPSIS

use C4::ClassSplitRoutine;

=head1 FUNCTIONS


=head2 split_callnumber

  my $cn_split = C4::ClassSplitRoutine::Generic::split_callnumber($cn_item);

  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.

=cut

sub split_callnumber {
    my ($cn_item) = @_;

    my @lines;

    # Split call numbers based on spaces
    push @lines, split /\s+/, $cn_item
      ;    # split the call number into an arbitrary number of pieces at spaces
    if ( $lines[-1] !~ /^.*\d-\d.*$/ && $lines[-1] =~ /^(.*\d+)(\D.*)$/ ) {
        pop @lines;    # pull off the matching last element
        push @lines, $1, $2;    # replace it with the two pieces
    }
    unless ( scalar @lines ) {
        warn sprintf( 'regexp failed to match string: %s', $cn_item );
        push( @lines, $cn_item );
    }
    $debug and print STDERR "split_ccn array: ", join( " | ", @lines ), "\n";

    return @lines;
}

1;

=head1 AUTHOR

Koha Development Team <http://koha-community.org/>

=cut




package C4::ClassSplitRoutine::LCC;

# Copyright 2018 Koha Development Team
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# Koha is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <http://www.gnu.org/licenses>.

use Modern::Perl;
use Library::CallNumber::LC;

use C4::Debug;

=head1 NAME

C4::ClassSplitRoutine::LCC - LCC call number split method

=head1 SYNOPSIS

use C4::ClassSplitRoutine;

my $cn_split = C4::ClassSplitRoutine::LCC::split_callnumber($cn_item);

=head1 FUNCTIONS

=head2 split_callnumber

  my $cn_split = C4::ClassSplitRoutine::LCC::split_callnumber($cn_item);

=cut

sub split_callnumber {
    my ($cn_item) = @_;
    # lccn examples: 'HE8700.7 .P6T44 1983', 'BS2545.E8 H39 1996';
    my @lines = Library::CallNumber::LC->new($cn_item)->components();
    unless (scalar @lines && defined $lines[0])  {
        $debug and warn sprintf('regexp failed to match string: %s', $cn_item);
        @lines = $cn_item;     # if no match, just use the whole string.
    }
    my $LastPiece = pop @lines;
    push @lines, split /\s+/, $LastPiece if $LastPiece;   # split the last piece into an arbitrary number of pieces at spaces
    $debug and warn "split LCC array: ", join(" | ", @lines), "\n";
    return @lines;
}

1;

=head1 AUTHOR

Koha Development Team <http://koha-community.org/>

=cut




package C4::ClassSplitRoutine::RegEx;

# Copyright 2018 Koha Development Team
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# Koha is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <http://www.gnu.org/licenses>.

use Modern::Perl;

use C4::Debug;

=head1 NAME

C4::ClassSplitRoutine::RegEx - regex call number sorting key routine

=head1 SYNOPSIS

use C4::ClassSplitRoutine;

my $cn_sort = C4::ClassSplitRoutine::RegEx::split_callnumber($cn_item, $regexs);

=head1 FUNCTIONS

=head2 split_callnumber

  my $cn_split = C4::ClassSplitRoutine::RegEx::split_callnumber($cn_item, $regexs);

=cut

sub split_callnumber {
    my ($cn_item, $regexs) = @_;

    for my $regex ( @$regexs ) {
        eval "\$cn_item =~ $regex";
    }
    my @lines = split "\n", $cn_item;

    return @lines;
}

1;

=head1 AUTHOR

Koha Development Team <http://koha-community.org/>

=cut




use Algorithm::CheckDigits;
use Text::CSV_XS;
use Data::Dumper;
use Library::CallNumber::LC;
use Text::Bidi qw( log2vis );

use C4::Context;
use C4::Debug;
use C4::Biblio;
use Koha::ClassSources;
use Koha::ClassSortRules;
use Koha::ClassSplitRules;
use C4::ClassSplitRoutine::Dewey;
use C4::ClassSplitRoutine::LCC;
use C4::ClassSplitRoutine::Generic;
use C4::ClassSplitRoutine::RegEx;

sub _check_params {
    my $given_params = {};

    return \@sorted_fields;
}


sub _split_lccn {
    my ($lccn) = @_;
    $_ = $lccn;
    # lccn examples: 'HE8700.7 .P6T44 1983', 'BS2545.E8 H39 1996';
    my @parts = Library::CallNumber::LC->new($lccn)->components();
    unless (scalar @parts && defined $parts[0])  {
        $debug and warn sprintf('regexp failed to match string: %s', $_);
        @parts = $_;     # if no match, just use the whole string.
    }
    my $LastPiece = pop @parts;
    push @parts, split /\s+/, $LastPiece if $LastPiece;   # 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;
}

sub _get_barcode_data {
    my ( $f, $item, $record ) = @_;
    my $kohatables = _desc_koha_tables();

    # FIXME - returns all items, so you can't get data from an embedded holdings field.
    # TODO - add a GetMarcBiblio1item(bibnum,itemnum) or a GetMarcItem(itemnum).
    my $cn_source = ($item->{'cn_source'} ? $item->{'cn_source'} : C4::Context->preference('DefaultClassificationSource'));
    my $class_source = Koha::ClassSources->find( $cn_source );
    my ( $split_routine, $regexs );
    if ($class_source) {
        my $class_split_rule = Koha::ClassSplitRules->find( $class_source->class_split_rule );
        $split_routine = $class_split_rule->split_routine;
        $regexs        = $class_split_rule->regexs;
    }
    else { $split_routine = $cn_source }
    LABEL_FIELDS:       # process data for requested fields on current label
    for my $field (@$label_fields) {
        if ($field->{'code'} eq 'itemtype') {

        # Fields which hold call number data  FIXME: ( 060? 090? 092? 099? )
        my @callnumber_list = qw(itemcallnumber 050a 050b 082a 952o 995k);
        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
            if ($split_routine eq 'LCC' || $split_routine eq 'nlm') { # NLM and LCC should be split the same way
                @label_lines = C4::ClassSplitRoutine::LCC::split_callnumber($field_data);
                @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
                push (@label_lines, $field_data) unless @label_lines;         # If it was not that, send it on unsplit
            } elsif ($split_routine eq 'Dewey') {
                @label_lines = C4::ClassSplitRoutine::Dewey::split_callnumber($field_data);
                @label_lines = C4::ClassSplitRoutine::Generic::split_callnumber($field_data) unless @label_lines;
                push (@label_lines, $field_data) unless @label_lines;
            } elsif ($split_routine eq 'RegEx' ) {
                @label_lines = C4::ClassSplitRoutine::RegEx::split_callnumber($field_data, $regexs);
                @label_lines = C4::ClassSplitRoutine::Generic::split_callnumber($field_data) unless @label_lines;
                push (@label_lines, $field_data) unless @label_lines;
            } else {
                warn sprintf('Call number splitting failed for: %s. Please add this call number to bug #2500 at bugs.koha-community.org', $field_data);
                push @label_lines, $field_data;




package Koha::ClassSplitRule;

# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 3 of the License, or (at your option) any later
# version.
#
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with Koha; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

use Modern::Perl;

use JSON qw(to_json from_json);

use Koha::Database;

use base qw(Koha::Object);

=head1 NAME

Koha::ClassSplitRule Koha Classfication Spliting Rule Object class

=head1 API

=head2 Class Methods

=cut

=head3 new

Accept 'regexs' as a valid attribute.
It should be an arrayref that will be serialized in JSON before stored in DB.

=cut

sub new {
    my ($class, $attributes) = @_;

    if ( exists $attributes->{regexs} ) {
        $attributes->{split_regex} = to_json($attributes->{regexs});
        delete $attributes->{regexs};
    }
    return $class->SUPER::new($attributes);
}

=head3 regexs

my $regexs = $rule->regexs

$rule->regex(\@regexs);

Getter or setter for split_regex

=cut

sub regexs {
    my ( $self, $regexs ) = @_;
    return $regexs
      ? $self->split_regex( to_json($regexs) )
      : from_json( $self->split_regex );
}

=head3 type

=cut

sub _type {
    return 'ClassSplitRule';
}

1;




package Koha::ClassSplitRules;

# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 3 of the License, or (at your option) any later
# version.
#
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with Koha; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

use Modern::Perl;

use Koha::Database;

use Koha::ClassSplitRule;

use base qw(Koha::Objects);

=head1 NAME

Koha::ClassSplitRules - Koha Classification Split Rules Object set class

=head1 API

=head2 Class Methods

=cut

=head3 _type

Returns name of corresponding DBIC resultset

=cut

sub _type {
    return 'ClassSplitRule';
}

=head3 object_class

Returns name of corresponding Koha object class

=cut

sub object_class {
    return 'Koha::ClassSplitRule';
}

1;

Lines 27-32 use C4::Output; Link Here

(-)a/admin/classsources.pl (-12 / +11 lines)
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	}

Lines 113-119 Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/admin-home.tt (-1 / +1 lines)
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>

Lines 16-21 Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/classsources.tt (-6 / +84 lines)
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>

Lines 20-25 Link Here

(-)a/t/Labels.t (-1 / +2 lines)
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');




#!/usr/bin/perl
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# Koha is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <http://www.gnu.org/licenses>.

use Modern::Perl;

use Test::More tests => 5;
use C4::ClassSplitRoutine::RegEx;

my $callnumbers = {
    '830 Han'          => [qw{830 Han}],
    '159.9 (091) Gesh' => [qw{159.9 (091) Gesh}],
    'J 3 Kin =774'     => ['J 3', 'Kin', '=774'],
    '830 Hil =774 4'   => [qw{830 Hil =774 4}],
    '830 Las=20 4'     => [qw{830 Las =20 4}],
};

# Split on spaces and before =
# If starts with J or K then do not split the first 2 groups
my @regexs = ('s/\s/\n/g', 's/(\s?=)/\n=/g', 's/^(J|K)\n/$1 /');
foreach my $cn (sort keys %$callnumbers) {
    my @parts = C4::ClassSplitRoutine::RegEx::split_callnumber($cn, \@regexs);
    my @expected = @{$callnumbers->{$cn}};
    is_deeply(\@parts, \@expected);
}

Lines 42-48 BEGIN { Link Here

(-)a/t/Labels_split_ddcn.t (-2 / +3 lines)
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) {

Lines 20-25 Link Here

(-)a/t/Labels_split_lccn.t (-2 / +2 lines)
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

Line 0 Link Here

(-)a/C4/ClassSplitRoutine.pm (+63 lines)
	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

Line 0 Link Here

(-)a/C4/ClassSplitRoutine/Dewey.pm (+79 lines)
		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

Line 0 Link Here

(-)a/C4/ClassSplitRoutine/Generic.pm (+72 lines)
		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

Line 0 Link Here

(-)a/C4/ClassSplitRoutine/LCC.pm (+63 lines)
	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

Line 0 Link Here

(-)a/C4/ClassSplitRoutine/RegEx.pm (+59 lines)
	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

Lines 7-21 use Text::Wrap; Link Here

(-)a/C4/Labels/Label.pm (-73 / +27 lines)
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;

Line 0 Link Here

(-)a/Koha/ClassSplitRule.pm (+78 lines)
		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;

Line 0 Link Here

(-)a/Koha/ClassSplitRules.pm (+56 lines)
	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;

Line 0 Link Here

(-)a/t/Labels_split_Regex.t (+38 lines)
	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	}