Bug 9174 follow-up: Eliminate warning and fix POD
[koha.git] / C4 / Koha.pm
1 package C4::Koha;
2
3 # Copyright 2000-2002 Katipo Communications
4 # Parts Copyright 2010 Nelsonville Public Library
5 # Parts copyright 2010 BibLibre
6 #
7 # This file is part of Koha.
8 #
9 # Koha is free software; you can redistribute it and/or modify it under the
10 # terms of the GNU General Public License as published by the Free Software
11 # Foundation; either version 2 of the License, or (at your option) any later
12 # version.
13 #
14 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
15 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
16 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
17 #
18 # You should have received a copy of the GNU General Public License along
19 # with Koha; if not, write to the Free Software Foundation, Inc.,
20 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
21
22
23 use strict;
24 #use warnings; FIXME - Bug 2505
25
26 use C4::Context;
27 use C4::Branch qw(GetBranchesCount);
28 use Memoize;
29 use DateTime;
30 use DateTime::Format::MySQL;
31 use autouse 'Data::Dumper' => qw(Dumper);
32
33 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $DEBUG);
34
35 BEGIN {
36     $VERSION = 3.07.00.049;
37         require Exporter;
38         @ISA    = qw(Exporter);
39         @EXPORT = qw(
40                 &slashifyDate
41                 &subfield_is_koha_internal_p
42                 &GetPrinters &GetPrinter
43                 &GetItemTypes &getitemtypeinfo
44                 &GetCcodes
45                 &GetSupportName &GetSupportList
46                 &get_itemtypeinfos_of
47                 &getframeworks &getframeworkinfo
48                 &getauthtypes &getauthtype
49                 &getallthemes
50                 &getFacets
51                 &displayServers
52                 &getnbpages
53                 &get_infos_of
54                 &get_notforloan_label_of
55                 &getitemtypeimagedir
56                 &getitemtypeimagesrc
57                 &getitemtypeimagelocation
58                 &GetAuthorisedValues
59                 &GetAuthorisedValueCategories
60                 &GetKohaAuthorisedValues
61                 &GetKohaAuthorisedValuesFromField
62     &GetKohaAuthorisedValueLib
63     &GetAuthorisedValueByCode
64     &GetKohaImageurlFromAuthorisedValues
65                 &GetAuthValCode
66                 &GetNormalizedUPC
67                 &GetNormalizedISBN
68                 &GetNormalizedEAN
69                 &GetNormalizedOCLCNumber
70         &xml_escape
71
72                 $DEBUG
73         );
74         $DEBUG = 0;
75 @EXPORT_OK = qw( GetDailyQuote );
76 }
77
78 # expensive functions
79 memoize('GetAuthorisedValues');
80
81 =head1 NAME
82
83 C4::Koha - Perl Module containing convenience functions for Koha scripts
84
85 =head1 SYNOPSIS
86
87 use C4::Koha;
88
89 =head1 DESCRIPTION
90
91 Koha.pm provides many functions for Koha scripts.
92
93 =head1 FUNCTIONS
94
95 =cut
96
97 =head2 slashifyDate
98
99   $slash_date = &slashifyDate($dash_date);
100
101 Takes a string of the form "DD-MM-YYYY" (or anything separated by
102 dashes), converts it to the form "YYYY/MM/DD", and returns the result.
103
104 =cut
105
106 sub slashifyDate {
107
108     # accepts a date of the form xx-xx-xx[xx] and returns it in the
109     # form xx/xx/xx[xx]
110     my @dateOut = split( '-', shift );
111     return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
112 }
113
114 # FIXME.. this should be moved to a MARC-specific module
115 sub subfield_is_koha_internal_p {
116     my ($subfield) = @_;
117
118     # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
119     # But real MARC subfields are always single-character
120     # so it really is safer just to check the length
121
122     return length $subfield != 1;
123 }
124
125 =head2 GetSupportName
126
127   $itemtypename = &GetSupportName($codestring);
128
129 Returns a string with the name of the itemtype.
130
131 =cut
132
133 sub GetSupportName{
134         my ($codestring)=@_;
135         return if (! $codestring); 
136         my $resultstring;
137         my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
138         if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {  
139                 my $query = qq|
140                         SELECT description
141                         FROM   itemtypes
142                         WHERE itemtype=?
143                         order by description
144                 |;
145                 my $sth = C4::Context->dbh->prepare($query);
146                 $sth->execute($codestring);
147                 ($resultstring)=$sth->fetchrow;
148                 return $resultstring;
149         } else {
150         my $sth =
151             C4::Context->dbh->prepare(
152                     "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
153                     );
154         $sth->execute( $advanced_search_types, $codestring );
155         my $data = $sth->fetchrow_hashref;
156         return $$data{'lib'};
157         }
158
159 }
160 =head2 GetSupportList
161
162   $itemtypes = &GetSupportList();
163
164 Returns an array ref containing informations about Support (since itemtype is rather a circulation code when item-level-itypes is used).
165
166 build a HTML select with the following code :
167
168 =head3 in PERL SCRIPT
169
170     my $itemtypes = GetSupportList();
171     $template->param(itemtypeloop => $itemtypes);
172
173 =head3 in TEMPLATE
174
175     <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
176         <select name="itemtype">
177             <option value="">Default</option>
178         <!-- TMPL_LOOP name="itemtypeloop" -->
179             <option value="<!-- TMPL_VAR name="itemtype" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->> <!--TMPL_IF Name="imageurl"--><img alt="<!-- TMPL_VAR name="description" -->" src="<!--TMPL_VAR Name="imageurl"-->><!--TMPL_ELSE-->"<!-- TMPL_VAR name="description" --><!--/TMPL_IF--></option>
180         <!-- /TMPL_LOOP -->
181         </select>
182         <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
183         <input type="submit" value="OK" class="button">
184     </form>
185
186 =cut
187
188 sub GetSupportList{
189         my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
190         if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {  
191                 my $query = qq|
192                         SELECT *
193                         FROM   itemtypes
194                         order by description
195                 |;
196                 my $sth = C4::Context->dbh->prepare($query);
197                 $sth->execute;
198                 return $sth->fetchall_arrayref({});
199         } else {
200                 my $advsearchtypes = GetAuthorisedValues($advanced_search_types);
201                 my @results= map {{itemtype=>$$_{authorised_value},description=>$$_{lib},imageurl=>$$_{imageurl}}} @$advsearchtypes;
202                 return \@results;
203         }
204 }
205 =head2 GetItemTypes
206
207   $itemtypes = &GetItemTypes();
208
209 Returns information about existing itemtypes.
210
211 build a HTML select with the following code :
212
213 =head3 in PERL SCRIPT
214
215     my $itemtypes = GetItemTypes;
216     my @itemtypesloop;
217     foreach my $thisitemtype (sort keys %$itemtypes) {
218         my $selected = 1 if $thisitemtype eq $itemtype;
219         my %row =(value => $thisitemtype,
220                     selected => $selected,
221                     description => $itemtypes->{$thisitemtype}->{'description'},
222                 );
223         push @itemtypesloop, \%row;
224     }
225     $template->param(itemtypeloop => \@itemtypesloop);
226
227 =head3 in TEMPLATE
228
229     <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
230         <select name="itemtype">
231             <option value="">Default</option>
232         <!-- TMPL_LOOP name="itemtypeloop" -->
233             <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
234         <!-- /TMPL_LOOP -->
235         </select>
236         <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
237         <input type="submit" value="OK" class="button">
238     </form>
239
240 =cut
241
242 sub GetItemTypes {
243
244     # returns a reference to a hash of references to itemtypes...
245     my %itemtypes;
246     my $dbh   = C4::Context->dbh;
247     my $query = qq|
248         SELECT *
249         FROM   itemtypes
250     |;
251     my $sth = $dbh->prepare($query);
252     $sth->execute;
253     while ( my $IT = $sth->fetchrow_hashref ) {
254         $itemtypes{ $IT->{'itemtype'} } = $IT;
255     }
256     return ( \%itemtypes );
257 }
258
259 sub get_itemtypeinfos_of {
260     my @itemtypes = @_;
261
262     my $placeholders = join( ', ', map { '?' } @itemtypes );
263     my $query = <<"END_SQL";
264 SELECT itemtype,
265        description,
266        imageurl,
267        notforloan
268   FROM itemtypes
269   WHERE itemtype IN ( $placeholders )
270 END_SQL
271
272     return get_infos_of( $query, 'itemtype', undef, \@itemtypes );
273 }
274
275 # this is temporary until we separate collection codes and item types
276 sub GetCcodes {
277     my $count = 0;
278     my @results;
279     my $dbh = C4::Context->dbh;
280     my $sth =
281       $dbh->prepare(
282         "SELECT * FROM authorised_values ORDER BY authorised_value");
283     $sth->execute;
284     while ( my $data = $sth->fetchrow_hashref ) {
285         if ( $data->{category} eq "CCODE" ) {
286             $count++;
287             $results[$count] = $data;
288
289             #warn "data: $data";
290         }
291     }
292     $sth->finish;
293     return ( $count, @results );
294 }
295
296 =head2 getauthtypes
297
298   $authtypes = &getauthtypes();
299
300 Returns information about existing authtypes.
301
302 build a HTML select with the following code :
303
304 =head3 in PERL SCRIPT
305
306    my $authtypes = getauthtypes;
307    my @authtypesloop;
308    foreach my $thisauthtype (keys %$authtypes) {
309        my $selected = 1 if $thisauthtype eq $authtype;
310        my %row =(value => $thisauthtype,
311                 selected => $selected,
312                 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
313             );
314         push @authtypesloop, \%row;
315     }
316     $template->param(itemtypeloop => \@itemtypesloop);
317
318 =head3 in TEMPLATE
319
320   <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
321     <select name="authtype">
322     <!-- TMPL_LOOP name="authtypeloop" -->
323         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
324     <!-- /TMPL_LOOP -->
325     </select>
326     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
327     <input type="submit" value="OK" class="button">
328   </form>
329
330
331 =cut
332
333 sub getauthtypes {
334
335     # returns a reference to a hash of references to authtypes...
336     my %authtypes;
337     my $dbh = C4::Context->dbh;
338     my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
339     $sth->execute;
340     while ( my $IT = $sth->fetchrow_hashref ) {
341         $authtypes{ $IT->{'authtypecode'} } = $IT;
342     }
343     return ( \%authtypes );
344 }
345
346 sub getauthtype {
347     my ($authtypecode) = @_;
348
349     # returns a reference to a hash of references to authtypes...
350     my %authtypes;
351     my $dbh = C4::Context->dbh;
352     my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
353     $sth->execute($authtypecode);
354     my $res = $sth->fetchrow_hashref;
355     return $res;
356 }
357
358 =head2 getframework
359
360   $frameworks = &getframework();
361
362 Returns information about existing frameworks
363
364 build a HTML select with the following code :
365
366 =head3 in PERL SCRIPT
367
368   my $frameworks = frameworks();
369   my @frameworkloop;
370   foreach my $thisframework (keys %$frameworks) {
371     my $selected = 1 if $thisframework eq $frameworkcode;
372     my %row =(value => $thisframework,
373                 selected => $selected,
374                 description => $frameworks->{$thisframework}->{'frameworktext'},
375             );
376     push @frameworksloop, \%row;
377   }
378   $template->param(frameworkloop => \@frameworksloop);
379
380 =head3 in TEMPLATE
381
382   <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
383     <select name="frameworkcode">
384         <option value="">Default</option>
385     <!-- TMPL_LOOP name="frameworkloop" -->
386         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
387     <!-- /TMPL_LOOP -->
388     </select>
389     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
390     <input type="submit" value="OK" class="button">
391   </form>
392
393 =cut
394
395 sub getframeworks {
396
397     # returns a reference to a hash of references to branches...
398     my %itemtypes;
399     my $dbh = C4::Context->dbh;
400     my $sth = $dbh->prepare("select * from biblio_framework");
401     $sth->execute;
402     while ( my $IT = $sth->fetchrow_hashref ) {
403         $itemtypes{ $IT->{'frameworkcode'} } = $IT;
404     }
405     return ( \%itemtypes );
406 }
407
408 =head2 getframeworkinfo
409
410   $frameworkinfo = &getframeworkinfo($frameworkcode);
411
412 Returns information about an frameworkcode.
413
414 =cut
415
416 sub getframeworkinfo {
417     my ($frameworkcode) = @_;
418     my $dbh             = C4::Context->dbh;
419     my $sth             =
420       $dbh->prepare("select * from biblio_framework where frameworkcode=?");
421     $sth->execute($frameworkcode);
422     my $res = $sth->fetchrow_hashref;
423     return $res;
424 }
425
426 =head2 getitemtypeinfo
427
428   $itemtype = &getitemtypeinfo($itemtype, [$interface]);
429
430 Returns information about an itemtype. The optional $interface argument
431 sets which interface ('opac' or 'intranet') to return the imageurl for.
432 Defaults to intranet.
433
434 =cut
435
436 sub getitemtypeinfo {
437     my ($itemtype, $interface) = @_;
438     my $dbh        = C4::Context->dbh;
439     my $sth        = $dbh->prepare("select * from itemtypes where itemtype=?");
440     $sth->execute($itemtype);
441     my $res = $sth->fetchrow_hashref;
442
443     $res->{imageurl} = getitemtypeimagelocation( ( ( defined $interface && $interface eq 'opac' ) ? 'opac' : 'intranet' ), $res->{imageurl} );
444
445     return $res;
446 }
447
448 =head2 getitemtypeimagedir
449
450   my $directory = getitemtypeimagedir( 'opac' );
451
452 pass in 'opac' or 'intranet'. Defaults to 'opac'.
453
454 returns the full path to the appropriate directory containing images.
455
456 =cut
457
458 sub getitemtypeimagedir {
459         my $src = shift || 'opac';
460         if ($src eq 'intranet') {
461                 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
462         } else {
463                 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
464         }
465 }
466
467 sub getitemtypeimagesrc {
468         my $src = shift || 'opac';
469         if ($src eq 'intranet') {
470                 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
471         } else {
472                 return '/opac-tmpl' . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
473         }
474 }
475
476 sub getitemtypeimagelocation {
477         my ( $src, $image ) = @_;
478
479         return '' if ( !$image );
480     require URI::Split;
481
482         my $scheme = ( URI::Split::uri_split( $image ) )[0];
483
484         return $image if ( $scheme );
485
486         return getitemtypeimagesrc( $src ) . '/' . $image;
487 }
488
489 =head3 _getImagesFromDirectory
490
491 Find all of the image files in a directory in the filesystem
492
493 parameters: a directory name
494
495 returns: a list of images in that directory.
496
497 Notes: this does not traverse into subdirectories. See
498 _getSubdirectoryNames for help with that.
499 Images are assumed to be files with .gif or .png file extensions.
500 The image names returned do not have the directory name on them.
501
502 =cut
503
504 sub _getImagesFromDirectory {
505     my $directoryname = shift;
506     return unless defined $directoryname;
507     return unless -d $directoryname;
508
509     if ( opendir ( my $dh, $directoryname ) ) {
510         my @images = grep { /\.(gif|png)$/i } readdir( $dh );
511         closedir $dh;
512         @images = sort(@images);
513         return @images;
514     } else {
515         warn "unable to opendir $directoryname: $!";
516         return;
517     }
518 }
519
520 =head3 _getSubdirectoryNames
521
522 Find all of the directories in a directory in the filesystem
523
524 parameters: a directory name
525
526 returns: a list of subdirectories in that directory.
527
528 Notes: this does not traverse into subdirectories. Only the first
529 level of subdirectories are returned.
530 The directory names returned don't have the parent directory name on them.
531
532 =cut
533
534 sub _getSubdirectoryNames {
535     my $directoryname = shift;
536     return unless defined $directoryname;
537     return unless -d $directoryname;
538
539     if ( opendir ( my $dh, $directoryname ) ) {
540         my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
541         closedir $dh;
542         return @directories;
543     } else {
544         warn "unable to opendir $directoryname: $!";
545         return;
546     }
547 }
548
549 =head3 getImageSets
550
551 returns: a listref of hashrefs. Each hash represents another collection of images.
552
553  { imagesetname => 'npl', # the name of the image set (npl is the original one)
554          images => listref of image hashrefs
555  }
556
557 each image is represented by a hashref like this:
558
559  { KohaImage     => 'npl/image.gif',
560    StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
561    OpacImageURL  => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
562    checked       => 0 or 1: was this the image passed to this method?
563                     Note: I'd like to remove this somehow.
564  }
565
566 =cut
567
568 sub getImageSets {
569     my %params = @_;
570     my $checked = $params{'checked'} || '';
571
572     my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
573                              url        => getitemtypeimagesrc('intranet'),
574                         },
575                   opac => { filesystem => getitemtypeimagedir('opac'),
576                              url       => getitemtypeimagesrc('opac'),
577                         }
578                   };
579
580     my @imagesets = (); # list of hasrefs of image set data to pass to template
581     my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
582     foreach my $imagesubdir ( @subdirectories ) {
583     warn $imagesubdir if $DEBUG;
584         my @imagelist     = (); # hashrefs of image info
585         my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
586         my $imagesetactive = 0;
587         foreach my $thisimage ( @imagenames ) {
588             push( @imagelist,
589                   { KohaImage     => "$imagesubdir/$thisimage",
590                     StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
591                     OpacImageUrl  => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
592                     checked       => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
593                }
594              );
595              $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
596         }
597         push @imagesets, { imagesetname => $imagesubdir,
598                            imagesetactive => $imagesetactive,
599                            images       => \@imagelist };
600         
601     }
602     return \@imagesets;
603 }
604
605 =head2 GetPrinters
606
607   $printers = &GetPrinters();
608   @queues = keys %$printers;
609
610 Returns information about existing printer queues.
611
612 C<$printers> is a reference-to-hash whose keys are the print queues
613 defined in the printers table of the Koha database. The values are
614 references-to-hash, whose keys are the fields in the printers table.
615
616 =cut
617
618 sub GetPrinters {
619     my %printers;
620     my $dbh = C4::Context->dbh;
621     my $sth = $dbh->prepare("select * from printers");
622     $sth->execute;
623     while ( my $printer = $sth->fetchrow_hashref ) {
624         $printers{ $printer->{'printqueue'} } = $printer;
625     }
626     return ( \%printers );
627 }
628
629 =head2 GetPrinter
630
631   $printer = GetPrinter( $query, $printers );
632
633 =cut
634
635 sub GetPrinter {
636     my ( $query, $printers ) = @_;    # get printer for this query from printers
637     my $printer = $query->param('printer');
638     my %cookie = $query->cookie('userenv');
639     ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
640     ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
641     return $printer;
642 }
643
644 =head2 getnbpages
645
646 Returns the number of pages to display in a pagination bar, given the number
647 of items and the number of items per page.
648
649 =cut
650
651 sub getnbpages {
652     my ( $nb_items, $nb_items_per_page ) = @_;
653
654     return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
655 }
656
657 =head2 getallthemes
658
659   (@themes) = &getallthemes('opac');
660   (@themes) = &getallthemes('intranet');
661
662 Returns an array of all available themes.
663
664 =cut
665
666 sub getallthemes {
667     my $type = shift;
668     my $htdocs;
669     my @themes;
670     if ( $type eq 'intranet' ) {
671         $htdocs = C4::Context->config('intrahtdocs');
672     }
673     else {
674         $htdocs = C4::Context->config('opachtdocs');
675     }
676     opendir D, "$htdocs";
677     my @dirlist = readdir D;
678     foreach my $directory (@dirlist) {
679         next if $directory eq 'lib';
680         -d "$htdocs/$directory/en" and push @themes, $directory;
681     }
682     return @themes;
683 }
684
685 sub getFacets {
686     my $facets;
687     if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
688         $facets = [
689             {
690                 idx   => 'su-to',
691                 label => 'Topics',
692                 tags  => [ qw/ 600ab 601ab 602a 604at 605a 606ax 610a / ],
693                 sep   => ' - ',
694             },
695             {
696                 idx   => 'su-geo',
697                 label => 'Places',
698                 tags  => [ qw/ 607a / ],
699                 sep   => ' - ',
700             },
701             {
702                 idx   => 'su-ut',
703                 label => 'Titles',
704                 tags  => [ qw/ 500a 501a 503a / ],
705                 sep   => ', ',
706             },
707             {
708                 idx   => 'au',
709                 label => 'Authors',
710                 tags  => [ qw/ 700ab 701ab 702ab / ],
711                 sep   => ', ',
712             },
713             {
714                 idx   => 'se',
715                 label => 'Series',
716                 tags  => [ qw/ 225a / ],
717                 sep   => ', ',
718             },
719             ];
720
721             my $library_facet;
722             unless ( C4::Context->preference("singleBranchMode") || GetBranchesCount() == 1 ) {
723                 $library_facet = {
724                     idx  => 'branch',
725                     label => 'Libraries',
726                     tags        => [ qw/ 995b / ],
727                 };
728             } else {
729                 $library_facet = {
730                     idx  => 'location',
731                     label => 'Location',
732                     tags        => [ qw/ 995c / ],
733                 };
734             }
735             push( @$facets, $library_facet );
736     }
737     else {
738         $facets = [
739             {
740                 idx   => 'su-to',
741                 label => 'Topics',
742                 tags  => [ qw/ 650a / ],
743                 sep   => '--',
744             },
745             #        {
746             #        idx   => 'su-na',
747             #        label => 'People and Organizations',
748             #        tags  => [ qw/ 600a 610a 611a / ],
749             #        sep   => 'a',
750             #        },
751             {
752                 idx   => 'su-geo',
753                 label => 'Places',
754                 tags  => [ qw/ 651a / ],
755                 sep   => '--',
756             },
757             {
758                 idx   => 'su-ut',
759                 label => 'Titles',
760                 tags  => [ qw/ 630a / ],
761                 sep   => '--',
762             },
763             {
764                 idx   => 'au',
765                 label => 'Authors',
766                 tags  => [ qw/ 100a 110a 700a / ],
767                 sep   => ', ',
768             },
769             {
770                 idx   => 'se',
771                 label => 'Series',
772                 tags  => [ qw/ 440a 490a / ],
773                 sep   => ', ',
774             },
775             {
776                 idx   => 'itype',
777                 label => 'ItemTypes',
778                 tags  => [ qw/ 952y 942c / ],
779                 sep   => ', ',
780             },
781             ];
782
783             my $library_facet;
784             unless ( C4::Context->preference("singleBranchMode") || GetBranchesCount() == 1 ) {
785                 $library_facet = {
786                     idx  => 'branch',
787                     label => 'Libraries',
788                     tags        => [ qw / 952b / ],
789                 };
790             } else {
791                 $library_facet = {
792                     idx => 'location',
793                     label => 'Location',
794                     tags => [ qw / 952c / ],
795                 };
796             }
797             push( @$facets, $library_facet );
798     }
799     return $facets;
800 }
801
802 =head2 get_infos_of
803
804 Return a href where a key is associated to a href. You give a query,
805 the name of the key among the fields returned by the query. If you
806 also give as third argument the name of the value, the function
807 returns a href of scalar. The optional 4th argument is an arrayref of
808 items passed to the C<execute()> call. It is designed to bind
809 parameters to any placeholders in your SQL.
810
811   my $query = '
812 SELECT itemnumber,
813        notforloan,
814        barcode
815   FROM items
816 ';
817
818   # generic href of any information on the item, href of href.
819   my $iteminfos_of = get_infos_of($query, 'itemnumber');
820   print $iteminfos_of->{$itemnumber}{barcode};
821
822   # specific information, href of scalar
823   my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
824   print $barcode_of_item->{$itemnumber};
825
826 =cut
827
828 sub get_infos_of {
829     my ( $query, $key_name, $value_name, $bind_params ) = @_;
830
831     my $dbh = C4::Context->dbh;
832
833     my $sth = $dbh->prepare($query);
834     $sth->execute( @$bind_params );
835
836     my %infos_of;
837     while ( my $row = $sth->fetchrow_hashref ) {
838         if ( defined $value_name ) {
839             $infos_of{ $row->{$key_name} } = $row->{$value_name};
840         }
841         else {
842             $infos_of{ $row->{$key_name} } = $row;
843         }
844     }
845     $sth->finish;
846
847     return \%infos_of;
848 }
849
850 =head2 get_notforloan_label_of
851
852   my $notforloan_label_of = get_notforloan_label_of();
853
854 Each authorised value of notforloan (information available in items and
855 itemtypes) is link to a single label.
856
857 Returns a href where keys are authorised values and values are corresponding
858 labels.
859
860   foreach my $authorised_value (keys %{$notforloan_label_of}) {
861     printf(
862         "authorised_value: %s => %s\n",
863         $authorised_value,
864         $notforloan_label_of->{$authorised_value}
865     );
866   }
867
868 =cut
869
870 # FIXME - why not use GetAuthorisedValues ??
871 #
872 sub get_notforloan_label_of {
873     my $dbh = C4::Context->dbh;
874
875     my $query = '
876 SELECT authorised_value
877   FROM marc_subfield_structure
878   WHERE kohafield = \'items.notforloan\'
879   LIMIT 0, 1
880 ';
881     my $sth = $dbh->prepare($query);
882     $sth->execute();
883     my ($statuscode) = $sth->fetchrow_array();
884
885     $query = '
886 SELECT lib,
887        authorised_value
888   FROM authorised_values
889   WHERE category = ?
890 ';
891     $sth = $dbh->prepare($query);
892     $sth->execute($statuscode);
893     my %notforloan_label_of;
894     while ( my $row = $sth->fetchrow_hashref ) {
895         $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
896     }
897     $sth->finish;
898
899     return \%notforloan_label_of;
900 }
901
902 =head2 displayServers
903
904    my $servers = displayServers();
905    my $servers = displayServers( $position );
906    my $servers = displayServers( $position, $type );
907
908 displayServers returns a listref of hashrefs, each containing
909 information about available z3950 servers. Each hashref has a format
910 like:
911
912     {
913       'checked'    => 'checked',
914       'encoding'   => 'MARC-8'
915       'icon'       => undef,
916       'id'         => 'LIBRARY OF CONGRESS',
917       'label'      => '',
918       'name'       => 'server',
919       'opensearch' => '',
920       'value'      => 'z3950.loc.gov:7090/',
921       'zed'        => 1,
922     },
923
924 =cut
925
926 sub displayServers {
927     my ( $position, $type ) = @_;
928     my $dbh = C4::Context->dbh;
929
930     my $strsth = 'SELECT * FROM z3950servers';
931     my @where_clauses;
932     my @bind_params;
933
934     if ($position) {
935         push @bind_params,   $position;
936         push @where_clauses, ' position = ? ';
937     }
938
939     if ($type) {
940         push @bind_params,   $type;
941         push @where_clauses, ' type = ? ';
942     }
943
944     # reassemble where clause from where clause pieces
945     if (@where_clauses) {
946         $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
947     }
948
949     my $rq = $dbh->prepare($strsth);
950     $rq->execute(@bind_params);
951     my @primaryserverloop;
952
953     while ( my $data = $rq->fetchrow_hashref ) {
954         push @primaryserverloop,
955           { label    => $data->{description},
956             id       => $data->{name},
957             name     => "server",
958             value    => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
959             encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
960             checked  => "checked",
961             icon     => $data->{icon},
962             zed        => $data->{type} eq 'zed',
963             opensearch => $data->{type} eq 'opensearch'
964           };
965     }
966     return \@primaryserverloop;
967 }
968
969
970 =head2 GetKohaImageurlFromAuthorisedValues
971
972 $authhorised_value = GetKohaImageurlFromAuthorisedValues( $category, $authvalcode );
973
974 Return the first url of the authorised value image represented by $lib.
975
976 =cut
977
978 sub GetKohaImageurlFromAuthorisedValues {
979     my ( $category, $lib ) = @_;
980     my $dbh = C4::Context->dbh;
981     my $sth = $dbh->prepare("SELECT imageurl FROM authorised_values WHERE category=? AND lib =?");
982     $sth->execute( $category, $lib );
983     while ( my $data = $sth->fetchrow_hashref ) {
984         return $data->{'imageurl'};
985     }
986 }
987
988 =head2 GetAuthValCode
989
990   $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
991
992 =cut
993
994 sub GetAuthValCode {
995         my ($kohafield,$fwcode) = @_;
996         my $dbh = C4::Context->dbh;
997         $fwcode='' unless $fwcode;
998         my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
999         $sth->execute($kohafield,$fwcode);
1000         my ($authvalcode) = $sth->fetchrow_array;
1001         return $authvalcode;
1002 }
1003
1004 =head2 GetAuthValCodeFromField
1005
1006   $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
1007
1008 C<$subfield> can be undefined
1009
1010 =cut
1011
1012 sub GetAuthValCodeFromField {
1013         my ($field,$subfield,$fwcode) = @_;
1014         my $dbh = C4::Context->dbh;
1015         $fwcode='' unless $fwcode;
1016         my $sth;
1017         if (defined $subfield) {
1018             $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
1019             $sth->execute($field,$subfield,$fwcode);
1020         } else {
1021             $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
1022             $sth->execute($field,$fwcode);
1023         }
1024         my ($authvalcode) = $sth->fetchrow_array;
1025         return $authvalcode;
1026 }
1027
1028 =head2 GetAuthorisedValues
1029
1030   $authvalues = GetAuthorisedValues([$category], [$selected]);
1031
1032 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
1033
1034 C<$category> returns authorised values for just one category (optional).
1035
1036 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1037
1038 =cut
1039
1040 sub GetAuthorisedValues {
1041     my ( $category, $selected, $opac ) = @_;
1042     my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1043     my @results;
1044     my $dbh      = C4::Context->dbh;
1045     my $query = qq{
1046         SELECT *
1047         FROM authorised_values
1048     };
1049     $query .= qq{
1050           LEFT JOIN authorised_values_branches ON ( id = av_id )
1051     } if $branch_limit;
1052     my @where_strings;
1053     my @where_args;
1054     if($category) {
1055         push @where_strings, "category = ?";
1056         push @where_args, $category;
1057     }
1058     if($branch_limit) {
1059         push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
1060         push @where_args, $branch_limit;
1061     }
1062     if(@where_strings > 0) {
1063         $query .= " WHERE " . join(" AND ", @where_strings);
1064     }
1065     $query .= " GROUP BY lib ORDER BY category, lib, lib_opac";
1066
1067     my $sth = $dbh->prepare($query);
1068
1069     $sth->execute( @where_args );
1070     while (my $data=$sth->fetchrow_hashref) {
1071         if ( defined $selected and $selected eq $data->{authorised_value} ) {
1072             $data->{selected} = 1;
1073         }
1074         else {
1075             $data->{selected} = 0;
1076         }
1077
1078         if ($opac && $data->{lib_opac}) {
1079             $data->{lib} = $data->{lib_opac};
1080         }
1081         push @results, $data;
1082     }
1083     $sth->finish;
1084     return \@results;
1085 }
1086
1087 =head2 GetAuthorisedValueCategories
1088
1089   $auth_categories = GetAuthorisedValueCategories();
1090
1091 Return an arrayref of all of the available authorised
1092 value categories.
1093
1094 =cut
1095
1096 sub GetAuthorisedValueCategories {
1097     my $dbh = C4::Context->dbh;
1098     my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1099     $sth->execute;
1100     my @results;
1101     while (defined (my $category  = $sth->fetchrow_array) ) {
1102         push @results, $category;
1103     }
1104     return \@results;
1105 }
1106
1107 =head2 GetAuthorisedValueByCode
1108
1109 $authhorised_value = GetAuthorisedValueByCode( $category, $authvalcode );
1110
1111 Return the lib attribute from authorised_values from the row identified
1112 by the passed category and code
1113
1114 =cut
1115
1116 sub GetAuthorisedValueByCode {
1117     my ( $category, $authvalcode, $opac ) = @_;
1118
1119     my $field = $opac ? 'lib_opac' : 'lib';
1120     my $dbh = C4::Context->dbh;
1121     my $sth = $dbh->prepare("SELECT $field FROM authorised_values WHERE category=? AND authorised_value =?");
1122     $sth->execute( $category, $authvalcode );
1123     while ( my $data = $sth->fetchrow_hashref ) {
1124         return $data->{ $field };
1125     }
1126 }
1127
1128 =head2 GetKohaAuthorisedValues
1129
1130 Takes $kohafield, $fwcode as parameters.
1131
1132 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1133
1134 Returns hashref of Code => description
1135
1136 Returns undef if no authorised value category is defined for the kohafield.
1137
1138 =cut
1139
1140 sub GetKohaAuthorisedValues {
1141   my ($kohafield,$fwcode,$opac) = @_;
1142   $fwcode='' unless $fwcode;
1143   my %values;
1144   my $dbh = C4::Context->dbh;
1145   my $avcode = GetAuthValCode($kohafield,$fwcode);
1146   if ($avcode) {  
1147         my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1148         $sth->execute($avcode);
1149         while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) { 
1150                 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1151         }
1152         return \%values;
1153   } else {
1154         return;
1155   }
1156 }
1157
1158 =head2 GetKohaAuthorisedValuesFromField
1159
1160 Takes $field, $subfield, $fwcode as parameters.
1161
1162 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1163 $subfield can be undefined
1164
1165 Returns hashref of Code => description
1166
1167 Returns undef if no authorised value category is defined for the given field and subfield 
1168
1169 =cut
1170
1171 sub GetKohaAuthorisedValuesFromField {
1172   my ($field, $subfield, $fwcode,$opac) = @_;
1173   $fwcode='' unless $fwcode;
1174   my %values;
1175   my $dbh = C4::Context->dbh;
1176   my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1177   if ($avcode) {  
1178         my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1179         $sth->execute($avcode);
1180         while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) { 
1181                 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1182         }
1183         return \%values;
1184   } else {
1185         return;
1186   }
1187 }
1188
1189 =head2 xml_escape
1190
1191   my $escaped_string = C4::Koha::xml_escape($string);
1192
1193 Convert &, <, >, ', and " in a string to XML entities
1194
1195 =cut
1196
1197 sub xml_escape {
1198     my $str = shift;
1199     return '' unless defined $str;
1200     $str =~ s/&/&amp;/g;
1201     $str =~ s/</&lt;/g;
1202     $str =~ s/>/&gt;/g;
1203     $str =~ s/'/&apos;/g;
1204     $str =~ s/"/&quot;/g;
1205     return $str;
1206 }
1207
1208 =head2 GetKohaAuthorisedValueLib
1209
1210 Takes $category, $authorised_value as parameters.
1211
1212 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1213
1214 Returns authorised value description
1215
1216 =cut
1217
1218 sub GetKohaAuthorisedValueLib {
1219   my ($category,$authorised_value,$opac) = @_;
1220   my $value;
1221   my $dbh = C4::Context->dbh;
1222   my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1223   $sth->execute($category,$authorised_value);
1224   my $data = $sth->fetchrow_hashref;
1225   $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1226   return $value;
1227 }
1228
1229 =head2 display_marc_indicators
1230
1231   my $display_form = C4::Koha::display_marc_indicators($field);
1232
1233 C<$field> is a MARC::Field object
1234
1235 Generate a display form of the indicators of a variable
1236 MARC field, replacing any blanks with '#'.
1237
1238 =cut
1239
1240 sub display_marc_indicators {
1241     my $field = shift;
1242     my $indicators = '';
1243     if ($field->tag() >= 10) {
1244         $indicators = $field->indicator(1) . $field->indicator(2);
1245         $indicators =~ s/ /#/g;
1246     }
1247     return $indicators;
1248 }
1249
1250 sub GetNormalizedUPC {
1251  my ($record,$marcflavour) = @_;
1252     my (@fields,$upc);
1253
1254     if ($marcflavour eq 'UNIMARC') {
1255         @fields = $record->field('072');
1256         foreach my $field (@fields) {
1257             my $upc = _normalize_match_point($field->subfield('a'));
1258             if ($upc ne '') {
1259                 return $upc;
1260             }
1261         }
1262
1263     }
1264     else { # assume marc21 if not unimarc
1265         @fields = $record->field('024');
1266         foreach my $field (@fields) {
1267             my $indicator = $field->indicator(1);
1268             my $upc = _normalize_match_point($field->subfield('a'));
1269             if ($indicator == 1 and $upc ne '') {
1270                 return $upc;
1271             }
1272         }
1273     }
1274 }
1275
1276 # Normalizes and returns the first valid ISBN found in the record
1277 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
1278 sub GetNormalizedISBN {
1279     my ($isbn,$record,$marcflavour) = @_;
1280     my @fields;
1281     if ($isbn) {
1282         # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1283         # anything after " | " should be removed, along with the delimiter
1284         $isbn =~ s/(.*)( \| )(.*)/$1/;
1285         return _isbn_cleanup($isbn);
1286     }
1287     return unless $record;
1288
1289     if ($marcflavour eq 'UNIMARC') {
1290         @fields = $record->field('010');
1291         foreach my $field (@fields) {
1292             my $isbn = $field->subfield('a');
1293             if ($isbn) {
1294                 return _isbn_cleanup($isbn);
1295             } else {
1296                 return;
1297             }
1298         }
1299     }
1300     else { # assume marc21 if not unimarc
1301         @fields = $record->field('020');
1302         foreach my $field (@fields) {
1303             $isbn = $field->subfield('a');
1304             if ($isbn) {
1305                 return _isbn_cleanup($isbn);
1306             } else {
1307                 return;
1308             }
1309         }
1310     }
1311 }
1312
1313 sub GetNormalizedEAN {
1314     my ($record,$marcflavour) = @_;
1315     my (@fields,$ean);
1316
1317     if ($marcflavour eq 'UNIMARC') {
1318         @fields = $record->field('073');
1319         foreach my $field (@fields) {
1320             $ean = _normalize_match_point($field->subfield('a'));
1321             if ($ean ne '') {
1322                 return $ean;
1323             }
1324         }
1325     }
1326     else { # assume marc21 if not unimarc
1327         @fields = $record->field('024');
1328         foreach my $field (@fields) {
1329             my $indicator = $field->indicator(1);
1330             $ean = _normalize_match_point($field->subfield('a'));
1331             if ($indicator == 3 and $ean ne '') {
1332                 return $ean;
1333             }
1334         }
1335     }
1336 }
1337 sub GetNormalizedOCLCNumber {
1338     my ($record,$marcflavour) = @_;
1339     my (@fields,$oclc);
1340
1341     if ($marcflavour eq 'UNIMARC') {
1342         # TODO: add UNIMARC fields
1343     }
1344     else { # assume marc21 if not unimarc
1345         @fields = $record->field('035');
1346         foreach my $field (@fields) {
1347             $oclc = $field->subfield('a');
1348             if ($oclc =~ /OCoLC/) {
1349                 $oclc =~ s/\(OCoLC\)//;
1350                 return $oclc;
1351             } else {
1352                 return;
1353             }
1354         }
1355     }
1356 }
1357
1358 =head2 GetDailyQuote($opts)
1359
1360 Takes a hashref of options
1361
1362 Currently supported options are:
1363
1364 'id'        An exact quote id
1365 'random'    Select a random quote
1366 noop        When no option is passed in, this sub will return the quote timestamped for the current day
1367
1368 The function returns an anonymous hash following this format:
1369
1370         {
1371           'source' => 'source-of-quote',
1372           'timestamp' => 'timestamp-value',
1373           'text' => 'text-of-quote',
1374           'id' => 'quote-id'
1375         };
1376
1377 =cut
1378
1379 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1380 # at least for default option
1381
1382 sub GetDailyQuote {
1383     my %opts = @_;
1384     my $dbh = C4::Context->dbh;
1385     my $query = '';
1386     my $sth = undef;
1387     my $quote = undef;
1388     if ($opts{'id'}) {
1389         $query = 'SELECT * FROM quotes WHERE id = ?';
1390         $sth = $dbh->prepare($query);
1391         $sth->execute($opts{'id'});
1392         $quote = $sth->fetchrow_hashref();
1393     }
1394     elsif ($opts{'random'}) {
1395         # Fall through... we also return a random quote as a catch-all if all else fails
1396     }
1397     else {
1398         $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1399         $sth = $dbh->prepare($query);
1400         $sth->execute();
1401         $quote = $sth->fetchrow_hashref();
1402     }
1403     unless ($quote) {        # if there are not matches, choose a random quote
1404         # get a list of all available quote ids
1405         $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1406         $sth->execute;
1407         my $range = ($sth->fetchrow_array)[0];
1408         if ($range > 1) {
1409             # chose a random id within that range if there is more than one quote
1410             my $id = int(rand($range));
1411             # grab it
1412             $query = 'SELECT * FROM quotes WHERE id = ?;';
1413             $sth = C4::Context->dbh->prepare($query);
1414             $sth->execute($id);
1415         }
1416         else {
1417             $query = 'SELECT * FROM quotes;';
1418             $sth = C4::Context->dbh->prepare($query);
1419             $sth->execute();
1420         }
1421         $quote = $sth->fetchrow_hashref();
1422         # update the timestamp for that quote
1423         $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1424         $sth = C4::Context->dbh->prepare($query);
1425         $sth->execute(DateTime::Format::MySQL->format_datetime(DateTime->now), $quote->{'id'});
1426     }
1427     return $quote;
1428 }
1429
1430 sub _normalize_match_point {
1431     my $match_point = shift;
1432     (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1433     $normalized_match_point =~ s/-//g;
1434
1435     return $normalized_match_point;
1436 }
1437
1438 sub _isbn_cleanup {
1439     require Business::ISBN;
1440     my $isbn = Business::ISBN->new( $_[0] );
1441     if ( $isbn ) {
1442         $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13';
1443         if (defined $isbn) {
1444             return $isbn->as_string([]);
1445         }
1446     }
1447     return;
1448 }
1449
1450 1;
1451
1452 __END__
1453
1454 =head1 AUTHOR
1455
1456 Koha Team
1457
1458 =cut