help.pl - bugfix module usage (HTML::Template::Pro)
[koha.git] / C4 / ClassSortRoutine.pm
1 package 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 with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA  02111-1307 USA
19
20 use strict;
21 require Exporter;
22 use Class::Factory::Util;
23 use C4::Context;
24 use C4::Koha;
25
26 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
27
28 # set the version for version checking
29 $VERSION = 3.00;
30
31 =head1 NAME 
32
33 C4::ClassSortRoutine - base object for creation of classification sorting
34                        key generation routines
35
36 =head1 SYNOPSIS
37
38 use C4::ClassSortRoutine;
39
40 =head1 FUNCTIONS
41
42 =cut
43
44 @ISA    = qw(Exporter);
45 @EXPORT = qw(
46    &GetSortRoutineNames
47    &GetClassSortKey
48 );
49
50 # intialization code
51 my %loaded_routines = ();
52 my @sort_routines = GetSortRoutineNames();
53 foreach my $sort_routine (@sort_routines) {
54     if (eval "require C4::ClassSortRoutine::$sort_routine") {
55         my $ref;
56         eval "\$ref = \\\&C4::ClassSortRoutine::${sort_routine}::get_class_sort_key";
57         if (eval "\$ref->(\"a\", \"b\")") {
58             $loaded_routines{$sort_routine} = $ref;
59         } else {
60             $loaded_routines{$sort_routine} = \&_get_class_sort_key;
61         }
62     } else {
63         $loaded_routines{$sort_routine} = \&_get_class_sort_key;
64     }
65 }
66
67 =head2 GetSortRoutineNames
68
69   my @routines = GetSortRoutineNames();
70
71 Get names of all modules under C4::ClassSortRoutine::*.  Adding
72 a new classification sorting routine can therefore be done 
73 simply by writing a new submodule under C4::ClassSortRoutine and
74 placing it in the C4/ClassSortRoutine directory.
75
76 =cut
77
78 sub GetSortRoutineNames {
79     return C4::ClassSortRoutine->subclasses();
80 }
81
82 =head2  GetClassSortKey
83
84   my $cn_sort = GetClassSortKey($sort_routine, $cn_class, $cn_item);
85
86 Generates classification sorting key.  If $sort_routine does not point
87 to a valid submodule in C4::ClassSortRoutine, default to a basic
88 normalization routine.
89
90 =cut
91
92 sub GetClassSortKey {
93     my ($sort_routine, $cn_class, $cn_item) = @_;
94     unless (exists $loaded_routines{$sort_routine}) {
95         warn "attempting to use non-existent class sorting routine $sort_routine\n";
96         $loaded_routines{$sort_routine} = \&_get_class_sort_key;
97     }
98     my $key = $loaded_routines{$sort_routine}->($cn_class, $cn_item);
99     # FIXME -- hardcoded length for cn_sort
100     # should replace with some way of getting column widths from
101     # the DB schema -- since doing this should ideally be
102     # independent of the DBMS, deferring for the moment.
103     return substr($key, 0, 30);
104 }
105
106 =head2 _get_class_sort_key 
107
108 Basic sorting function.  Concatenates classification part 
109 and item, converts to uppercase, changes each run of
110 whitespace to '_', and removes any non-digit, non-latin
111 letter characters.
112
113 =cut
114
115 sub _get_class_sort_key {
116     my ($cn_class, $cn_item) = @_;
117     my $key = uc "$cn_class $cn_item";
118     $key =~ s/\s+/_/;
119     $key =~ s/[^A-Z_0-9]//g;
120     return $key;
121 }
122
123 1;
124
125 =head1 AUTHOR
126
127 Koha Developement team <info@koha.org>
128
129 =cut
130