fixing permissions on scripts
[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 # $Id$
21
22 use strict;
23 require Exporter;
24 use C4::Context;
25 use C4::Output;
26 our ($VERSION,@ISA,@EXPORT);
27
28 $VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
29
30 =head1 NAME
31
32     C4::Koha - Perl Module containing convenience functions for Koha scripts
33
34 =head1 SYNOPSIS
35
36   use C4::Koha;
37
38
39 =head1 DESCRIPTION
40
41     Koha.pm provides many functions for Koha scripts.
42
43 =head1 FUNCTIONS
44
45 =over 2
46
47 =cut
48
49 @ISA    = qw(Exporter);
50 @EXPORT = qw(
51   &slashifyDate
52   &DisplayISBN
53   &subfield_is_koha_internal_p
54   &GetPrinters &GetPrinter
55   &GetItemTypes &getitemtypeinfo
56   &GetCcodes
57   &GetAuthItemlost
58   &GetAuthItembinding
59   &get_itemtypeinfos_of
60   &getframeworks &getframeworkinfo
61   &getauthtypes &getauthtype
62   &getallthemes
63   &getFacets
64   &displaySortby
65   &displayIndexes
66   &displaySubtypesLimit
67   &displayLimitTypes
68   &displayServers
69   &getnbpages
70   &getitemtypeimagesrcfromurl
71   &get_infos_of
72   &get_notforloan_label_of
73   &getitemtypeimagedir
74   &getitemtypeimagesrc
75   &GetAuthorisedValues
76   &FixEncoding
77   &GetKohaAuthorisedValues
78   &GetManagedTagSubfields
79
80   $DEBUG
81   );
82
83 my $DEBUG = 0;
84
85 =head2 slashifyDate
86
87   $slash_date = &slashifyDate($dash_date);
88
89     Takes a string of the form "DD-MM-YYYY" (or anything separated by
90     dashes), converts it to the form "YYYY/MM/DD", and returns the result.
91
92 =cut
93
94 sub slashifyDate {
95
96     # accepts a date of the form xx-xx-xx[xx] and returns it in the
97     # form xx/xx/xx[xx]
98     my @dateOut = split( '-', shift );
99     return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
100 }
101
102
103 =head2 DisplayISBN
104
105     my $string = DisplayISBN( $isbn );
106
107 =cut
108
109 sub DisplayISBN {
110     my ($isbn) = @_;
111     my $seg1;
112     if ( substr( $isbn, 0, 1 ) <= 7 ) {
113         $seg1 = substr( $isbn, 0, 1 );
114     }
115     elsif ( substr( $isbn, 0, 2 ) <= 94 ) {
116         $seg1 = substr( $isbn, 0, 2 );
117     }
118     elsif ( substr( $isbn, 0, 3 ) <= 995 ) {
119         $seg1 = substr( $isbn, 0, 3 );
120     }
121     elsif ( substr( $isbn, 0, 4 ) <= 9989 ) {
122         $seg1 = substr( $isbn, 0, 4 );
123     }
124     else {
125         $seg1 = substr( $isbn, 0, 5 );
126     }
127     my $x = substr( $isbn, length($seg1) );
128     my $seg2;
129     if ( substr( $x, 0, 2 ) <= 19 ) {
130
131         # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
132         $seg2 = substr( $x, 0, 2 );
133     }
134     elsif ( substr( $x, 0, 3 ) <= 699 ) {
135         $seg2 = substr( $x, 0, 3 );
136     }
137     elsif ( substr( $x, 0, 4 ) <= 8399 ) {
138         $seg2 = substr( $x, 0, 4 );
139     }
140     elsif ( substr( $x, 0, 5 ) <= 89999 ) {
141         $seg2 = substr( $x, 0, 5 );
142     }
143     elsif ( substr( $x, 0, 6 ) <= 9499999 ) {
144         $seg2 = substr( $x, 0, 6 );
145     }
146     else {
147         $seg2 = substr( $x, 0, 7 );
148     }
149     my $seg3 = substr( $x, length($seg2) );
150     $seg3 = substr( $seg3, 0, length($seg3) - 1 );
151     my $seg4 = substr( $x, -1, 1 );
152     return "$seg1-$seg2-$seg3-$seg4";
153 }
154
155 # FIXME.. this should be moved to a MARC-specific module
156 sub subfield_is_koha_internal_p ($) {
157     my ($subfield) = @_;
158
159     # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
160     # But real MARC subfields are always single-character
161     # so it really is safer just to check the length
162
163     return length $subfield != 1;
164 }
165
166 =head2 GetItemTypes
167
168   $itemtypes = &GetItemTypes();
169
170 Returns information about existing itemtypes.
171
172 build a HTML select with the following code :
173
174 =head3 in PERL SCRIPT
175
176     my $itemtypes = GetItemTypes;
177     my @itemtypesloop;
178     foreach my $thisitemtype (sort keys %$itemtypes) {
179         my $selected = 1 if $thisitemtype eq $itemtype;
180         my %row =(value => $thisitemtype,
181                     selected => $selected,
182                     description => $itemtypes->{$thisitemtype}->{'description'},
183                 );
184         push @itemtypesloop, \%row;
185     }
186     $template->param(itemtypeloop => \@itemtypesloop);
187
188 =head3 in TEMPLATE
189
190     <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
191         <select name="itemtype">
192             <option value="">Default</option>
193         <!-- TMPL_LOOP name="itemtypeloop" -->
194             <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
195         <!-- /TMPL_LOOP -->
196         </select>
197         <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
198         <input type="submit" value="OK" class="button">
199     </form>
200
201 =cut
202
203 sub GetItemTypes {
204
205     # returns a reference to a hash of references to branches...
206     my %itemtypes;
207     my $dbh   = C4::Context->dbh;
208     my $query = qq|
209         SELECT *
210         FROM   itemtypes
211     |;
212     my $sth = $dbh->prepare($query);
213     $sth->execute;
214     while ( my $IT = $sth->fetchrow_hashref ) {
215         $itemtypes{ $IT->{'itemtype'} } = $IT;
216     }
217     return ( \%itemtypes );
218 }
219
220 sub get_itemtypeinfos_of {
221     my @itemtypes = @_;
222
223     my $query = '
224 SELECT itemtype,
225        description,
226        notforloan
227   FROM itemtypes
228   WHERE itemtype IN (' . join( ',', map( { "'" . $_ . "'" } @itemtypes ) ) . ')
229 ';
230
231     return get_infos_of( $query, 'itemtype' );
232 }
233
234 # this is temporary until we separate collection codes and item types
235 sub GetCcodes {
236     my $count = 0;
237     my @results;
238     my $dbh = C4::Context->dbh;
239     my $sth =
240       $dbh->prepare(
241         "SELECT * FROM authorised_values ORDER BY authorised_value");
242     $sth->execute;
243     while ( my $data = $sth->fetchrow_hashref ) {
244         if ( $data->{category} eq "CCODE" ) {
245             $count++;
246             $results[$count] = $data;
247
248             #warn "data: $data";
249         }
250     }
251     $sth->finish;
252     return ( $count, @results );
253 }
254
255 =head2
256
257 grab itemlost authorized values
258
259 =cut
260
261 sub GetAuthItemlost {
262     my $itemlost = shift;
263     my $count    = 0;
264     my @results;
265     my $dbh = C4::Context->dbh;
266     my $sth =
267       $dbh->prepare(
268         "SELECT * FROM authorised_values ORDER BY authorised_value");
269     $sth->execute;
270     while ( my $data = $sth->fetchrow_hashref ) {
271         if ( $data->{category} eq "ITEMLOST" ) {
272             $count++;
273             if ( $itemlost eq $data->{'authorised_value'} ) {
274                 $data->{'selected'} = 1;
275             }
276             $results[$count] = $data;
277
278             #warn "data: $data";
279         }
280     }
281     $sth->finish;
282     return ( $count, @results );
283 }
284
285 =head2 GetAuthItembinding
286
287 grab itemlost authorized values
288
289 =cut
290
291 sub GetAuthItembinding {
292     my $itembinding = shift;
293     my $count       = 0;
294     my @results;
295     my $dbh = C4::Context->dbh;
296     my $sth =
297       $dbh->prepare(
298         "SELECT * FROM authorised_values ORDER BY authorised_value");
299     $sth->execute;
300     while ( my $data = $sth->fetchrow_hashref ) {
301         if ( $data->{category} eq "BINDING" ) {
302             $count++;
303             if ( $itembinding eq $data->{'authorised_value'} ) {
304                 $data->{'selected'} = 1;
305             }
306             $results[$count] = $data;
307
308             #warn "data: $data";
309         }
310     }
311     $sth->finish;
312     return ( $count, @results );
313 }
314
315 =head2 getauthtypes
316
317   $authtypes = &getauthtypes();
318
319 Returns information about existing authtypes.
320
321 build a HTML select with the following code :
322
323 =head3 in PERL SCRIPT
324
325 my $authtypes = getauthtypes;
326 my @authtypesloop;
327 foreach my $thisauthtype (keys %$authtypes) {
328     my $selected = 1 if $thisauthtype eq $authtype;
329     my %row =(value => $thisauthtype,
330                 selected => $selected,
331                 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
332             );
333     push @authtypesloop, \%row;
334 }
335 $template->param(itemtypeloop => \@itemtypesloop);
336
337 =head3 in TEMPLATE
338
339 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
340     <select name="authtype">
341     <!-- TMPL_LOOP name="authtypeloop" -->
342         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
343     <!-- /TMPL_LOOP -->
344     </select>
345     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
346     <input type="submit" value="OK" class="button">
347 </form>
348
349
350 =cut
351
352 sub getauthtypes {
353
354     # returns a reference to a hash of references to authtypes...
355     my %authtypes;
356     my $dbh = C4::Context->dbh;
357     my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
358     $sth->execute;
359     while ( my $IT = $sth->fetchrow_hashref ) {
360         $authtypes{ $IT->{'authtypecode'} } = $IT;
361     }
362     return ( \%authtypes );
363 }
364
365 sub getauthtype {
366     my ($authtypecode) = @_;
367
368     # returns a reference to a hash of references to authtypes...
369     my %authtypes;
370     my $dbh = C4::Context->dbh;
371     my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
372     $sth->execute($authtypecode);
373     my $res = $sth->fetchrow_hashref;
374     return $res;
375 }
376
377 =head2 getframework
378
379   $frameworks = &getframework();
380
381 Returns information about existing frameworks
382
383 build a HTML select with the following code :
384
385 =head3 in PERL SCRIPT
386
387 my $frameworks = frameworks();
388 my @frameworkloop;
389 foreach my $thisframework (keys %$frameworks) {
390     my $selected = 1 if $thisframework eq $frameworkcode;
391     my %row =(value => $thisframework,
392                 selected => $selected,
393                 description => $frameworks->{$thisframework}->{'frameworktext'},
394             );
395     push @frameworksloop, \%row;
396 }
397 $template->param(frameworkloop => \@frameworksloop);
398
399 =head3 in TEMPLATE
400
401 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
402     <select name="frameworkcode">
403         <option value="">Default</option>
404     <!-- TMPL_LOOP name="frameworkloop" -->
405         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
406     <!-- /TMPL_LOOP -->
407     </select>
408     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
409     <input type="submit" value="OK" class="button">
410 </form>
411
412
413 =cut
414
415 sub getframeworks {
416
417     # returns a reference to a hash of references to branches...
418     my %itemtypes;
419     my $dbh = C4::Context->dbh;
420     my $sth = $dbh->prepare("select * from biblio_framework");
421     $sth->execute;
422     while ( my $IT = $sth->fetchrow_hashref ) {
423         $itemtypes{ $IT->{'frameworkcode'} } = $IT;
424     }
425     return ( \%itemtypes );
426 }
427
428 =head2 getframeworkinfo
429
430   $frameworkinfo = &getframeworkinfo($frameworkcode);
431
432 Returns information about an frameworkcode.
433
434 =cut
435
436 sub getframeworkinfo {
437     my ($frameworkcode) = @_;
438     my $dbh             = C4::Context->dbh;
439     my $sth             =
440       $dbh->prepare("select * from biblio_framework where frameworkcode=?");
441     $sth->execute($frameworkcode);
442     my $res = $sth->fetchrow_hashref;
443     return $res;
444 }
445
446 =head2 getitemtypeinfo
447
448   $itemtype = &getitemtype($itemtype);
449
450 Returns information about an itemtype.
451
452 =cut
453
454 sub getitemtypeinfo {
455     my ($itemtype) = @_;
456     my $dbh        = C4::Context->dbh;
457     my $sth        = $dbh->prepare("select * from itemtypes where itemtype=?");
458     $sth->execute($itemtype);
459     my $res = $sth->fetchrow_hashref;
460
461     $res->{imageurl} = getitemtypeimagesrcfromurl( $res->{imageurl} );
462
463     return $res;
464 }
465
466 sub getitemtypeimagesrcfromurl {
467     my ($imageurl) = @_;
468
469     if ( defined $imageurl and $imageurl !~ m/^http/ ) {
470         $imageurl = getitemtypeimagesrc() . '/' . $imageurl;
471     }
472
473     return $imageurl;
474 }
475
476 sub getitemtypeimagedir {
477     return C4::Context->opachtdocs . '/'
478       . C4::Context->preference('template')
479       . '/itemtypeimg';
480 }
481
482 sub getitemtypeimagesrc {
483     return '/opac-tmpl' . '/'
484       . C4::Context->preference('template')
485       . '/itemtypeimg';
486 }
487
488 =head2 GetPrinters
489
490   $printers = &GetPrinters();
491   @queues = keys %$printers;
492
493 Returns information about existing printer queues.
494
495 C<$printers> is a reference-to-hash whose keys are the print queues
496 defined in the printers table of the Koha database. The values are
497 references-to-hash, whose keys are the fields in the printers table.
498
499 =cut
500
501 sub GetPrinters {
502     my %printers;
503     my $dbh = C4::Context->dbh;
504     my $sth = $dbh->prepare("select * from printers");
505     $sth->execute;
506     while ( my $printer = $sth->fetchrow_hashref ) {
507         $printers{ $printer->{'printqueue'} } = $printer;
508     }
509     return ( \%printers );
510 }
511
512 =head2 GetPrinter
513
514 $printer = GetPrinter( $query, $printers );
515
516 =cut
517
518 sub GetPrinter ($$) {
519     my ( $query, $printers ) = @_;    # get printer for this query from printers
520     my $printer = $query->param('printer');
521     my %cookie = $query->cookie('userenv');
522     ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
523     ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
524     return $printer;
525 }
526
527 =item getnbpages
528
529 Returns the number of pages to display in a pagination bar, given the number
530 of items and the number of items per page.
531
532 =cut
533
534 sub getnbpages {
535     my ( $nb_items, $nb_items_per_page ) = @_;
536
537     return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
538 }
539
540 =item getallthemes
541
542   (@themes) = &getallthemes('opac');
543   (@themes) = &getallthemes('intranet');
544
545 Returns an array of all available themes.
546
547 =cut
548
549 sub getallthemes {
550     my $type = shift;
551     my $htdocs;
552     my @themes;
553     if ( $type eq 'intranet' ) {
554         $htdocs = C4::Context->config('intrahtdocs');
555     }
556     else {
557         $htdocs = C4::Context->config('opachtdocs');
558     }
559     opendir D, "$htdocs";
560     my @dirlist = readdir D;
561     foreach my $directory (@dirlist) {
562         -d "$htdocs/$directory/en" and push @themes, $directory;
563     }
564     return @themes;
565 }
566
567 sub getFacets {
568     my $facets;
569     if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
570         $facets = [
571             {
572                 link_value  => 'su-to',
573                 label_value => 'Topics',
574                 tags        =>
575                   [ '600', '601', '602', '603', '604', '605', '606', '610' ],
576                 subfield => 'a',
577             },
578             {
579                 link_value  => 'su-geo',
580                 label_value => 'Places',
581                 tags        => ['651'],
582                 subfield    => 'a',
583             },
584             {
585                 link_value  => 'su-ut',
586                 label_value => 'Titles',
587                 tags        => [ '500', '501', '502', '503', '504', ],
588                 subfield    => 'a',
589             },
590             {
591                 link_value  => 'au',
592                 label_value => 'Authors',
593                 tags        => [ '700', '701', '702', ],
594                 subfield    => 'a',
595             },
596             {
597                 link_value  => 'se',
598                 label_value => 'Series',
599                 tags        => ['225'],
600                 subfield    => 'a',
601             },
602             {
603                 link_value  => 'branch',
604                 label_value => 'Branches',
605                 tags        => [ '995', ],
606                 subfield    => 'b',
607                 expanded    => '1',
608             },
609         ];
610     }
611     else {
612         $facets = [
613             {
614                 link_value  => 'su-to',
615                 label_value => 'Topics',
616                 tags        => ['650'],
617                 subfield    => 'a',
618             },
619
620             #        {
621             #        link_value => 'su-na',
622             #        label_value => 'People and Organizations',
623             #        tags => ['600', '610', '611'],
624             #        subfield => 'a',
625             #        },
626             {
627                 link_value  => 'su-geo',
628                 label_value => 'Places',
629                 tags        => ['651'],
630                 subfield    => 'a',
631             },
632             {
633                 link_value  => 'su-ut',
634                 label_value => 'Titles',
635                 tags        => ['630'],
636                 subfield    => 'a',
637             },
638             {
639                 link_value  => 'au',
640                 label_value => 'Authors',
641                 tags        => [ '100', '110', '700', ],
642                 subfield    => 'a',
643             },
644             {
645                 link_value  => 'se',
646                 label_value => 'Series',
647                 tags        => [ '440', '490', ],
648                 subfield    => 'a',
649             },
650             {
651                 link_value  => 'branch',
652                 label_value => 'Branches',
653                 tags        => [ '952', ],
654                 subfield    => 'b',
655                 expanded    => '1',
656             },
657         ];
658     }
659     return $facets;
660 }
661
662 =head2 get_infos_of
663
664 Return a href where a key is associated to a href. You give a query, the
665 name of the key among the fields returned by the query. If you also give as
666 third argument the name of the value, the function returns a href of scalar.
667
668   my $query = '
669 SELECT itemnumber,
670        notforloan,
671        barcode
672   FROM items
673 ';
674
675   # generic href of any information on the item, href of href.
676   my $iteminfos_of = get_infos_of($query, 'itemnumber');
677   print $iteminfos_of->{$itemnumber}{barcode};
678
679   # specific information, href of scalar
680   my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
681   print $barcode_of_item->{$itemnumber};
682
683 =cut
684
685 sub get_infos_of {
686     my ( $query, $key_name, $value_name ) = @_;
687
688     my $dbh = C4::Context->dbh;
689
690     my $sth = $dbh->prepare($query);
691     $sth->execute();
692
693     my %infos_of;
694     while ( my $row = $sth->fetchrow_hashref ) {
695         if ( defined $value_name ) {
696             $infos_of{ $row->{$key_name} } = $row->{$value_name};
697         }
698         else {
699             $infos_of{ $row->{$key_name} } = $row;
700         }
701     }
702     $sth->finish;
703
704     return \%infos_of;
705 }
706
707 =head2 get_notforloan_label_of
708
709   my $notforloan_label_of = get_notforloan_label_of();
710
711 Each authorised value of notforloan (information available in items and
712 itemtypes) is link to a single label.
713
714 Returns a href where keys are authorised values and values are corresponding
715 labels.
716
717   foreach my $authorised_value (keys %{$notforloan_label_of}) {
718     printf(
719         "authorised_value: %s => %s\n",
720         $authorised_value,
721         $notforloan_label_of->{$authorised_value}
722     );
723   }
724
725 =cut
726
727 sub get_notforloan_label_of {
728     my $dbh = C4::Context->dbh;
729
730     my $query = '
731 SELECT authorised_value
732   FROM marc_subfield_structure
733   WHERE kohafield = \'items.notforloan\'
734   LIMIT 0, 1
735 ';
736     my $sth = $dbh->prepare($query);
737     $sth->execute();
738     my ($statuscode) = $sth->fetchrow_array();
739
740     $query = '
741 SELECT lib,
742        authorised_value
743   FROM authorised_values
744   WHERE category = ?
745 ';
746     $sth = $dbh->prepare($query);
747     $sth->execute($statuscode);
748     my %notforloan_label_of;
749     while ( my $row = $sth->fetchrow_hashref ) {
750         $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
751     }
752     $sth->finish;
753
754     return \%notforloan_label_of;
755 }
756
757 sub displaySortby {
758     my ($sort_by) = @_;
759     $sort_by =~ s/</\&lt;/;
760     $sort_by =~ s/>/\&gt;/;
761     my $sort_by_loop = [
762         { value => "1=9523 &gt;i", label => "Popularity (Most to Least)" },
763         { value => "1=9523 &lt;i", label => "Popularity (Least to Most)" },
764         { value => "1=1003 &lt;i", label => "Author (A-Z)" },
765         { value => "1=1003 &gt;i", label => "Author (Z-A)" },
766         {
767             value => "1=20 &lt;i",
768             label => "Call Number (Non-fiction 0-9 to Fiction A-Z)"
769         },
770         {
771             value => "1=20 &gt;i",
772             label => "Call Number (Fiction Z-A to Non-fiction 9-0)"
773         },
774         { value => "1=31 &gt;i", label => "Dates" },
775         {
776             value => "1=31 &gt;i",
777             label =>
778               "&nbsp;&nbsp;&nbsp;Publication/Copyright Date: Newest to Oldest"
779         },
780         {
781             value => "1=31 &lt;i",
782             label =>
783               "&nbsp;&nbsp;&nbsp;Publication/Copyright Date: Oldest to Newest"
784         },
785         {
786             value => "1=32 &gt;i",
787             label => "&nbsp;&nbsp;&nbsp;Acquisition Date: Newest to Oldest"
788         },
789         {
790             value => "1=32 &lt;i",
791             label => "&nbsp;&nbsp;&nbsp;Acquisition Date: Oldest to Newest"
792         },
793         { value => "1=4 &lt;i", label => "Title (A-Z)" },
794         { value => "1=4 &gt;i", label => "Title (Z-A)" },
795     ];
796     for my $hash (@$sort_by_loop) {
797
798         #warn "sort by: $sort_by ... hash:".$hash->{value};
799         if ($sort_by && $hash->{value} eq $sort_by ) {
800             $hash->{selected} = "selected";
801         }
802     }
803     return $sort_by_loop;
804
805 }
806
807 sub displayIndexes {
808     my $indexes = [
809         { value => '',   label => 'Keyword' },
810         { value => 'au', label => 'Author' },
811         {
812             value => 'au,phr',
813             label => '&nbsp;&nbsp;&nbsp;&nbsp; Author Phrase'
814         },
815         { value => 'cpn', label => '&nbsp;&nbsp;&nbsp;&nbsp; Corporate Name' },
816         { value => 'cfn', label => '&nbsp;&nbsp;&nbsp;&nbsp; Conference Name' },
817         {
818             value => 'cpn,phr',
819             label => '&nbsp;&nbsp;&nbsp;&nbsp; Corporate Name Phrase'
820         },
821         {
822             value => 'cfn,phr',
823             label => '&nbsp;&nbsp;&nbsp;&nbsp; Conference Name Phrase'
824         },
825         { value => 'pn', label => '&nbsp;&nbsp;&nbsp;&nbsp; Personal Name' },
826         {
827             value => 'pn,phr',
828             label => '&nbsp;&nbsp;&nbsp;&nbsp; Personal Name Phrase'
829         },
830         { value => 'ln', label => 'Language' },
831
832         #    { value => 'mt', label => 'Material Type' },
833         #    { value => 'mt,phr', label => 'Material Type Phrase' },
834         #    { value => 'mc', label => 'Musical Composition' },
835         #    { value => 'mc,phr', label => 'Musical Composition Phrase' },
836
837         { value => 'nt',  label => 'Notes/Comments' },
838         { value => 'pb',  label => 'Publisher' },
839         { value => 'pl',  label => 'Publisher Location' },
840         { value => 'sn',  label => 'Standard Number' },
841         { value => 'nb',  label => '&nbsp;&nbsp;&nbsp;&nbsp; ISBN' },
842         { value => 'ns',  label => '&nbsp;&nbsp;&nbsp;&nbsp; ISSN' },
843         { value => 'lcn', label => '&nbsp;&nbsp;&nbsp;&nbsp; Call Number' },
844         { value => 'su',  label => 'Subject' },
845         {
846             value => 'su,phr',
847             label => '&nbsp;&nbsp;&nbsp;&nbsp; Subject Phrase'
848         },
849
850 #    { value => 'de', label => '&nbsp;&nbsp;&nbsp;&nbsp; Descriptor' },
851 #    { value => 'ge', label => '&nbsp;&nbsp;&nbsp;&nbsp; Genre/Form' },
852 #    { value => 'gc', label => '&nbsp;&nbsp;&nbsp;&nbsp; Geographic Coverage' },
853
854 #     { value => 'nc', label => '&nbsp;&nbsp;&nbsp;&nbsp; Named Corporation and Conference' },
855 #     { value => 'na', label => '&nbsp;&nbsp;&nbsp;&nbsp; Named Person' },
856
857         { value => 'ti',     label => 'Title' },
858         { value => 'ti,phr', label => '&nbsp;&nbsp;&nbsp;&nbsp; Title Phrase' },
859         { value => 'se',     label => '&nbsp;&nbsp;&nbsp;&nbsp; Series Title' },
860     ];
861     return $indexes;
862 }
863
864 sub displaySubtypesLimit {
865     my $outer_subtype_limits_loop = [
866
867         {    # in MARC21, aud codes are stored in 008/22 (Target audience)
868             name                      => "limit",
869             inner_subtype_limits_loop => [
870                 {
871                     value    => '',
872                     label    => 'Any Audience',
873                     selected => "selected"
874                 },
875                 { value => 'aud:a', label => 'Easy', },
876                 { value => 'aud:c', label => 'Juvenile', },
877                 { value => 'aud:d', label => 'Young Adult', },
878                 { value => 'aud:e', label => 'Adult', },
879
880             ],
881         },
882         {    # in MARC21, fic is in 008/33, bio in 008/34, mus in LDR/06
883             name                      => "limit",
884             inner_subtype_limits_loop => [
885                 { value => '', label => 'Any Content', selected => "selected" },
886                 { value => 'fic:1', label => 'Fiction', },
887                 { value => 'fic:0', label => 'Non Fiction', },
888                 { value => 'bio:b', label => 'Biography', },
889                 { value => 'mus:j', label => 'Musical recording', },
890                 { value => 'mus:i', label => 'Non-musical recording', },
891
892             ],
893         },
894         {    # MARC21, these are codes stored in 007/00-01
895             name                      => "limit",
896             inner_subtype_limits_loop => [
897                 { value => '', label => 'Any Format', selected => "selected" },
898                 { value => 'l-format:ta', label => 'Regular print', },
899                 { value => 'l-format:tb', label => 'Large print', },
900                 { value => 'l-format:fk', label => 'Braille', },
901                 { value => '',            label => '-----------', },
902                 { value => 'l-format:sd', label => 'CD audio', },
903                 { value => 'l-format:ss', label => 'Cassette recording', },
904                 {
905                     value => 'l-format:vf',
906                     label => 'VHS tape / Videocassette',
907                 },
908                 { value => 'l-format:vd', label => 'DVD video / Videodisc', },
909                 { value => 'l-format:co', label => 'CD Software', },
910                 { value => 'l-format:cr', label => 'Website', },
911
912             ],
913         },
914         {    # in MARC21, these are codes in 008/24-28
915             name                      => "limit",
916             inner_subtype_limits_loop => [
917                 { value => '',        label => 'Additional Content Types', },
918                 { value => 'ctype:a', label => 'Abstracts/summaries', },
919                 { value => 'ctype:b', label => 'Bibliographies', },
920                 { value => 'ctype:c', label => 'Catalogs', },
921                 { value => 'ctype:d', label => 'Dictionaries', },
922                 { value => 'ctype:e', label => 'Encyclopedias ', },
923                 { value => 'ctype:f', label => 'Handbooks', },
924                 { value => 'ctype:g', label => 'Legal articles', },
925                 { value => 'ctype:i', label => 'Indexes', },
926                 { value => 'ctype:j', label => 'Patent document', },
927                 { value => 'ctype:k', label => 'Discographies', },
928                 { value => 'ctype:l', label => 'Legislation', },
929                 { value => 'ctype:m', label => 'Theses', },
930                 { value => 'ctype:n', label => 'Surveys', },
931                 { value => 'ctype:o', label => 'Reviews', },
932                 { value => 'ctype:p', label => 'Programmed texts', },
933                 { value => 'ctype:q', label => 'Filmographies', },
934                 { value => 'ctype:r', label => 'Directories', },
935                 { value => 'ctype:s', label => 'Statistics', },
936                 { value => 'ctype:t', label => 'Technical reports', },
937                 { value => 'ctype:v', label => 'Legal cases and case notes', },
938                 { value => 'ctype:w', label => 'Law reports and digests', },
939                 { value => 'ctype:z', label => 'Treaties ', },
940             ],
941         },
942     ];
943     return $outer_subtype_limits_loop;
944 }
945
946 sub displayLimitTypes {
947     my $outer_limit_types_loop = [
948
949         {
950             inner_limit_types_loop => [
951                 {
952                     label => "Books",
953                     id    => "mc-books",
954                     name  => "limit",
955                     value => "(mc-collection:AF or mc-collection:MYS or mc-collection:SCI or mc-collection:NF or mc-collection:YA or mc-collection:BIO or mc-collection:LP or mc-collection:LPNF)",
956                     icon  => "search-books.gif",
957                     title =>
958 "Books, Pamphlets, Technical reports, Manuscripts, Legal papers, Theses and dissertations",
959                 },
960
961                 {
962                     label => "Movies",
963                     id    => "mc-movies",
964                     name  => "limit",
965                     value => "(mc-collection:DVD or mc-collection:AV or mc-collection:AVJ or mc-collection:AVJN or mc-collection:AVJNF or mc-collection:AVNF)",
966                     icon  => "search-movies.gif",
967                     title =>
968 "Motion pictures, Videorecordings, Filmstrips, Slides, Transparencies, Photos, Cards, Charts, Drawings",
969                 },
970
971                 {
972                                         label => "Music",
973                                 id => "mc-music",
974                     name  => "limit",
975                     value => "(mc-collection:CDM)",
976                     icon  => "search-music.gif",
977                     title => "Spoken, Books on CD and Cassette",
978                 },
979             ],
980         },
981         {
982             inner_limit_types_loop => [
983                 {
984                     label => "Audio Books",
985                                         id => "mc-audio-books",
986                     name  => "limit",
987                     value => "(mc-collection:AB or mc-collection:AC or mc-collection:JAC or mc-collection:YAC)",
988                     icon  => "search-audio-books.gif",
989                     title => "Spoken, Books on CD and Cassette",
990                 },
991
992                 {
993                     label => "Local History Materials",
994                                 id => "mc-local-history",
995                     name  => "limit",
996                     value => "mc-collection:LH",
997                     icon  => "Local history.gif",
998                     title => "Local History Materials",
999                 },
1000
1001     {label => "Large Print",
1002     id => "mc-large-print",
1003                     name  => "limit",
1004     value => "(mc-collection:LP or mc-collection:LPNF)",
1005     icon => "search-large-print.gif ",
1006     title => "Large Print",},
1007             ],
1008         },
1009 { inner_limit_types_loop => [
1010     {label => "Kids",
1011     id => "mc-kids",
1012                     name  => "limit",
1013     value => "(mc-collection:EASY or mc-collection:JNF or mc-collection:JF or mc-collection:JREF or mc-collection:JB)",
1014     icon => "search-kids.gif",
1015     title => "Music",},
1016
1017     {label => "Software/Internet",
1018     id => "mc-sofware-web",
1019                     name  => "limit",
1020     value => "(mc-collection:CDR)",
1021     icon => "search-software-web.gif",
1022     title => "Kits",},
1023
1024     {label => "Reference",
1025     id => "mc-reference",
1026                     name  => "limit",
1027                     value => "mc-collection:REF",
1028     icon => "search-reference.gif",
1029     title => "Reference",},
1030
1031             ],
1032         },
1033
1034     ];
1035     return $outer_limit_types_loop;
1036 }
1037
1038 sub displayServers {
1039     my ( $position, $type ) = @_;
1040     my $dbh    = C4::Context->dbh;
1041     my $strsth = "SELECT * FROM z3950servers where 1";
1042     $strsth .= " AND position=\"$position\"" if ($position);
1043     $strsth .= " AND type=\"$type\""         if ($type);
1044     my $rq = $dbh->prepare($strsth);
1045     $rq->execute;
1046     my @primaryserverloop;
1047
1048     while ( my $data = $rq->fetchrow_hashref ) {
1049         my %cell;
1050         $cell{label} = $data->{'description'};
1051         $cell{id}    = $data->{'name'};
1052         $cell{value} =
1053             $data->{host}
1054           . ( $data->{port} ? ":" . $data->{port} : "" ) . "/"
1055           . $data->{database}
1056           if ( $data->{host} );
1057         $cell{checked} = $data->{checked};
1058         push @primaryserverloop,
1059           {
1060             label => $data->{description},
1061             id    => $data->{name},
1062             name  => "server",
1063             value => $data->{host} . ":"
1064               . $data->{port} . "/"
1065               . $data->{database},
1066             checked    => "checked",
1067             icon       => $data->{icon},
1068             zed        => $data->{type} eq 'zed',
1069             opensearch => $data->{type} eq 'opensearch'
1070           };
1071     }
1072     return \@primaryserverloop;
1073 }
1074
1075 sub displaySecondaryServers {
1076
1077 #       my $secondary_servers_loop = [
1078 #               { inner_sup_servers_loop => [
1079 #               {label => "Google", id=>"GOOG", value=>"google",icon => "google.ico",opensearch => "1"},
1080 #               {label => "Yahoo", id=>"YAH", value=>"yahoo", icon =>"yahoo.ico", zed => "1"},
1081 #               {label => "Worldcat", id=>"WCT", value=>"worldcat", icon => "worldcat.gif", zed => "1"},
1082 #               {label => "Library of Congress", id=>"LOC", name=> "server", value=>"z3950.loc.gov:7090/Voyager", icon =>"loc.ico", zed => "1"},
1083 #       ],
1084 #       },
1085 #       ];
1086     return;    #$secondary_servers_loop;
1087 }
1088
1089 =head2 GetAuthorisedValues
1090
1091 $authvalues = GetAuthorisedValues($category);
1092
1093 this function get all authorised values from 'authosied_value' table into a reference to array which
1094 each value containt an hashref.
1095
1096 Set C<$category> on input args if you want to limits your query to this one. This params is not mandatory.
1097
1098 =cut
1099
1100 sub GetAuthorisedValues {
1101     my $category = shift;
1102     my $dbh      = C4::Context->dbh;
1103     my $query    = "SELECT * FROM authorised_values";
1104     $query .= " WHERE category = '" . $category . "'" if $category;
1105
1106     my $sth = $dbh->prepare($query);
1107     $sth->execute;
1108     my $data = $sth->fetchall_arrayref({});
1109     return $data;
1110 }
1111
1112 =item fixEncoding
1113
1114   $marcrecord = &fixEncoding($marcblob);
1115
1116 Returns a well encoded marcrecord.
1117
1118 =cut
1119 sub FixEncoding {
1120   my $marc=shift;
1121   my $record = MARC::Record->new_from_usmarc($marc);
1122   if (C4::Context->preference("MARCFLAVOUR") eq "UNIMARC"){
1123     use Encode::Guess;
1124     my $targetcharset="utf8" if (C4::Context->preference("TemplateEncoding") eq "utf-8");
1125     $targetcharset="latin1" if (C4::Context->preference("TemplateEncoding") eq "iso-8859-1");
1126     my $decoder = guess_encoding($marc, qw/utf8 latin1/);
1127 #     die $decoder unless ref($decoder);
1128     if (ref($decoder)) {
1129         my $newRecord=MARC::Record->new();
1130         foreach my $field ($record->fields()){
1131         if ($field->tag()<'010'){
1132             $newRecord->insert_grouped_field($field);
1133         } else {
1134             my $newField;
1135             my $createdfield=0;
1136             foreach my $subfield ($field->subfields()){
1137             if ($createdfield){
1138                 if (($newField->tag eq '100')) {
1139                     substr($subfield->[1],26,2,"0103") if ($targetcharset eq "latin1");
1140                     substr($subfield->[1],26,4,"5050") if ($targetcharset eq "utf8");
1141                 }
1142                 map {C4::Biblio::char_decode($_,"UNIMARC")} @$subfield;
1143                 $newField->add_subfields($subfield->[0]=>$subfield->[1]);
1144             } else {
1145                 map {C4::Biblio::char_decode($_,"UNIMARC")} @$subfield;
1146                 $newField=MARC::Field->new($field->tag(),$field->indicator(1),$field->indicator(2),$subfield->[0]=>$subfield->[1]);
1147                 $createdfield=1;
1148             }
1149             }
1150             $newRecord->insert_grouped_field($newField);
1151         }
1152         }
1153     #     warn $newRecord->as_formatted(); 
1154         return $newRecord;
1155     } else {
1156         return $record;
1157     }
1158   } else {
1159     return $record;
1160   }
1161 }
1162
1163 =head2 GetKohaAuthorisedValues
1164         
1165         Takes $dbh , $kohafield as parameters.
1166         returns hashref of authvalCode => liblibrarian
1167         or undef if no authvals defined for kohafield.
1168
1169 =cut
1170
1171 sub GetKohaAuthorisedValues {
1172   my ($kohafield) = @_;
1173   my %values;
1174   my $dbh = C4::Context->dbh;
1175   my $sthnflstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=?');
1176   $sthnflstatus->execute($kohafield);
1177   my $authorised_valuecode = $sthnflstatus->fetchrow;
1178   if ($authorised_valuecode) {  
1179     $sthnflstatus = $dbh->prepare("select authorised_value, lib from authorised_values where category=? ");
1180     $sthnflstatus->execute($authorised_valuecode);
1181     while ( my ($val, $lib) = $sthnflstatus->fetchrow_array ) { 
1182       $values{$val}= $lib;
1183     }
1184   }
1185   return \%values;
1186 }
1187
1188 =head2 GetManagedTagSubfields
1189
1190 =over 4
1191
1192 $res = GetManagedTagSubfields();
1193
1194 Returns a reference to a big hash of hash, with the Marc structure fro the given frameworkcode
1195 $forlibrarian  :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
1196 $frameworkcode : the framework code to read
1197
1198 =back
1199
1200 =back
1201
1202 =cut
1203
1204 sub GetManagedTagSubfields{
1205   my $dbh=C4::Context->dbh;
1206   my $rq=$dbh->prepare(qq|
1207 SELECT 
1208   DISTINCT CONCAT( marc_subfield_structure.tagfield, tagsubfield ) AS tagsubfield, 
1209   marc_subfield_structure.liblibrarian as subfielddesc, 
1210   marc_tag_structure.liblibrarian as tagdesc
1211 FROM marc_subfield_structure
1212   LEFT JOIN marc_tag_structure 
1213     ON marc_tag_structure.tagfield = marc_subfield_structure.tagfield
1214     AND marc_tag_structure.frameworkcode = marc_subfield_structure.frameworkcode
1215 WHERE marc_subfield_structure.tab>=0
1216 ORDER BY tagsubfield|);
1217   $rq->execute;
1218   my $data=$rq->fetchall_arrayref({});
1219   return $data;
1220 }
1221
1222 1;
1223
1224 __END__
1225
1226 =head1 AUTHOR
1227
1228 Koha Team
1229
1230 =cut