Bug 5880: Correct misleading pod in new subroutine
[koha.git] / C4 / Koha.pm
1 package C4::Koha;
2
3 # Copyright 2000-2002 Katipo Communications
4 # Parts Copyright 2010 Nelsonville Public Library
5 #
6 # This file is part of Koha.
7 #
8 # Koha is free software; you can redistribute it and/or modify it under the
9 # terms of the GNU General Public License as published by the Free Software
10 # Foundation; either version 2 of the License, or (at your option) any later
11 # version.
12 #
13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
16 #
17 # You should have received a copy of the GNU General Public License along
18 # with Koha; if not, write to the Free Software Foundation, Inc.,
19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
20
21
22 use strict;
23 #use warnings; FIXME - Bug 2505
24 use C4::Context;
25 use C4::Output;
26 use URI::Split qw(uri_split);
27 use Memoize;
28 use Business::ISBN;
29
30 use vars qw($VERSION @ISA @EXPORT $DEBUG);
31
32 BEGIN {
33         $VERSION = 3.01;
34         require Exporter;
35         @ISA    = qw(Exporter);
36         @EXPORT = qw(
37                 &slashifyDate
38                 &subfield_is_koha_internal_p
39                 &GetPrinters &GetPrinter
40                 &GetItemTypes &getitemtypeinfo
41                 &GetCcodes
42                 &GetSupportName &GetSupportList
43                 &get_itemtypeinfos_of
44                 &getframeworks &getframeworkinfo
45                 &getauthtypes &getauthtype
46                 &getallthemes
47                 &getFacets
48                 &displayServers
49                 &getnbpages
50                 &get_infos_of
51                 &get_notforloan_label_of
52                 &getitemtypeimagedir
53                 &getitemtypeimagesrc
54                 &getitemtypeimagelocation
55                 &GetAuthorisedValues
56                 &GetAuthorisedValueCategories
57                 &GetKohaAuthorisedValues
58                 &GetKohaAuthorisedValuesFromField
59     &GetKohaAuthorisedValueLib
60     &GetAuthorisedValueByCode
61     &GetKohaImageurlFromAuthorisedValues
62                 &GetAuthValCode
63                 &GetNormalizedUPC
64                 &GetNormalizedISBN
65                 &GetNormalizedEAN
66                 &GetNormalizedOCLCNumber
67         &xml_escape
68
69                 $DEBUG
70         );
71         $DEBUG = 0;
72 }
73
74 # expensive functions
75 memoize('GetAuthorisedValues');
76
77 =head1 NAME
78
79 C4::Koha - Perl Module containing convenience functions for Koha scripts
80
81 =head1 SYNOPSIS
82
83 use C4::Koha;
84
85 =head1 DESCRIPTION
86
87 Koha.pm provides many functions for Koha scripts.
88
89 =head1 FUNCTIONS
90
91 =cut
92
93 =head2 slashifyDate
94
95   $slash_date = &slashifyDate($dash_date);
96
97 Takes a string of the form "DD-MM-YYYY" (or anything separated by
98 dashes), converts it to the form "YYYY/MM/DD", and returns the result.
99
100 =cut
101
102 sub slashifyDate {
103
104     # accepts a date of the form xx-xx-xx[xx] and returns it in the
105     # form xx/xx/xx[xx]
106     my @dateOut = split( '-', shift );
107     return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
108 }
109
110 # FIXME.. this should be moved to a MARC-specific module
111 sub subfield_is_koha_internal_p ($) {
112     my ($subfield) = @_;
113
114     # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
115     # But real MARC subfields are always single-character
116     # so it really is safer just to check the length
117
118     return length $subfield != 1;
119 }
120
121 =head2 GetSupportName
122
123   $itemtypename = &GetSupportName($codestring);
124
125 Returns a string with the name of the itemtype.
126
127 =cut
128
129 sub GetSupportName{
130         my ($codestring)=@_;
131         return if (! $codestring); 
132         my $resultstring;
133         my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
134         if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {  
135                 my $query = qq|
136                         SELECT description
137                         FROM   itemtypes
138                         WHERE itemtype=?
139                         order by description
140                 |;
141                 my $sth = C4::Context->dbh->prepare($query);
142                 $sth->execute($codestring);
143                 ($resultstring)=$sth->fetchrow;
144                 return $resultstring;
145         } else {
146         my $sth =
147             C4::Context->dbh->prepare(
148                     "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
149                     );
150         $sth->execute( $advanced_search_types, $codestring );
151         my $data = $sth->fetchrow_hashref;
152         return $$data{'lib'};
153         }
154
155 }
156 =head2 GetSupportList
157
158   $itemtypes = &GetSupportList();
159
160 Returns an array ref containing informations about Support (since itemtype is rather a circulation code when item-level-itypes is used).
161
162 build a HTML select with the following code :
163
164 =head3 in PERL SCRIPT
165
166     my $itemtypes = GetSupportList();
167     $template->param(itemtypeloop => $itemtypes);
168
169 =head3 in TEMPLATE
170
171     <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
172         <select name="itemtype">
173             <option value="">Default</option>
174         <!-- TMPL_LOOP name="itemtypeloop" -->
175             <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>
176         <!-- /TMPL_LOOP -->
177         </select>
178         <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
179         <input type="submit" value="OK" class="button">
180     </form>
181
182 =cut
183
184 sub GetSupportList{
185         my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
186         if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {  
187                 my $query = qq|
188                         SELECT *
189                         FROM   itemtypes
190                         order by description
191                 |;
192                 my $sth = C4::Context->dbh->prepare($query);
193                 $sth->execute;
194                 return $sth->fetchall_arrayref({});
195         } else {
196                 my $advsearchtypes = GetAuthorisedValues($advanced_search_types);
197                 my @results= map {{itemtype=>$$_{authorised_value},description=>$$_{lib},imageurl=>$$_{imageurl}}} @$advsearchtypes;
198                 return \@results;
199         }
200 }
201 =head2 GetItemTypes
202
203   $itemtypes = &GetItemTypes();
204
205 Returns information about existing itemtypes.
206
207 build a HTML select with the following code :
208
209 =head3 in PERL SCRIPT
210
211     my $itemtypes = GetItemTypes;
212     my @itemtypesloop;
213     foreach my $thisitemtype (sort keys %$itemtypes) {
214         my $selected = 1 if $thisitemtype eq $itemtype;
215         my %row =(value => $thisitemtype,
216                     selected => $selected,
217                     description => $itemtypes->{$thisitemtype}->{'description'},
218                 );
219         push @itemtypesloop, \%row;
220     }
221     $template->param(itemtypeloop => \@itemtypesloop);
222
223 =head3 in TEMPLATE
224
225     <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
226         <select name="itemtype">
227             <option value="">Default</option>
228         <!-- TMPL_LOOP name="itemtypeloop" -->
229             <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
230         <!-- /TMPL_LOOP -->
231         </select>
232         <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
233         <input type="submit" value="OK" class="button">
234     </form>
235
236 =cut
237
238 sub GetItemTypes {
239
240     # returns a reference to a hash of references to itemtypes...
241     my %itemtypes;
242     my $dbh   = C4::Context->dbh;
243     my $query = qq|
244         SELECT *
245         FROM   itemtypes
246     |;
247     my $sth = $dbh->prepare($query);
248     $sth->execute;
249     while ( my $IT = $sth->fetchrow_hashref ) {
250         $itemtypes{ $IT->{'itemtype'} } = $IT;
251     }
252     return ( \%itemtypes );
253 }
254
255 sub get_itemtypeinfos_of {
256     my @itemtypes = @_;
257
258     my $placeholders = join( ', ', map { '?' } @itemtypes );
259     my $query = <<"END_SQL";
260 SELECT itemtype,
261        description,
262        imageurl,
263        notforloan
264   FROM itemtypes
265   WHERE itemtype IN ( $placeholders )
266 END_SQL
267
268     return get_infos_of( $query, 'itemtype', undef, \@itemtypes );
269 }
270
271 # this is temporary until we separate collection codes and item types
272 sub GetCcodes {
273     my $count = 0;
274     my @results;
275     my $dbh = C4::Context->dbh;
276     my $sth =
277       $dbh->prepare(
278         "SELECT * FROM authorised_values ORDER BY authorised_value");
279     $sth->execute;
280     while ( my $data = $sth->fetchrow_hashref ) {
281         if ( $data->{category} eq "CCODE" ) {
282             $count++;
283             $results[$count] = $data;
284
285             #warn "data: $data";
286         }
287     }
288     $sth->finish;
289     return ( $count, @results );
290 }
291
292 =head2 getauthtypes
293
294   $authtypes = &getauthtypes();
295
296 Returns information about existing authtypes.
297
298 build a HTML select with the following code :
299
300 =head3 in PERL SCRIPT
301
302    my $authtypes = getauthtypes;
303    my @authtypesloop;
304    foreach my $thisauthtype (keys %$authtypes) {
305        my $selected = 1 if $thisauthtype eq $authtype;
306        my %row =(value => $thisauthtype,
307                 selected => $selected,
308                 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
309             );
310         push @authtypesloop, \%row;
311     }
312     $template->param(itemtypeloop => \@itemtypesloop);
313
314 =head3 in TEMPLATE
315
316   <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
317     <select name="authtype">
318     <!-- TMPL_LOOP name="authtypeloop" -->
319         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
320     <!-- /TMPL_LOOP -->
321     </select>
322     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
323     <input type="submit" value="OK" class="button">
324   </form>
325
326
327 =cut
328
329 sub getauthtypes {
330
331     # returns a reference to a hash of references to authtypes...
332     my %authtypes;
333     my $dbh = C4::Context->dbh;
334     my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
335     $sth->execute;
336     while ( my $IT = $sth->fetchrow_hashref ) {
337         $authtypes{ $IT->{'authtypecode'} } = $IT;
338     }
339     return ( \%authtypes );
340 }
341
342 sub getauthtype {
343     my ($authtypecode) = @_;
344
345     # returns a reference to a hash of references to authtypes...
346     my %authtypes;
347     my $dbh = C4::Context->dbh;
348     my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
349     $sth->execute($authtypecode);
350     my $res = $sth->fetchrow_hashref;
351     return $res;
352 }
353
354 =head2 getframework
355
356   $frameworks = &getframework();
357
358 Returns information about existing frameworks
359
360 build a HTML select with the following code :
361
362 =head3 in PERL SCRIPT
363
364   my $frameworks = frameworks();
365   my @frameworkloop;
366   foreach my $thisframework (keys %$frameworks) {
367     my $selected = 1 if $thisframework eq $frameworkcode;
368     my %row =(value => $thisframework,
369                 selected => $selected,
370                 description => $frameworks->{$thisframework}->{'frameworktext'},
371             );
372     push @frameworksloop, \%row;
373   }
374   $template->param(frameworkloop => \@frameworksloop);
375
376 =head3 in TEMPLATE
377
378   <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
379     <select name="frameworkcode">
380         <option value="">Default</option>
381     <!-- TMPL_LOOP name="frameworkloop" -->
382         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
383     <!-- /TMPL_LOOP -->
384     </select>
385     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
386     <input type="submit" value="OK" class="button">
387   </form>
388
389 =cut
390
391 sub getframeworks {
392
393     # returns a reference to a hash of references to branches...
394     my %itemtypes;
395     my $dbh = C4::Context->dbh;
396     my $sth = $dbh->prepare("select * from biblio_framework");
397     $sth->execute;
398     while ( my $IT = $sth->fetchrow_hashref ) {
399         $itemtypes{ $IT->{'frameworkcode'} } = $IT;
400     }
401     return ( \%itemtypes );
402 }
403
404 =head2 getframeworkinfo
405
406   $frameworkinfo = &getframeworkinfo($frameworkcode);
407
408 Returns information about an frameworkcode.
409
410 =cut
411
412 sub getframeworkinfo {
413     my ($frameworkcode) = @_;
414     my $dbh             = C4::Context->dbh;
415     my $sth             =
416       $dbh->prepare("select * from biblio_framework where frameworkcode=?");
417     $sth->execute($frameworkcode);
418     my $res = $sth->fetchrow_hashref;
419     return $res;
420 }
421
422 =head2 getitemtypeinfo
423
424   $itemtype = &getitemtype($itemtype);
425
426 Returns information about an itemtype.
427
428 =cut
429
430 sub getitemtypeinfo {
431     my ($itemtype) = @_;
432     my $dbh        = C4::Context->dbh;
433     my $sth        = $dbh->prepare("select * from itemtypes where itemtype=?");
434     $sth->execute($itemtype);
435     my $res = $sth->fetchrow_hashref;
436
437     $res->{imageurl} = getitemtypeimagelocation( 'intranet', $res->{imageurl} );
438
439     return $res;
440 }
441
442 =head2 getitemtypeimagedir
443
444   my $directory = getitemtypeimagedir( 'opac' );
445
446 pass in 'opac' or 'intranet'. Defaults to 'opac'.
447
448 returns the full path to the appropriate directory containing images.
449
450 =cut
451
452 sub getitemtypeimagedir {
453         my $src = shift || 'opac';
454         if ($src eq 'intranet') {
455                 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
456         } else {
457                 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('template') . '/itemtypeimg';
458         }
459 }
460
461 sub getitemtypeimagesrc {
462         my $src = shift || 'opac';
463         if ($src eq 'intranet') {
464                 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
465         } else {
466                 return '/opac-tmpl' . '/' . C4::Context->preference('template') . '/itemtypeimg';
467         }
468 }
469
470 sub getitemtypeimagelocation($$) {
471         my ( $src, $image ) = @_;
472
473         return '' if ( !$image );
474
475         my $scheme = ( uri_split( $image ) )[0];
476
477         return $image if ( $scheme );
478
479         return getitemtypeimagesrc( $src ) . '/' . $image;
480 }
481
482 =head3 _getImagesFromDirectory
483
484 Find all of the image files in a directory in the filesystem
485
486 parameters: a directory name
487
488 returns: a list of images in that directory.
489
490 Notes: this does not traverse into subdirectories. See
491 _getSubdirectoryNames for help with that.
492 Images are assumed to be files with .gif or .png file extensions.
493 The image names returned do not have the directory name on them.
494
495 =cut
496
497 sub _getImagesFromDirectory {
498     my $directoryname = shift;
499     return unless defined $directoryname;
500     return unless -d $directoryname;
501
502     if ( opendir ( my $dh, $directoryname ) ) {
503         my @images = grep { /\.(gif|png)$/i } readdir( $dh );
504         closedir $dh;
505         @images = sort(@images);
506         return @images;
507     } else {
508         warn "unable to opendir $directoryname: $!";
509         return;
510     }
511 }
512
513 =head3 _getSubdirectoryNames
514
515 Find all of the directories in a directory in the filesystem
516
517 parameters: a directory name
518
519 returns: a list of subdirectories in that directory.
520
521 Notes: this does not traverse into subdirectories. Only the first
522 level of subdirectories are returned.
523 The directory names returned don't have the parent directory name on them.
524
525 =cut
526
527 sub _getSubdirectoryNames {
528     my $directoryname = shift;
529     return unless defined $directoryname;
530     return unless -d $directoryname;
531
532     if ( opendir ( my $dh, $directoryname ) ) {
533         my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
534         closedir $dh;
535         return @directories;
536     } else {
537         warn "unable to opendir $directoryname: $!";
538         return;
539     }
540 }
541
542 =head3 getImageSets
543
544 returns: a listref of hashrefs. Each hash represents another collection of images.
545
546  { imagesetname => 'npl', # the name of the image set (npl is the original one)
547          images => listref of image hashrefs
548  }
549
550 each image is represented by a hashref like this:
551
552  { KohaImage     => 'npl/image.gif',
553    StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
554    OpacImageURL  => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
555    checked       => 0 or 1: was this the image passed to this method?
556                     Note: I'd like to remove this somehow.
557  }
558
559 =cut
560
561 sub getImageSets {
562     my %params = @_;
563     my $checked = $params{'checked'} || '';
564
565     my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
566                              url        => getitemtypeimagesrc('intranet'),
567                         },
568                   opac => { filesystem => getitemtypeimagedir('opac'),
569                              url       => getitemtypeimagesrc('opac'),
570                         }
571                   };
572
573     my @imagesets = (); # list of hasrefs of image set data to pass to template
574     my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
575 warn $paths->{'staff'}{'filesystem'};
576     foreach my $imagesubdir ( @subdirectories ) {
577         warn $imagesubdir;
578         my @imagelist     = (); # hashrefs of image info
579         my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
580         my $imagesetactive = 0;
581         foreach my $thisimage ( @imagenames ) {
582             push( @imagelist,
583                   { KohaImage     => "$imagesubdir/$thisimage",
584                     StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
585                     OpacImageUrl  => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
586                     checked       => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
587                }
588              );
589              $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
590         }
591         push @imagesets, { imagesetname => $imagesubdir,
592                            imagesetactive => $imagesetactive,
593                            images       => \@imagelist };
594         
595     }
596     return \@imagesets;
597 }
598
599 =head2 GetPrinters
600
601   $printers = &GetPrinters();
602   @queues = keys %$printers;
603
604 Returns information about existing printer queues.
605
606 C<$printers> is a reference-to-hash whose keys are the print queues
607 defined in the printers table of the Koha database. The values are
608 references-to-hash, whose keys are the fields in the printers table.
609
610 =cut
611
612 sub GetPrinters {
613     my %printers;
614     my $dbh = C4::Context->dbh;
615     my $sth = $dbh->prepare("select * from printers");
616     $sth->execute;
617     while ( my $printer = $sth->fetchrow_hashref ) {
618         $printers{ $printer->{'printqueue'} } = $printer;
619     }
620     return ( \%printers );
621 }
622
623 =head2 GetPrinter
624
625   $printer = GetPrinter( $query, $printers );
626
627 =cut
628
629 sub GetPrinter ($$) {
630     my ( $query, $printers ) = @_;    # get printer for this query from printers
631     my $printer = $query->param('printer');
632     my %cookie = $query->cookie('userenv');
633     ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
634     ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
635     return $printer;
636 }
637
638 =head2 getnbpages
639
640 Returns the number of pages to display in a pagination bar, given the number
641 of items and the number of items per page.
642
643 =cut
644
645 sub getnbpages {
646     my ( $nb_items, $nb_items_per_page ) = @_;
647
648     return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
649 }
650
651 =head2 getallthemes
652
653   (@themes) = &getallthemes('opac');
654   (@themes) = &getallthemes('intranet');
655
656 Returns an array of all available themes.
657
658 =cut
659
660 sub getallthemes {
661     my $type = shift;
662     my $htdocs;
663     my @themes;
664     if ( $type eq 'intranet' ) {
665         $htdocs = C4::Context->config('intrahtdocs');
666     }
667     else {
668         $htdocs = C4::Context->config('opachtdocs');
669     }
670     opendir D, "$htdocs";
671     my @dirlist = readdir D;
672     foreach my $directory (@dirlist) {
673         -d "$htdocs/$directory/en" and push @themes, $directory;
674     }
675     return @themes;
676 }
677
678 sub getFacets {
679     my $facets;
680     if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
681         $facets = [
682             {
683                 link_value  => 'su-to',
684                 label_value => 'Topics',
685                 tags        =>
686                   [ '600', '601', '602', '603', '604', '605', '606', '610' ],
687                 subfield => 'a',
688             },
689             {
690                 link_value  => 'su-geo',
691                 label_value => 'Places',
692                 tags        => ['651'],
693                 subfield    => 'a',
694             },
695             {
696                 link_value  => 'su-ut',
697                 label_value => 'Titles',
698                 tags        => [ '500', '501', '502', '503', '504', ],
699                 subfield    => 'a',
700             },
701             {
702                 link_value  => 'au',
703                 label_value => 'Authors',
704                 tags        => [ '700', '701', '702', ],
705                 subfield    => 'a',
706             },
707             {
708                 link_value  => 'se',
709                 label_value => 'Series',
710                 tags        => ['225'],
711                 subfield    => 'a',
712             },
713             ];
714
715             my $library_facet;
716
717             $library_facet = {
718                 link_value  => 'branch',
719                 label_value => 'Libraries',
720                 tags        => [ '995', ],
721                 subfield    => 'b',
722                 expanded    => '1',
723             };
724             push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
725     }
726     else {
727         $facets = [
728             {
729                 link_value  => 'su-to',
730                 label_value => 'Topics',
731                 tags        => ['650'],
732                 subfield    => 'a',
733             },
734
735             #        {
736             #        link_value => 'su-na',
737             #        label_value => 'People and Organizations',
738             #        tags => ['600', '610', '611'],
739             #        subfield => 'a',
740             #        },
741             {
742                 link_value  => 'su-geo',
743                 label_value => 'Places',
744                 tags        => ['651'],
745                 subfield    => 'a',
746             },
747             {
748                 link_value  => 'su-ut',
749                 label_value => 'Titles',
750                 tags        => ['630'],
751                 subfield    => 'a',
752             },
753             {
754                 link_value  => 'au',
755                 label_value => 'Authors',
756                 tags        => [ '100', '110', '700', ],
757                 subfield    => 'a',
758             },
759             {
760                 link_value  => 'se',
761                 label_value => 'Series',
762                 tags        => [ '440', '490', ],
763                 subfield    => 'a',
764             },
765             ];
766             my $library_facet;
767             $library_facet = {
768                 link_value  => 'branch',
769                 label_value => 'Libraries',
770                 tags        => [ '952', ],
771                 subfield    => 'b',
772                 expanded    => '1',
773             };
774             push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
775     }
776     return $facets;
777 }
778
779 =head2 get_infos_of
780
781 Return a href where a key is associated to a href. You give a query,
782 the name of the key among the fields returned by the query. If you
783 also give as third argument the name of the value, the function
784 returns a href of scalar. The optional 4th argument is an arrayref of
785 items passed to the C<execute()> call. It is designed to bind
786 parameters to any placeholders in your SQL.
787
788   my $query = '
789 SELECT itemnumber,
790        notforloan,
791        barcode
792   FROM items
793 ';
794
795   # generic href of any information on the item, href of href.
796   my $iteminfos_of = get_infos_of($query, 'itemnumber');
797   print $iteminfos_of->{$itemnumber}{barcode};
798
799   # specific information, href of scalar
800   my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
801   print $barcode_of_item->{$itemnumber};
802
803 =cut
804
805 sub get_infos_of {
806     my ( $query, $key_name, $value_name, $bind_params ) = @_;
807
808     my $dbh = C4::Context->dbh;
809
810     my $sth = $dbh->prepare($query);
811     $sth->execute( @$bind_params );
812
813     my %infos_of;
814     while ( my $row = $sth->fetchrow_hashref ) {
815         if ( defined $value_name ) {
816             $infos_of{ $row->{$key_name} } = $row->{$value_name};
817         }
818         else {
819             $infos_of{ $row->{$key_name} } = $row;
820         }
821     }
822     $sth->finish;
823
824     return \%infos_of;
825 }
826
827 =head2 get_notforloan_label_of
828
829   my $notforloan_label_of = get_notforloan_label_of();
830
831 Each authorised value of notforloan (information available in items and
832 itemtypes) is link to a single label.
833
834 Returns a href where keys are authorised values and values are corresponding
835 labels.
836
837   foreach my $authorised_value (keys %{$notforloan_label_of}) {
838     printf(
839         "authorised_value: %s => %s\n",
840         $authorised_value,
841         $notforloan_label_of->{$authorised_value}
842     );
843   }
844
845 =cut
846
847 # FIXME - why not use GetAuthorisedValues ??
848 #
849 sub get_notforloan_label_of {
850     my $dbh = C4::Context->dbh;
851
852     my $query = '
853 SELECT authorised_value
854   FROM marc_subfield_structure
855   WHERE kohafield = \'items.notforloan\'
856   LIMIT 0, 1
857 ';
858     my $sth = $dbh->prepare($query);
859     $sth->execute();
860     my ($statuscode) = $sth->fetchrow_array();
861
862     $query = '
863 SELECT lib,
864        authorised_value
865   FROM authorised_values
866   WHERE category = ?
867 ';
868     $sth = $dbh->prepare($query);
869     $sth->execute($statuscode);
870     my %notforloan_label_of;
871     while ( my $row = $sth->fetchrow_hashref ) {
872         $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
873     }
874     $sth->finish;
875
876     return \%notforloan_label_of;
877 }
878
879 =head2 displayServers
880
881    my $servers = displayServers();
882    my $servers = displayServers( $position );
883    my $servers = displayServers( $position, $type );
884
885 displayServers returns a listref of hashrefs, each containing
886 information about available z3950 servers. Each hashref has a format
887 like:
888
889     {
890       'checked'    => 'checked',
891       'encoding'   => 'MARC-8'
892       'icon'       => undef,
893       'id'         => 'LIBRARY OF CONGRESS',
894       'label'      => '',
895       'name'       => 'server',
896       'opensearch' => '',
897       'value'      => 'z3950.loc.gov:7090/',
898       'zed'        => 1,
899     },
900
901 =cut
902
903 sub displayServers {
904     my ( $position, $type ) = @_;
905     my $dbh = C4::Context->dbh;
906
907     my $strsth = 'SELECT * FROM z3950servers';
908     my @where_clauses;
909     my @bind_params;
910
911     if ($position) {
912         push @bind_params,   $position;
913         push @where_clauses, ' position = ? ';
914     }
915
916     if ($type) {
917         push @bind_params,   $type;
918         push @where_clauses, ' type = ? ';
919     }
920
921     # reassemble where clause from where clause pieces
922     if (@where_clauses) {
923         $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
924     }
925
926     my $rq = $dbh->prepare($strsth);
927     $rq->execute(@bind_params);
928     my @primaryserverloop;
929
930     while ( my $data = $rq->fetchrow_hashref ) {
931         push @primaryserverloop,
932           { label    => $data->{description},
933             id       => $data->{name},
934             name     => "server",
935             value    => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
936             encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
937             checked  => "checked",
938             icon     => $data->{icon},
939             zed        => $data->{type} eq 'zed',
940             opensearch => $data->{type} eq 'opensearch'
941           };
942     }
943     return \@primaryserverloop;
944 }
945
946
947 =head2 GetKohaImageurlFromAuthorisedValues
948
949 $authhorised_value = GetKohaImageurlFromAuthorisedValues( $category, $authvalcode );
950
951 Return the first url of the authorised value image represented by $lib.
952
953 =cut
954
955 sub GetKohaImageurlFromAuthorisedValues {
956     my ( $category, $lib ) = @_;
957     my $dbh = C4::Context->dbh;
958     my $sth = $dbh->prepare("SELECT imageurl FROM authorised_values WHERE category=? AND lib =?");
959     $sth->execute( $category, $lib );
960     while ( my $data = $sth->fetchrow_hashref ) {
961         return $data->{'imageurl'};
962     }
963 }
964
965 =head2 GetAuthValCode
966
967   $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
968
969 =cut
970
971 sub GetAuthValCode {
972         my ($kohafield,$fwcode) = @_;
973         my $dbh = C4::Context->dbh;
974         $fwcode='' unless $fwcode;
975         my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
976         $sth->execute($kohafield,$fwcode);
977         my ($authvalcode) = $sth->fetchrow_array;
978         return $authvalcode;
979 }
980
981 =head2 GetAuthValCodeFromField
982
983   $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
984
985 C<$subfield> can be undefined
986
987 =cut
988
989 sub GetAuthValCodeFromField {
990         my ($field,$subfield,$fwcode) = @_;
991         my $dbh = C4::Context->dbh;
992         $fwcode='' unless $fwcode;
993         my $sth;
994         if (defined $subfield) {
995             $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
996             $sth->execute($field,$subfield,$fwcode);
997         } else {
998             $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
999             $sth->execute($field,$fwcode);
1000         }
1001         my ($authvalcode) = $sth->fetchrow_array;
1002         return $authvalcode;
1003 }
1004
1005 =head2 GetAuthorisedValues
1006
1007   $authvalues = GetAuthorisedValues([$category], [$selected]);
1008
1009 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
1010
1011 C<$category> returns authorised values for just one category (optional).
1012
1013 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1014
1015 =cut
1016
1017 sub GetAuthorisedValues {
1018     my ($category,$selected,$opac) = @_;
1019         my @results;
1020     my $dbh      = C4::Context->dbh;
1021     my $query    = "SELECT * FROM authorised_values";
1022     $query .= " WHERE category = '" . $category . "'" if $category;
1023     $query .= " ORDER BY category, lib, lib_opac";
1024     my $sth = $dbh->prepare($query);
1025     $sth->execute;
1026         while (my $data=$sth->fetchrow_hashref) {
1027             if ($selected && $selected eq $data->{'authorised_value'} ) {
1028                     $data->{'selected'} = 1;
1029             }
1030             if ($opac && $data->{'lib_opac'}) {
1031                 $data->{'lib'} = $data->{'lib_opac'};
1032             }
1033             push @results, $data;
1034         }
1035     #my $data = $sth->fetchall_arrayref({});
1036     return \@results; #$data;
1037 }
1038
1039 =head2 GetAuthorisedValueCategories
1040
1041   $auth_categories = GetAuthorisedValueCategories();
1042
1043 Return an arrayref of all of the available authorised
1044 value categories.
1045
1046 =cut
1047
1048 sub GetAuthorisedValueCategories {
1049     my $dbh = C4::Context->dbh;
1050     my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1051     $sth->execute;
1052     my @results;
1053     while (my $category = $sth->fetchrow_array) {
1054         push @results, $category;
1055     }
1056     return \@results;
1057 }
1058
1059 =head2 GetAuthorisedValueByCode
1060
1061 $authhorised_value = GetAuthorisedValueByCode( $category, $authvalcode );
1062
1063 Return the lib attribute from authorised_values from the row identified
1064 by the passed category and code
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