Merge branch 'bug_8557' into 3.12-master
[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 = &getitemtype($itemtype);
429
430 Returns information about an itemtype.
431
432 =cut
433
434 sub getitemtypeinfo {
435     my ($itemtype) = @_;
436     my $dbh        = C4::Context->dbh;
437     my $sth        = $dbh->prepare("select * from itemtypes where itemtype=?");
438     $sth->execute($itemtype);
439     my $res = $sth->fetchrow_hashref;
440
441     $res->{imageurl} = getitemtypeimagelocation( 'intranet', $res->{imageurl} );
442
443     return $res;
444 }
445
446 =head2 getitemtypeimagedir
447
448   my $directory = getitemtypeimagedir( 'opac' );
449
450 pass in 'opac' or 'intranet'. Defaults to 'opac'.
451
452 returns the full path to the appropriate directory containing images.
453
454 =cut
455
456 sub getitemtypeimagedir {
457         my $src = shift || 'opac';
458         if ($src eq 'intranet') {
459                 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
460         } else {
461                 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
462         }
463 }
464
465 sub getitemtypeimagesrc {
466         my $src = shift || 'opac';
467         if ($src eq 'intranet') {
468                 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
469         } else {
470                 return '/opac-tmpl' . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
471         }
472 }
473
474 sub getitemtypeimagelocation {
475         my ( $src, $image ) = @_;
476
477         return '' if ( !$image );
478     require URI::Split;
479
480         my $scheme = ( URI::Split::uri_split( $image ) )[0];
481
482         return $image if ( $scheme );
483
484         return getitemtypeimagesrc( $src ) . '/' . $image;
485 }
486
487 =head3 _getImagesFromDirectory
488
489 Find all of the image files in a directory in the filesystem
490
491 parameters: a directory name
492
493 returns: a list of images in that directory.
494
495 Notes: this does not traverse into subdirectories. See
496 _getSubdirectoryNames for help with that.
497 Images are assumed to be files with .gif or .png file extensions.
498 The image names returned do not have the directory name on them.
499
500 =cut
501
502 sub _getImagesFromDirectory {
503     my $directoryname = shift;
504     return unless defined $directoryname;
505     return unless -d $directoryname;
506
507     if ( opendir ( my $dh, $directoryname ) ) {
508         my @images = grep { /\.(gif|png)$/i } readdir( $dh );
509         closedir $dh;
510         @images = sort(@images);
511         return @images;
512     } else {
513         warn "unable to opendir $directoryname: $!";
514         return;
515     }
516 }
517
518 =head3 _getSubdirectoryNames
519
520 Find all of the directories in a directory in the filesystem
521
522 parameters: a directory name
523
524 returns: a list of subdirectories in that directory.
525
526 Notes: this does not traverse into subdirectories. Only the first
527 level of subdirectories are returned.
528 The directory names returned don't have the parent directory name on them.
529
530 =cut
531
532 sub _getSubdirectoryNames {
533     my $directoryname = shift;
534     return unless defined $directoryname;
535     return unless -d $directoryname;
536
537     if ( opendir ( my $dh, $directoryname ) ) {
538         my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
539         closedir $dh;
540         return @directories;
541     } else {
542         warn "unable to opendir $directoryname: $!";
543         return;
544     }
545 }
546
547 =head3 getImageSets
548
549 returns: a listref of hashrefs. Each hash represents another collection of images.
550
551  { imagesetname => 'npl', # the name of the image set (npl is the original one)
552          images => listref of image hashrefs
553  }
554
555 each image is represented by a hashref like this:
556
557  { KohaImage     => 'npl/image.gif',
558    StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
559    OpacImageURL  => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
560    checked       => 0 or 1: was this the image passed to this method?
561                     Note: I'd like to remove this somehow.
562  }
563
564 =cut
565
566 sub getImageSets {
567     my %params = @_;
568     my $checked = $params{'checked'} || '';
569
570     my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
571                              url        => getitemtypeimagesrc('intranet'),
572                         },
573                   opac => { filesystem => getitemtypeimagedir('opac'),
574                              url       => getitemtypeimagesrc('opac'),
575                         }
576                   };
577
578     my @imagesets = (); # list of hasrefs of image set data to pass to template
579     my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
580     foreach my $imagesubdir ( @subdirectories ) {
581     warn $imagesubdir if $DEBUG;
582         my @imagelist     = (); # hashrefs of image info
583         my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
584         my $imagesetactive = 0;
585         foreach my $thisimage ( @imagenames ) {
586             push( @imagelist,
587                   { KohaImage     => "$imagesubdir/$thisimage",
588                     StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
589                     OpacImageUrl  => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
590                     checked       => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
591                }
592              );
593              $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
594         }
595         push @imagesets, { imagesetname => $imagesubdir,
596                            imagesetactive => $imagesetactive,
597                            images       => \@imagelist };
598         
599     }
600     return \@imagesets;
601 }
602
603 =head2 GetPrinters
604
605   $printers = &GetPrinters();
606   @queues = keys %$printers;
607
608 Returns information about existing printer queues.
609
610 C<$printers> is a reference-to-hash whose keys are the print queues
611 defined in the printers table of the Koha database. The values are
612 references-to-hash, whose keys are the fields in the printers table.
613
614 =cut
615
616 sub GetPrinters {
617     my %printers;
618     my $dbh = C4::Context->dbh;
619     my $sth = $dbh->prepare("select * from printers");
620     $sth->execute;
621     while ( my $printer = $sth->fetchrow_hashref ) {
622         $printers{ $printer->{'printqueue'} } = $printer;
623     }
624     return ( \%printers );
625 }
626
627 =head2 GetPrinter
628
629   $printer = GetPrinter( $query, $printers );
630
631 =cut
632
633 sub GetPrinter {
634     my ( $query, $printers ) = @_;    # get printer for this query from printers
635     my $printer = $query->param('printer');
636     my %cookie = $query->cookie('userenv');
637     ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
638     ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
639     return $printer;
640 }
641
642 =head2 getnbpages
643
644 Returns the number of pages to display in a pagination bar, given the number
645 of items and the number of items per page.
646
647 =cut
648
649 sub getnbpages {
650     my ( $nb_items, $nb_items_per_page ) = @_;
651
652     return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
653 }
654
655 =head2 getallthemes
656
657   (@themes) = &getallthemes('opac');
658   (@themes) = &getallthemes('intranet');
659
660 Returns an array of all available themes.
661
662 =cut
663
664 sub getallthemes {
665     my $type = shift;
666     my $htdocs;
667     my @themes;
668     if ( $type eq 'intranet' ) {
669         $htdocs = C4::Context->config('intrahtdocs');
670     }
671     else {
672         $htdocs = C4::Context->config('opachtdocs');
673     }
674     opendir D, "$htdocs";
675     my @dirlist = readdir D;
676     foreach my $directory (@dirlist) {
677         next if $directory eq 'lib';
678         -d "$htdocs/$directory/en" and push @themes, $directory;
679     }
680     return @themes;
681 }
682
683 sub getFacets {
684     my $facets;
685     if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
686         $facets = [
687             {
688                 idx   => 'su-to',
689                 label => 'Topics',
690                 tags  => [ qw/ 600ab 601ab 602a 604at 605a 606ax 610a / ],
691                 sep   => ' - ',
692             },
693             {
694                 idx   => 'su-geo',
695                 label => 'Places',
696                 tags  => [ qw/ 607a / ],
697                 sep   => ' - ',
698             },
699             {
700                 idx   => 'su-ut',
701                 label => 'Titles',
702                 tags  => [ qw/ 500a 501a 503a / ],
703                 sep   => ', ',
704             },
705             {
706                 idx   => 'au',
707                 label => 'Authors',
708                 tags  => [ qw/ 700ab 701ab 702ab / ],
709                 sep   => ', ',
710             },
711             {
712                 idx   => 'se',
713                 label => 'Series',
714                 tags  => [ qw/ 225a / ],
715                 sep   => ', ',
716             },
717             ];
718
719             my $library_facet;
720             unless ( C4::Context->preference("singleBranchMode") || GetBranchesCount() == 1 ) {
721                 $library_facet = {
722                     idx  => 'branch',
723                     label => 'Libraries',
724                     tags        => [ qw/ 995b / ],
725                 };
726             } else {
727                 $library_facet = {
728                     idx  => 'location',
729                     label => 'Location',
730                     tags        => [ qw/ 995c / ],
731                 };
732             }
733             push( @$facets, $library_facet );
734     }
735     else {
736         $facets = [
737             {
738                 idx   => 'su-to',
739                 label => 'Topics',
740                 tags  => [ qw/ 650a / ],
741                 sep   => '--',
742             },
743             #        {
744             #        idx   => 'su-na',
745             #        label => 'People and Organizations',
746             #        tags  => [ qw/ 600a 610a 611a / ],
747             #        sep   => 'a',
748             #        },
749             {
750                 idx   => 'su-geo',
751                 label => 'Places',
752                 tags  => [ qw/ 651a / ],
753                 sep   => '--',
754             },
755             {
756                 idx   => 'su-ut',
757                 label => 'Titles',
758                 tags  => [ qw/ 630a / ],
759                 sep   => '--',
760             },
761             {
762                 idx   => 'au',
763                 label => 'Authors',
764                 tags  => [ qw/ 100a 110a 700a / ],
765                 sep   => ', ',
766             },
767             {
768                 idx   => 'se',
769                 label => 'Series',
770                 tags  => [ qw/ 440a 490a / ],
771                 sep   => ', ',
772             },
773             {
774                 idx   => 'itype',
775                 label => 'ItemTypes',
776                 tags  => [ qw/ 952y 942c / ],
777                 sep   => ', ',
778             },
779             ];
780
781             my $library_facet;
782             unless ( C4::Context->preference("singleBranchMode") || GetBranchesCount() == 1 ) {
783                 $library_facet = {
784                     idx  => 'branch',
785                     label => 'Libraries',
786                     tags        => [ qw / 952b / ],
787                 };
788             } else {
789                 $library_facet = {
790                     idx => 'location',
791                     label => 'Location',
792                     tags => [ qw / 952c / ],
793                 };
794             }
795             push( @$facets, $library_facet );
796     }
797     return $facets;
798 }
799
800 =head2 get_infos_of
801
802 Return a href where a key is associated to a href. You give a query,
803 the name of the key among the fields returned by the query. If you
804 also give as third argument the name of the value, the function
805 returns a href of scalar. The optional 4th argument is an arrayref of
806 items passed to the C<execute()> call. It is designed to bind
807 parameters to any placeholders in your SQL.
808
809   my $query = '
810 SELECT itemnumber,
811        notforloan,
812        barcode
813   FROM items
814 ';
815
816   # generic href of any information on the item, href of href.
817   my $iteminfos_of = get_infos_of($query, 'itemnumber');
818   print $iteminfos_of->{$itemnumber}{barcode};
819
820   # specific information, href of scalar
821   my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
822   print $barcode_of_item->{$itemnumber};
823
824 =cut
825
826 sub get_infos_of {
827     my ( $query, $key_name, $value_name, $bind_params ) = @_;
828
829     my $dbh = C4::Context->dbh;
830
831     my $sth = $dbh->prepare($query);
832     $sth->execute( @$bind_params );
833
834     my %infos_of;
835     while ( my $row = $sth->fetchrow_hashref ) {
836         if ( defined $value_name ) {
837             $infos_of{ $row->{$key_name} } = $row->{$value_name};
838         }
839         else {
840             $infos_of{ $row->{$key_name} } = $row;
841         }
842     }
843     $sth->finish;
844
845     return \%infos_of;
846 }
847
848 =head2 get_notforloan_label_of
849
850   my $notforloan_label_of = get_notforloan_label_of();
851
852 Each authorised value of notforloan (information available in items and
853 itemtypes) is link to a single label.
854
855 Returns a href where keys are authorised values and values are corresponding
856 labels.
857
858   foreach my $authorised_value (keys %{$notforloan_label_of}) {
859     printf(
860         "authorised_value: %s => %s\n",
861         $authorised_value,
862         $notforloan_label_of->{$authorised_value}
863     );
864   }
865
866 =cut
867
868 # FIXME - why not use GetAuthorisedValues ??
869 #
870 sub get_notforloan_label_of {
871     my $dbh = C4::Context->dbh;
872
873     my $query = '
874 SELECT authorised_value
875   FROM marc_subfield_structure
876   WHERE kohafield = \'items.notforloan\'
877   LIMIT 0, 1
878 ';
879     my $sth = $dbh->prepare($query);
880     $sth->execute();
881     my ($statuscode) = $sth->fetchrow_array();
882
883     $query = '
884 SELECT lib,
885        authorised_value
886   FROM authorised_values
887   WHERE category = ?
888 ';
889     $sth = $dbh->prepare($query);
890     $sth->execute($statuscode);
891     my %notforloan_label_of;
892     while ( my $row = $sth->fetchrow_hashref ) {
893         $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
894     }
895     $sth->finish;
896
897     return \%notforloan_label_of;
898 }
899
900 =head2 displayServers
901
902    my $servers = displayServers();
903    my $servers = displayServers( $position );
904    my $servers = displayServers( $position, $type );
905
906 displayServers returns a listref of hashrefs, each containing
907 information about available z3950 servers. Each hashref has a format
908 like:
909
910     {
911       'checked'    => 'checked',
912       'encoding'   => 'MARC-8'
913       'icon'       => undef,
914       'id'         => 'LIBRARY OF CONGRESS',
915       'label'      => '',
916       'name'       => 'server',
917       'opensearch' => '',
918       'value'      => 'z3950.loc.gov:7090/',
919       'zed'        => 1,
920     },
921
922 =cut
923
924 sub displayServers {
925     my ( $position, $type ) = @_;
926     my $dbh = C4::Context->dbh;
927
928     my $strsth = 'SELECT * FROM z3950servers';
929     my @where_clauses;
930     my @bind_params;
931
932     if ($position) {
933         push @bind_params,   $position;
934         push @where_clauses, ' position = ? ';
935     }
936
937     if ($type) {
938         push @bind_params,   $type;
939         push @where_clauses, ' type = ? ';
940     }
941
942     # reassemble where clause from where clause pieces
943     if (@where_clauses) {
944         $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
945     }
946
947     my $rq = $dbh->prepare($strsth);
948     $rq->execute(@bind_params);
949     my @primaryserverloop;
950
951     while ( my $data = $rq->fetchrow_hashref ) {
952         push @primaryserverloop,
953           { label    => $data->{description},
954             id       => $data->{name},
955             name     => "server",
956             value    => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
957             encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
958             checked  => "checked",
959             icon     => $data->{icon},
960             zed        => $data->{type} eq 'zed',
961             opensearch => $data->{type} eq 'opensearch'
962           };
963     }
964     return \@primaryserverloop;
965 }
966
967
968 =head2 GetKohaImageurlFromAuthorisedValues
969
970 $authhorised_value = GetKohaImageurlFromAuthorisedValues( $category, $authvalcode );
971
972 Return the first url of the authorised value image represented by $lib.
973
974 =cut
975
976 sub GetKohaImageurlFromAuthorisedValues {
977     my ( $category, $lib ) = @_;
978     my $dbh = C4::Context->dbh;
979     my $sth = $dbh->prepare("SELECT imageurl FROM authorised_values WHERE category=? AND lib =?");
980     $sth->execute( $category, $lib );
981     while ( my $data = $sth->fetchrow_hashref ) {
982         return $data->{'imageurl'};
983     }
984 }
985
986 =head2 GetAuthValCode
987
988   $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
989
990 =cut
991
992 sub GetAuthValCode {
993         my ($kohafield,$fwcode) = @_;
994         my $dbh = C4::Context->dbh;
995         $fwcode='' unless $fwcode;
996         my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
997         $sth->execute($kohafield,$fwcode);
998         my ($authvalcode) = $sth->fetchrow_array;
999         return $authvalcode;
1000 }
1001
1002 =head2 GetAuthValCodeFromField
1003
1004   $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
1005
1006 C<$subfield> can be undefined
1007
1008 =cut
1009
1010 sub GetAuthValCodeFromField {
1011         my ($field,$subfield,$fwcode) = @_;
1012         my $dbh = C4::Context->dbh;
1013         $fwcode='' unless $fwcode;
1014         my $sth;
1015         if (defined $subfield) {
1016             $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
1017             $sth->execute($field,$subfield,$fwcode);
1018         } else {
1019             $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
1020             $sth->execute($field,$fwcode);
1021         }
1022         my ($authvalcode) = $sth->fetchrow_array;
1023         return $authvalcode;
1024 }
1025
1026 =head2 GetAuthorisedValues
1027
1028   $authvalues = GetAuthorisedValues([$category], [$selected]);
1029
1030 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
1031
1032 C<$category> returns authorised values for just one category (optional).
1033
1034 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1035
1036 =cut
1037
1038 sub GetAuthorisedValues {
1039     my ( $category, $selected, $opac ) = @_;
1040     my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1041     my @results;
1042     my $dbh      = C4::Context->dbh;
1043     my $query = qq{
1044         SELECT *
1045         FROM authorised_values
1046     };
1047     $query .= qq{
1048           LEFT JOIN authorised_values_branches ON ( id = av_id )
1049     } if $branch_limit;
1050     my @where_strings;
1051     my @where_args;
1052     if($category) {
1053         push @where_strings, "category = ?";
1054         push @where_args, $category;
1055     }
1056     if($branch_limit) {
1057         push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
1058         push @where_args, $branch_limit;
1059     }
1060     if(@where_strings > 0) {
1061         $query .= " WHERE " . join(" AND ", @where_strings);
1062     }
1063     $query .= " GROUP BY lib ORDER BY category, lib, lib_opac";
1064
1065     my $sth = $dbh->prepare($query);
1066
1067     $sth->execute( @where_args );
1068     while (my $data=$sth->fetchrow_hashref) {
1069         if ( defined $selected and $selected eq $data->{authorised_value} ) {
1070             $data->{selected} = 1;
1071         }
1072         else {
1073             $data->{selected} = 0;
1074         }
1075
1076         if ($opac && $data->{lib_opac}) {
1077             $data->{lib} = $data->{lib_opac};
1078         }
1079         push @results, $data;
1080     }
1081     $sth->finish;
1082     return \@results;
1083 }
1084
1085 =head2 GetAuthorisedValueCategories
1086
1087   $auth_categories = GetAuthorisedValueCategories();
1088
1089 Return an arrayref of all of the available authorised
1090 value categories.
1091
1092 =cut
1093
1094 sub GetAuthorisedValueCategories {
1095     my $dbh = C4::Context->dbh;
1096     my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1097     $sth->execute;
1098     my @results;
1099     while (defined (my $category  = $sth->fetchrow_array) ) {
1100         push @results, $category;
1101     }
1102     return \@results;
1103 }
1104
1105 =head2 GetAuthorisedValueByCode
1106
1107 $authhorised_value = GetAuthorisedValueByCode( $category, $authvalcode );
1108
1109 Return the lib attribute from authorised_values from the row identified
1110 by the passed category and code
1111
1112 =cut
1113
1114 sub GetAuthorisedValueByCode {
1115     my ( $category, $authvalcode, $opac ) = @_;
1116
1117     my $field = $opac ? 'lib_opac' : 'lib';
1118     my $dbh = C4::Context->dbh;
1119     my $sth = $dbh->prepare("SELECT $field FROM authorised_values WHERE category=? AND authorised_value =?");
1120     $sth->execute( $category, $authvalcode );
1121     while ( my $data = $sth->fetchrow_hashref ) {
1122         return $data->{ $field };
1123     }
1124 }
1125
1126 =head2 GetKohaAuthorisedValues
1127
1128 Takes $kohafield, $fwcode as parameters.
1129
1130 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1131
1132 Returns hashref of Code => description
1133
1134 Returns undef if no authorised value category is defined for the kohafield.
1135
1136 =cut
1137
1138 sub GetKohaAuthorisedValues {
1139   my ($kohafield,$fwcode,$opac) = @_;
1140   $fwcode='' unless $fwcode;
1141   my %values;
1142   my $dbh = C4::Context->dbh;
1143   my $avcode = GetAuthValCode($kohafield,$fwcode);
1144   if ($avcode) {  
1145         my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1146         $sth->execute($avcode);
1147         while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) { 
1148                 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1149         }
1150         return \%values;
1151   } else {
1152         return;
1153   }
1154 }
1155
1156 =head2 GetKohaAuthorisedValuesFromField
1157
1158 Takes $field, $subfield, $fwcode as parameters.
1159
1160 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1161 $subfield can be undefined
1162
1163 Returns hashref of Code => description
1164
1165 Returns undef if no authorised value category is defined for the given field and subfield 
1166
1167 =cut
1168
1169 sub GetKohaAuthorisedValuesFromField {
1170   my ($field, $subfield, $fwcode,$opac) = @_;
1171   $fwcode='' unless $fwcode;
1172   my %values;
1173   my $dbh = C4::Context->dbh;
1174   my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1175   if ($avcode) {  
1176         my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1177         $sth->execute($avcode);
1178         while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) { 
1179                 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1180         }
1181         return \%values;
1182   } else {
1183         return;
1184   }
1185 }
1186
1187 =head2 xml_escape
1188
1189   my $escaped_string = C4::Koha::xml_escape($string);
1190
1191 Convert &, <, >, ', and " in a string to XML entities
1192
1193 =cut
1194
1195 sub xml_escape {
1196     my $str = shift;
1197     return '' unless defined $str;
1198     $str =~ s/&/&amp;/g;
1199     $str =~ s/</&lt;/g;
1200     $str =~ s/>/&gt;/g;
1201     $str =~ s/'/&apos;/g;
1202     $str =~ s/"/&quot;/g;
1203     return $str;
1204 }
1205
1206 =head2 GetKohaAuthorisedValueLib
1207
1208 Takes $category, $authorised_value as parameters.
1209
1210 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1211
1212 Returns authorised value description
1213
1214 =cut
1215
1216 sub GetKohaAuthorisedValueLib {
1217   my ($category,$authorised_value,$opac) = @_;
1218   my $value;
1219   my $dbh = C4::Context->dbh;
1220   my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1221   $sth->execute($category,$authorised_value);
1222   my $data = $sth->fetchrow_hashref;
1223   $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1224   return $value;
1225 }
1226
1227 =head2 display_marc_indicators
1228
1229   my $display_form = C4::Koha::display_marc_indicators($field);
1230
1231 C<$field> is a MARC::Field object
1232
1233 Generate a display form of the indicators of a variable
1234 MARC field, replacing any blanks with '#'.
1235
1236 =cut
1237
1238 sub display_marc_indicators {
1239     my $field = shift;
1240     my $indicators = '';
1241     if ($field->tag() >= 10) {
1242         $indicators = $field->indicator(1) . $field->indicator(2);
1243         $indicators =~ s/ /#/g;
1244     }
1245     return $indicators;
1246 }
1247
1248 sub GetNormalizedUPC {
1249  my ($record,$marcflavour) = @_;
1250     my (@fields,$upc);
1251
1252     if ($marcflavour eq 'UNIMARC') {
1253         @fields = $record->field('072');
1254         foreach my $field (@fields) {
1255             my $upc = _normalize_match_point($field->subfield('a'));
1256             if ($upc ne '') {
1257                 return $upc;
1258             }
1259         }
1260
1261     }
1262     else { # assume marc21 if not unimarc
1263         @fields = $record->field('024');
1264         foreach my $field (@fields) {
1265             my $indicator = $field->indicator(1);
1266             my $upc = _normalize_match_point($field->subfield('a'));
1267             if ($indicator == 1 and $upc ne '') {
1268                 return $upc;
1269             }
1270         }
1271     }
1272 }
1273
1274 # Normalizes and returns the first valid ISBN found in the record
1275 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
1276 sub GetNormalizedISBN {
1277     my ($isbn,$record,$marcflavour) = @_;
1278     my @fields;
1279     if ($isbn) {
1280         # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1281         # anything after " | " should be removed, along with the delimiter
1282         $isbn =~ s/(.*)( \| )(.*)/$1/;
1283         return _isbn_cleanup($isbn);
1284     }
1285     return unless $record;
1286
1287     if ($marcflavour eq 'UNIMARC') {
1288         @fields = $record->field('010');
1289         foreach my $field (@fields) {
1290             my $isbn = $field->subfield('a');
1291             if ($isbn) {
1292                 return _isbn_cleanup($isbn);
1293             } else {
1294                 return;
1295             }
1296         }
1297     }
1298     else { # assume marc21 if not unimarc
1299         @fields = $record->field('020');
1300         foreach my $field (@fields) {
1301             $isbn = $field->subfield('a');
1302             if ($isbn) {
1303                 return _isbn_cleanup($isbn);
1304             } else {
1305                 return;
1306             }
1307         }
1308     }
1309 }
1310
1311 sub GetNormalizedEAN {
1312     my ($record,$marcflavour) = @_;
1313     my (@fields,$ean);
1314
1315     if ($marcflavour eq 'UNIMARC') {
1316         @fields = $record->field('073');
1317         foreach my $field (@fields) {
1318             $ean = _normalize_match_point($field->subfield('a'));
1319             if ($ean ne '') {
1320                 return $ean;
1321             }
1322         }
1323     }
1324     else { # assume marc21 if not unimarc
1325         @fields = $record->field('024');
1326         foreach my $field (@fields) {
1327             my $indicator = $field->indicator(1);
1328             $ean = _normalize_match_point($field->subfield('a'));
1329             if ($indicator == 3 and $ean ne '') {
1330                 return $ean;
1331             }
1332         }
1333     }
1334 }
1335 sub GetNormalizedOCLCNumber {
1336     my ($record,$marcflavour) = @_;
1337     my (@fields,$oclc);
1338
1339     if ($marcflavour eq 'UNIMARC') {
1340         # TODO: add UNIMARC fields
1341     }
1342     else { # assume marc21 if not unimarc
1343         @fields = $record->field('035');
1344         foreach my $field (@fields) {
1345             $oclc = $field->subfield('a');
1346             if ($oclc =~ /OCoLC/) {
1347                 $oclc =~ s/\(OCoLC\)//;
1348                 return $oclc;
1349             } else {
1350                 return;
1351             }
1352         }
1353     }
1354 }
1355
1356 =head2 GetDailyQuote($opts)
1357
1358 Takes a hashref of options
1359
1360 Currently supported options are:
1361
1362 'id'        An exact quote id
1363 'random'    Select a random quote
1364 noop        When no option is passed in, this sub will return the quote timestamped for the current day
1365
1366 The function returns an anonymous hash following this format:
1367
1368         {
1369           'source' => 'source-of-quote',
1370           'timestamp' => 'timestamp-value',
1371           'text' => 'text-of-quote',
1372           'id' => 'quote-id'
1373         };
1374
1375 =cut
1376
1377 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1378 # at least for default option
1379
1380 sub GetDailyQuote {
1381     my %opts = @_;
1382     my $dbh = C4::Context->dbh;
1383     my $query = '';
1384     my $sth = undef;
1385     my $quote = undef;
1386     if ($opts{'id'}) {
1387         $query = 'SELECT * FROM quotes WHERE id = ?';
1388         $sth = $dbh->prepare($query);
1389         $sth->execute($opts{'id'});
1390         $quote = $sth->fetchrow_hashref();
1391     }
1392     elsif ($opts{'random'}) {
1393         # Fall through... we also return a random quote as a catch-all if all else fails
1394     }
1395     else {
1396         $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1397         $sth = $dbh->prepare($query);
1398         $sth->execute();
1399         $quote = $sth->fetchrow_hashref();
1400     }
1401     unless ($quote) {        # if there are not matches, choose a random quote
1402         # get a list of all available quote ids
1403         $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1404         $sth->execute;
1405         my $range = ($sth->fetchrow_array)[0];
1406         if ($range > 1) {
1407             # chose a random id within that range if there is more than one quote
1408             my $id = int(rand($range));
1409             # grab it
1410             $query = 'SELECT * FROM quotes WHERE id = ?;';
1411             $sth = C4::Context->dbh->prepare($query);
1412             $sth->execute($id);
1413         }
1414         else {
1415             $query = 'SELECT * FROM quotes;';
1416             $sth = C4::Context->dbh->prepare($query);
1417             $sth->execute();
1418         }
1419         $quote = $sth->fetchrow_hashref();
1420         # update the timestamp for that quote
1421         $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1422         $sth = C4::Context->dbh->prepare($query);
1423         $sth->execute(DateTime::Format::MySQL->format_datetime(DateTime->now), $quote->{'id'});
1424     }
1425     return $quote;
1426 }
1427
1428 sub _normalize_match_point {
1429     my $match_point = shift;
1430     (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1431     $normalized_match_point =~ s/-//g;
1432
1433     return $normalized_match_point;
1434 }
1435
1436 sub _isbn_cleanup {
1437     require Business::ISBN;
1438     my $isbn = Business::ISBN->new( $_[0] );
1439     if ( $isbn ) {
1440         $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13';
1441         if (defined $isbn) {
1442             return $isbn->as_string([]);
1443         }
1444     }
1445     return;
1446 }
1447
1448 1;
1449
1450 __END__
1451
1452 =head1 AUTHOR
1453
1454 Koha Team
1455
1456 =cut