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