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