File Coverage

File:C4/ClassSortRoutine.pm
Coverage:59.5%

linestmtbrancondsubtimecode
1package C4::ClassSortRoutine;
2
3# Copyright (C) 2007 LibLime
4#
5# This file is part of Koha.
6#
7# Koha is free software; you can redistribute it and/or modify it under the
8# terms of the GNU General Public License as published by the Free Software
9# Foundation; either version 2 of the License, or (at your option) any later
10# version.
11#
12# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License along
17# with Koha; if not, write to the Free Software Foundation, Inc.,
18# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
23
23
23
23
18061
106
896
use strict;
21
23
23
23
23
176
251
1360
use warnings;
22
23require Exporter;
24
23
23
23
23
33613
16625
374
use Class::Factory::Util;
25
23
23
23
23
1244
126
370
use C4::Context;
26
27
23
23
23
23
359
100
10401
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
28
29# set the version for version checking
30$VERSION = 3.00;
31
32 - 43
=head1 NAME 

C4::ClassSortRoutine - base object for creation of classification sorting
                       key generation routines

=head1 SYNOPSIS

use C4::ClassSortRoutine;

=head1 FUNCTIONS

=cut
44
45@ISA = qw(Exporter);
46@EXPORT = qw(
47   &GetSortRoutineNames
48   &GetClassSortKey
49);
50
51# intialization code
52my %loaded_routines = ();
53my @sort_routines = GetSortRoutineNames();
54foreach my $sort_routine (@sort_routines) {
55    if (eval "require C4::ClassSortRoutine::$sort_routine") {
56        my $ref;
57        eval "\$ref = \\\&C4::ClassSortRoutine::${sort_routine}::get_class_sort_key";
58        if (eval "\$ref->(\"a\", \"b\")") {
59            $loaded_routines{$sort_routine} = $ref;
60        } else {
61            $loaded_routines{$sort_routine} = \&_get_class_sort_key;
62        }
63    } else {
64        $loaded_routines{$sort_routine} = \&_get_class_sort_key;
65    }
66}
67
68 - 77
=head2 GetSortRoutineNames

  my @routines = GetSortRoutineNames();

Get names of all modules under C4::ClassSortRoutine::*.  Adding
a new classification sorting routine can therefore be done 
simply by writing a new submodule under C4::ClassSortRoutine and
placing it in the C4/ClassSortRoutine directory.

=cut
78
79sub GetSortRoutineNames {
80
23
23
337
    return C4::ClassSortRoutine->subclasses();
81}
82
83 - 91
=head2  GetClassSortKey

  my $cn_sort = GetClassSortKey($sort_routine, $cn_class, $cn_item);

Generates classification sorting key.  If $sort_routine does not point
to a valid submodule in C4::ClassSortRoutine, default to a basic
normalization routine.

=cut
92
93sub GetClassSortKey {
94
0
0
    my ($sort_routine, $cn_class, $cn_item) = @_;
95
0
0
    unless (exists $loaded_routines{$sort_routine}) {
96
0
        warn "attempting to use non-existent class sorting routine $sort_routine\n";
97
0
        $loaded_routines{$sort_routine} = \&_get_class_sort_key;
98    }
99
0
    my $key = $loaded_routines{$sort_routine}->($cn_class, $cn_item);
100    # FIXME -- hardcoded length for cn_sort
101    # should replace with some way of getting column widths from
102    # the DB schema -- since doing this should ideally be
103    # independent of the DBMS, deferring for the moment.
104
0
    return substr($key, 0, 30);
105}
106
107 - 114
=head2 _get_class_sort_key 

Basic sorting function.  Concatenates classification part 
and item, converts to uppercase, changes each run of
whitespace to '_', and removes any non-digit, non-latin
letter characters.

=cut
115
116sub _get_class_sort_key {
117
0
0
    my ($cn_class, $cn_item) = @_;
118
0
    my $key = uc "$cn_class $cn_item";
119
0
    $key =~ s/\s+/_/;
120
0
    $key =~ s/[^A-Z_0-9]//g;
121
0
    return $key;
122}
123
1241;
125
126 - 130
=head1 AUTHOR

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

=cut
131