help.pl - bugfix module usage (HTML::Template::Pro)
[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 vars qw($VERSION @ISA @EXPORT $DEBUG);
25
26 BEGIN {
27         $VERSION = 3.01;
28         require Exporter;
29         @ISA    = qw(Exporter);
30         @EXPORT = qw(
31                 &slashifyDate
32                 &DisplayISBN
33                 &subfield_is_koha_internal_p
34                 &GetPrinters &GetPrinter
35                 &GetItemTypes &getitemtypeinfo
36                 &GetCcodes
37                 &get_itemtypeinfos_of
38                 &getframeworks &getframeworkinfo
39                 &getauthtypes &getauthtype
40                 &getallthemes
41                 &getFacets
42                 &displayServers
43                 &getnbpages
44                 &getitemtypeimagesrcfromurl
45                 &get_infos_of
46                 &get_notforloan_label_of
47                 &getitemtypeimagedir
48                 &getitemtypeimagesrc
49                 &GetAuthorisedValues
50                 &FixEncoding
51                 &GetKohaAuthorisedValues
52                 &GetAuthValCode
53                 &GetManagedTagSubfields
54
55                 $DEBUG
56         );
57         $DEBUG = 0;
58 }
59
60 =head1 NAME
61
62     C4::Koha - Perl Module containing convenience functions for Koha scripts
63
64 =head1 SYNOPSIS
65
66   use C4::Koha;
67
68
69 =head1 DESCRIPTION
70
71     Koha.pm provides many functions for Koha scripts.
72
73 =head1 FUNCTIONS
74
75 =over 2
76
77 =head2 slashifyDate
78
79   $slash_date = &slashifyDate($dash_date);
80
81     Takes a string of the form "DD-MM-YYYY" (or anything separated by
82     dashes), converts it to the form "YYYY/MM/DD", and returns the result.
83
84 =cut
85
86 sub slashifyDate {
87
88     # accepts a date of the form xx-xx-xx[xx] and returns it in the
89     # form xx/xx/xx[xx]
90     my @dateOut = split( '-', shift );
91     return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
92 }
93
94
95 =head2 DisplayISBN
96
97     my $string = DisplayISBN( $isbn );
98
99 =cut
100
101 sub DisplayISBN {
102     my ($isbn) = @_;
103     if (length ($isbn)<13){
104     my $seg1;
105     if ( substr( $isbn, 0, 1 ) <= 7 ) {
106         $seg1 = substr( $isbn, 0, 1 );
107     }
108     elsif ( substr( $isbn, 0, 2 ) <= 94 ) {
109         $seg1 = substr( $isbn, 0, 2 );
110     }
111     elsif ( substr( $isbn, 0, 3 ) <= 995 ) {
112         $seg1 = substr( $isbn, 0, 3 );
113     }
114     elsif ( substr( $isbn, 0, 4 ) <= 9989 ) {
115         $seg1 = substr( $isbn, 0, 4 );
116     }
117     else {
118         $seg1 = substr( $isbn, 0, 5 );
119     }
120     my $x = substr( $isbn, length($seg1) );
121     my $seg2;
122     if ( substr( $x, 0, 2 ) <= 19 ) {
123
124         # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
125         $seg2 = substr( $x, 0, 2 );
126     }
127     elsif ( substr( $x, 0, 3 ) <= 699 ) {
128         $seg2 = substr( $x, 0, 3 );
129     }
130     elsif ( substr( $x, 0, 4 ) <= 8399 ) {
131         $seg2 = substr( $x, 0, 4 );
132     }
133     elsif ( substr( $x, 0, 5 ) <= 89999 ) {
134         $seg2 = substr( $x, 0, 5 );
135     }
136     elsif ( substr( $x, 0, 6 ) <= 9499999 ) {
137         $seg2 = substr( $x, 0, 6 );
138     }
139     else {
140         $seg2 = substr( $x, 0, 7 );
141     }
142     my $seg3 = substr( $x, length($seg2) );
143     $seg3 = substr( $seg3, 0, length($seg3) - 1 );
144     my $seg4 = substr( $x, -1, 1 );
145     return "$seg1-$seg2-$seg3-$seg4";
146     } else {
147       my $seg1;
148       $seg1 = substr( $isbn, 0, 3 );
149       my $seg2;
150       if ( substr( $isbn, 3, 1 ) <= 7 ) {
151           $seg2 = substr( $isbn, 3, 1 );
152       }
153       elsif ( substr( $isbn, 3, 2 ) <= 94 ) {
154           $seg2 = substr( $isbn, 3, 2 );
155       }
156       elsif ( substr( $isbn, 3, 3 ) <= 995 ) {
157           $seg2 = substr( $isbn, 3, 3 );
158       }
159       elsif ( substr( $isbn, 3, 4 ) <= 9989 ) {
160           $seg2 = substr( $isbn, 3, 4 );
161       }
162       else {
163           $seg2 = substr( $isbn, 3, 5 );
164       }
165       my $x = substr( $isbn, length($seg2) +3);
166       my $seg3;
167       if ( substr( $x, 0, 2 ) <= 19 ) {
168   
169           # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
170           $seg3 = substr( $x, 0, 2 );
171       }
172       elsif ( substr( $x, 0, 3 ) <= 699 ) {
173           $seg3 = substr( $x, 0, 3 );
174       }
175       elsif ( substr( $x, 0, 4 ) <= 8399 ) {
176           $seg3 = substr( $x, 0, 4 );
177       }
178       elsif ( substr( $x, 0, 5 ) <= 89999 ) {
179           $seg3 = substr( $x, 0, 5 );
180       }
181       elsif ( substr( $x, 0, 6 ) <= 9499999 ) {
182           $seg3 = substr( $x, 0, 6 );
183       }
184       else {
185           $seg3 = substr( $x, 0, 7 );
186       }
187       my $seg4 = substr( $x, length($seg3) );
188       $seg4 = substr( $seg4, 0, length($seg4) - 1 );
189       my $seg5 = substr( $x, -1, 1 );
190       return "$seg1-$seg2-$seg3-$seg4-$seg5";       
191     }    
192 }
193
194 # FIXME.. this should be moved to a MARC-specific module
195 sub subfield_is_koha_internal_p ($) {
196     my ($subfield) = @_;
197
198     # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
199     # But real MARC subfields are always single-character
200     # so it really is safer just to check the length
201
202     return length $subfield != 1;
203 }
204
205 =head2 GetItemTypes
206
207   $itemtypes = &GetItemTypes();
208
209 Returns information about existing itemtypes.
210
211 build a HTML select with the following code :
212
213 =head3 in PERL SCRIPT
214
215     my $itemtypes = GetItemTypes;
216     my @itemtypesloop;
217     foreach my $thisitemtype (sort keys %$itemtypes) {
218         my $selected = 1 if $thisitemtype eq $itemtype;
219         my %row =(value => $thisitemtype,
220                     selected => $selected,
221                     description => $itemtypes->{$thisitemtype}->{'description'},
222                 );
223         push @itemtypesloop, \%row;
224     }
225     $template->param(itemtypeloop => \@itemtypesloop);
226
227 =head3 in TEMPLATE
228
229     <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
230         <select name="itemtype">
231             <option value="">Default</option>
232         <!-- TMPL_LOOP name="itemtypeloop" -->
233             <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
234         <!-- /TMPL_LOOP -->
235         </select>
236         <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
237         <input type="submit" value="OK" class="button">
238     </form>
239
240 =cut
241
242 sub GetItemTypes {
243
244     # returns a reference to a hash of references to branches...
245     my %itemtypes;
246     my $dbh   = C4::Context->dbh;
247     my $query = qq|
248         SELECT *
249         FROM   itemtypes
250     |;
251     my $sth = $dbh->prepare($query);
252     $sth->execute;
253     while ( my $IT = $sth->fetchrow_hashref ) {
254         $itemtypes{ $IT->{'itemtype'} } = $IT;
255     }
256     return ( \%itemtypes );
257 }
258
259 sub get_itemtypeinfos_of {
260     my @itemtypes = @_;
261
262     my $query = '
263 SELECT itemtype,
264        description,
265        imageurl,
266        notforloan
267   FROM itemtypes
268   WHERE itemtype IN (' . join( ',', map( { "'" . $_ . "'" } @itemtypes ) ) . ')
269 ';
270
271     return get_infos_of( $query, 'itemtype' );
272 }
273
274 # this is temporary until we separate collection codes and item types
275 sub GetCcodes {
276     my $count = 0;
277     my @results;
278     my $dbh = C4::Context->dbh;
279     my $sth =
280       $dbh->prepare(
281         "SELECT * FROM authorised_values ORDER BY authorised_value");
282     $sth->execute;
283     while ( my $data = $sth->fetchrow_hashref ) {
284         if ( $data->{category} eq "CCODE" ) {
285             $count++;
286             $results[$count] = $data;
287
288             #warn "data: $data";
289         }
290     }
291     $sth->finish;
292     return ( $count, @results );
293 }
294
295 =head2 getauthtypes
296
297   $authtypes = &getauthtypes();
298
299 Returns information about existing authtypes.
300
301 build a HTML select with the following code :
302
303 =head3 in PERL SCRIPT
304
305 my $authtypes = getauthtypes;
306 my @authtypesloop;
307 foreach my $thisauthtype (keys %$authtypes) {
308     my $selected = 1 if $thisauthtype eq $authtype;
309     my %row =(value => $thisauthtype,
310                 selected => $selected,
311                 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
312             );
313     push @authtypesloop, \%row;
314 }
315 $template->param(itemtypeloop => \@itemtypesloop);
316
317 =head3 in TEMPLATE
318
319 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
320     <select name="authtype">
321     <!-- TMPL_LOOP name="authtypeloop" -->
322         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
323     <!-- /TMPL_LOOP -->
324     </select>
325     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
326     <input type="submit" value="OK" class="button">
327 </form>
328
329
330 =cut
331
332 sub getauthtypes {
333
334     # returns a reference to a hash of references to authtypes...
335     my %authtypes;
336     my $dbh = C4::Context->dbh;
337     my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
338     $sth->execute;
339     while ( my $IT = $sth->fetchrow_hashref ) {
340         $authtypes{ $IT->{'authtypecode'} } = $IT;
341     }
342     return ( \%authtypes );
343 }
344
345 sub getauthtype {
346     my ($authtypecode) = @_;
347
348     # returns a reference to a hash of references to authtypes...
349     my %authtypes;
350     my $dbh = C4::Context->dbh;
351     my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
352     $sth->execute($authtypecode);
353     my $res = $sth->fetchrow_hashref;
354     return $res;
355 }
356
357 =head2 getframework
358
359   $frameworks = &getframework();
360
361 Returns information about existing frameworks
362
363 build a HTML select with the following code :
364
365 =head3 in PERL SCRIPT
366
367 my $frameworks = frameworks();
368 my @frameworkloop;
369 foreach my $thisframework (keys %$frameworks) {
370     my $selected = 1 if $thisframework eq $frameworkcode;
371     my %row =(value => $thisframework,
372                 selected => $selected,
373                 description => $frameworks->{$thisframework}->{'frameworktext'},
374             );
375     push @frameworksloop, \%row;
376 }
377 $template->param(frameworkloop => \@frameworksloop);
378
379 =head3 in TEMPLATE
380
381 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
382     <select name="frameworkcode">
383         <option value="">Default</option>
384     <!-- TMPL_LOOP name="frameworkloop" -->
385         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
386     <!-- /TMPL_LOOP -->
387     </select>
388     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
389     <input type="submit" value="OK" class="button">
390 </form>
391
392
393 =cut
394
395 sub getframeworks {
396
397     # returns a reference to a hash of references to branches...
398     my %itemtypes;
399     my $dbh = C4::Context->dbh;
400     my $sth = $dbh->prepare("select * from biblio_framework");
401     $sth->execute;
402     while ( my $IT = $sth->fetchrow_hashref ) {
403         $itemtypes{ $IT->{'frameworkcode'} } = $IT;
404     }
405     return ( \%itemtypes );
406 }
407
408 =head2 getframeworkinfo
409
410   $frameworkinfo = &getframeworkinfo($frameworkcode);
411
412 Returns information about an frameworkcode.
413
414 =cut
415
416 sub getframeworkinfo {
417     my ($frameworkcode) = @_;
418     my $dbh             = C4::Context->dbh;
419     my $sth             =
420       $dbh->prepare("select * from biblio_framework where frameworkcode=?");
421     $sth->execute($frameworkcode);
422     my $res = $sth->fetchrow_hashref;
423     return $res;
424 }
425
426 =head2 getitemtypeinfo
427
428   $itemtype = &getitemtype($itemtype);
429
430 Returns information about an itemtype.
431
432 =cut
433
434 sub getitemtypeinfo {
435     my ($itemtype) = @_;
436     my $dbh        = C4::Context->dbh;
437     my $sth        = $dbh->prepare("select * from itemtypes where itemtype=?");
438     $sth->execute($itemtype);
439     my $res = $sth->fetchrow_hashref;
440
441     $res->{imageurl} = getitemtypeimagesrcfromurl( $res->{imageurl} );
442
443     return $res;
444 }
445
446 sub getitemtypeimagesrcfromurl {
447     my ($imageurl) = @_;
448
449     if ( defined $imageurl and $imageurl !~ m/^http/ ) {
450         $imageurl = getitemtypeimagesrc() . '/' . $imageurl;
451     }
452
453     return $imageurl;
454 }
455
456 sub getitemtypeimagedir {
457     return C4::Context->opachtdocs . '/'
458       . C4::Context->preference('template')
459       . '/itemtypeimg';
460 }
461
462 sub getitemtypeimagesrc {
463     return '/opac-tmpl' . '/'
464       . C4::Context->preference('template')
465       . '/itemtypeimg';
466 }
467
468 =head2 GetPrinters
469
470   $printers = &GetPrinters();
471   @queues = keys %$printers;
472
473 Returns information about existing printer queues.
474
475 C<$printers> is a reference-to-hash whose keys are the print queues
476 defined in the printers table of the Koha database. The values are
477 references-to-hash, whose keys are the fields in the printers table.
478
479 =cut
480
481 sub GetPrinters {
482     my %printers;
483     my $dbh = C4::Context->dbh;
484     my $sth = $dbh->prepare("select * from printers");
485     $sth->execute;
486     while ( my $printer = $sth->fetchrow_hashref ) {
487         $printers{ $printer->{'printqueue'} } = $printer;
488     }
489     return ( \%printers );
490 }
491
492 =head2 GetPrinter
493
494 $printer = GetPrinter( $query, $printers );
495
496 =cut
497
498 sub GetPrinter ($$) {
499     my ( $query, $printers ) = @_;    # get printer for this query from printers
500     my $printer = $query->param('printer');
501     my %cookie = $query->cookie('userenv');
502     ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
503     ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
504     return $printer;
505 }
506
507 =item getnbpages
508
509 Returns the number of pages to display in a pagination bar, given the number
510 of items and the number of items per page.
511
512 =cut
513
514 sub getnbpages {
515     my ( $nb_items, $nb_items_per_page ) = @_;
516
517     return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
518 }
519
520 =item getallthemes
521
522   (@themes) = &getallthemes('opac');
523   (@themes) = &getallthemes('intranet');
524
525 Returns an array of all available themes.
526
527 =cut
528
529 sub getallthemes {
530     my $type = shift;
531     my $htdocs;
532     my @themes;
533     if ( $type eq 'intranet' ) {
534         $htdocs = C4::Context->config('intrahtdocs');
535     }
536     else {
537         $htdocs = C4::Context->config('opachtdocs');
538     }
539     opendir D, "$htdocs";
540     my @dirlist = readdir D;
541     foreach my $directory (@dirlist) {
542         -d "$htdocs/$directory/en" and push @themes, $directory;
543     }
544     return @themes;
545 }
546
547 sub getFacets {
548     my $facets;
549     if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
550         $facets = [
551             {
552                 link_value  => 'su-to',
553                 label_value => 'Topics',
554                 tags        =>
555                   [ '600', '601', '602', '603', '604', '605', '606', '610' ],
556                 subfield => 'a',
557             },
558             {
559                 link_value  => 'su-geo',
560                 label_value => 'Places',
561                 tags        => ['651'],
562                 subfield    => 'a',
563             },
564             {
565                 link_value  => 'su-ut',
566                 label_value => 'Titles',
567                 tags        => [ '500', '501', '502', '503', '504', ],
568                 subfield    => 'a',
569             },
570             {
571                 link_value  => 'au',
572                 label_value => 'Authors',
573                 tags        => [ '700', '701', '702', ],
574                 subfield    => 'a',
575             },
576             {
577                 link_value  => 'se',
578                 label_value => 'Series',
579                 tags        => ['225'],
580                 subfield    => 'a',
581             },
582             {
583                 link_value  => 'branch',
584                 label_value => 'Libraries',
585                 tags        => [ '995', ],
586                 subfield    => 'b',
587                 expanded    => '1',
588             },
589         ];
590     }
591     else {
592         $facets = [
593             {
594                 link_value  => 'su-to',
595                 label_value => 'Topics',
596                 tags        => ['650'],
597                 subfield    => 'a',
598             },
599
600             #        {
601             #        link_value => 'su-na',
602             #        label_value => 'People and Organizations',
603             #        tags => ['600', '610', '611'],
604             #        subfield => 'a',
605             #        },
606             {
607                 link_value  => 'su-geo',
608                 label_value => 'Places',
609                 tags        => ['651'],
610                 subfield    => 'a',
611             },
612             {
613                 link_value  => 'su-ut',
614                 label_value => 'Titles',
615                 tags        => ['630'],
616                 subfield    => 'a',
617             },
618             {
619                 link_value  => 'au',
620                 label_value => 'Authors',
621                 tags        => [ '100', '110', '700', ],
622                 subfield    => 'a',
623             },
624             {
625                 link_value  => 'se',
626                 label_value => 'Series',
627                 tags        => [ '440', '490', ],
628                 subfield    => 'a',
629             },
630             {
631                 link_value  => 'branch',
632                 label_value => 'Libraries',
633                 tags        => [ '952', ],
634                 subfield    => 'b',
635                 expanded    => '1',
636             },
637         ];
638     }
639     return $facets;
640 }
641
642 =head2 get_infos_of
643
644 Return a href where a key is associated to a href. You give a query, the
645 name of the key among the fields returned by the query. If you also give as
646 third argument the name of the value, the function returns a href of scalar.
647
648   my $query = '
649 SELECT itemnumber,
650        notforloan,
651        barcode
652   FROM items
653 ';
654
655   # generic href of any information on the item, href of href.
656   my $iteminfos_of = get_infos_of($query, 'itemnumber');
657   print $iteminfos_of->{$itemnumber}{barcode};
658
659   # specific information, href of scalar
660   my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
661   print $barcode_of_item->{$itemnumber};
662
663 =cut
664
665 sub get_infos_of {
666     my ( $query, $key_name, $value_name ) = @_;
667
668     my $dbh = C4::Context->dbh;
669
670     my $sth = $dbh->prepare($query);
671     $sth->execute();
672
673     my %infos_of;
674     while ( my $row = $sth->fetchrow_hashref ) {
675         if ( defined $value_name ) {
676             $infos_of{ $row->{$key_name} } = $row->{$value_name};
677         }
678         else {
679             $infos_of{ $row->{$key_name} } = $row;
680         }
681     }
682     $sth->finish;
683
684     return \%infos_of;
685 }
686
687 =head2 get_notforloan_label_of
688
689   my $notforloan_label_of = get_notforloan_label_of();
690
691 Each authorised value of notforloan (information available in items and
692 itemtypes) is link to a single label.
693
694 Returns a href where keys are authorised values and values are corresponding
695 labels.
696
697   foreach my $authorised_value (keys %{$notforloan_label_of}) {
698     printf(
699         "authorised_value: %s => %s\n",
700         $authorised_value,
701         $notforloan_label_of->{$authorised_value}
702     );
703   }
704
705 =cut
706
707 # FIXME - why not use GetAuthorisedValues ??
708 #
709 sub get_notforloan_label_of {
710     my $dbh = C4::Context->dbh;
711
712     my $query = '
713 SELECT authorised_value
714   FROM marc_subfield_structure
715   WHERE kohafield = \'items.notforloan\'
716   LIMIT 0, 1
717 ';
718     my $sth = $dbh->prepare($query);
719     $sth->execute();
720     my ($statuscode) = $sth->fetchrow_array();
721
722     $query = '
723 SELECT lib,
724        authorised_value
725   FROM authorised_values
726   WHERE category = ?
727 ';
728     $sth = $dbh->prepare($query);
729     $sth->execute($statuscode);
730     my %notforloan_label_of;
731     while ( my $row = $sth->fetchrow_hashref ) {
732         $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
733     }
734     $sth->finish;
735
736     return \%notforloan_label_of;
737 }
738
739 sub displayServers {
740     my ( $position, $type ) = @_;
741     my $dbh    = C4::Context->dbh;
742     my $strsth = "SELECT * FROM z3950servers where 1";
743     $strsth .= " AND position=\"$position\"" if ($position);
744     $strsth .= " AND type=\"$type\""         if ($type);
745     my $rq = $dbh->prepare($strsth);
746     $rq->execute;
747     my @primaryserverloop;
748
749     while ( my $data = $rq->fetchrow_hashref ) {
750         my %cell;
751         $cell{label} = $data->{'description'};
752         $cell{id}    = $data->{'name'};
753         $cell{value} =
754             $data->{host}
755           . ( $data->{port} ? ":" . $data->{port} : "" ) . "/"
756           . $data->{database}
757           if ( $data->{host} );
758         $cell{checked} = $data->{checked};
759         push @primaryserverloop,
760           {
761             label => $data->{description},
762             id    => $data->{name},
763             name  => "server",
764             value => $data->{host} . ":"
765               . $data->{port} . "/"
766               . $data->{database},
767             checked    => "checked",
768             icon       => $data->{icon},
769             zed        => $data->{type} eq 'zed',
770             opensearch => $data->{type} eq 'opensearch'
771           };
772     }
773     return \@primaryserverloop;
774 }
775
776 sub displaySecondaryServers {
777
778 #       my $secondary_servers_loop = [
779 #               { inner_sup_servers_loop => [
780 #               {label => "Google", id=>"GOOG", value=>"google",icon => "google.ico",opensearch => "1"},
781 #               {label => "Yahoo", id=>"YAH", value=>"yahoo", icon =>"yahoo.ico", zed => "1"},
782 #               {label => "Worldcat", id=>"WCT", value=>"worldcat", icon => "worldcat.gif", zed => "1"},
783 #               {label => "Library of Congress", id=>"LOC", name=> "server", value=>"z3950.loc.gov:7090/Voyager", icon =>"loc.ico", zed => "1"},
784 #       ],
785 #       },
786 #       ];
787     return;    #$secondary_servers_loop;
788 }
789
790 =head2 GetAuthValCode
791
792 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
793
794 =cut
795
796 sub GetAuthValCode {
797         my ($kohafield,$fwcode) = @_;
798         my $dbh = C4::Context->dbh;
799         $fwcode='' unless $fwcode;
800         my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
801         $sth->execute($kohafield,$fwcode);
802         my ($authvalcode) = $sth->fetchrow_array;
803         return $authvalcode;
804 }
805
806 =head2 GetAuthorisedValues
807
808 $authvalues = GetAuthorisedValues($category);
809
810 this function get all authorised values from 'authosied_value' table into a reference to array which
811 each value containt an hashref.
812
813 Set C<$category> on input args if you want to limits your query to this one. This params is not mandatory.
814
815 =cut
816
817 sub GetAuthorisedValues {
818     my ($category,$selected) = @_;
819         my $count = 0;
820         my @results;
821     my $dbh      = C4::Context->dbh;
822     my $query    = "SELECT * FROM authorised_values";
823     $query .= " WHERE category = '" . $category . "'" if $category;
824
825     my $sth = $dbh->prepare($query);
826     $sth->execute;
827         while (my $data=$sth->fetchrow_hashref) {
828                 if ($selected eq $data->{'authorised_value'} ) {
829                         $data->{'selected'} = 1;
830                 }
831                 $results[$count] = $data;
832                 $count++;
833         }
834     #my $data = $sth->fetchall_arrayref({});
835     return \@results; #$data;
836 }
837
838 =item fixEncoding
839
840   $marcrecord = &fixEncoding($marcblob);
841
842 Returns a well encoded marcrecord.
843
844 =cut
845 sub FixEncoding {
846   my $marc=shift;
847   my $record = MARC::Record->new_from_usmarc($marc);
848   if (C4::Context->preference("MARCFLAVOUR") eq "UNIMARC"){
849     use Encode::Guess;
850     my $targetcharset="utf8" if (C4::Context->preference("TemplateEncoding") eq "utf-8");
851     $targetcharset="latin1" if (C4::Context->preference("TemplateEncoding") eq "iso-8859-1");
852     my $decoder = guess_encoding($marc, qw/utf8 latin1/);
853 #     die $decoder unless ref($decoder);
854     if (ref($decoder)) {
855         my $newRecord=MARC::Record->new();
856         foreach my $field ($record->fields()){
857         if ($field->tag()<'010'){
858             $newRecord->insert_grouped_field($field);
859         } else {
860             my $newField;
861             my $createdfield=0;
862             foreach my $subfield ($field->subfields()){
863             if ($createdfield){
864                 if (($newField->tag eq '100')) {
865                     substr($subfield->[1],26,2,"0103") if ($targetcharset eq "latin1");
866                     substr($subfield->[1],26,4,"5050") if ($targetcharset eq "utf8");
867                 }
868                 map {C4::Biblio::char_decode($_,"UNIMARC")} @$subfield;
869                 $newField->add_subfields($subfield->[0]=>$subfield->[1]);
870             } else {
871                 map {C4::Biblio::char_decode($_,"UNIMARC")} @$subfield;
872                 $newField=MARC::Field->new($field->tag(),$field->indicator(1),$field->indicator(2),$subfield->[0]=>$subfield->[1]);
873                 $createdfield=1;
874             }
875             }
876             $newRecord->insert_grouped_field($newField);
877         }
878         }
879     #     warn $newRecord->as_formatted(); 
880         return $newRecord;
881     } else {
882         return $record;
883     }
884   } else {
885     return $record;
886   }
887 }
888
889 =head2 GetKohaAuthorisedValues
890         
891         Takes $dbh , $kohafield as parameters.
892         returns hashref of authvalCode => liblibrarian
893         or undef if no authvals defined for kohafield.
894
895 =cut
896
897 sub GetKohaAuthorisedValues {
898   my ($kohafield,$fwcode) = @_;
899   $fwcode='' unless $fwcode;
900   my %values;
901   my $dbh = C4::Context->dbh;
902   my $avcode = GetAuthValCode($kohafield,$fwcode);
903   if ($avcode) {  
904     my $sth = $dbh->prepare("select authorised_value, lib from authorised_values where category=? ");
905     $sth->execute($avcode);
906         while ( my ($val, $lib) = $sth->fetchrow_array ) { 
907                 $values{$val}= $lib;
908         }
909   }
910   return \%values;
911 }
912
913 =head2 GetManagedTagSubfields
914
915 =over 4
916
917 $res = GetManagedTagSubfields();
918
919 =back
920
921 Returns a reference to a big hash of hash, with the Marc structure fro the given frameworkcode
922
923 NOTE: This function is used only by the (incomplete) bulk editing feature.  Since
924 that feature currently does not deal with items and biblioitems changes 
925 correctly, those tags are specifically excluded from the list prepared
926 by this function.
927
928 For future reference, if a bulk item editing feature is implemented at some point, it
929 needs some design thought -- for example, circulation status fields should not 
930 be changed willy-nilly.
931
932 =cut
933
934 sub GetManagedTagSubfields{
935   my $dbh=C4::Context->dbh;
936   my $rq=$dbh->prepare(qq|
937 SELECT 
938   DISTINCT CONCAT( marc_subfield_structure.tagfield, tagsubfield ) AS tagsubfield, 
939   marc_subfield_structure.liblibrarian as subfielddesc, 
940   marc_tag_structure.liblibrarian as tagdesc
941 FROM marc_subfield_structure
942   LEFT JOIN marc_tag_structure 
943     ON marc_tag_structure.tagfield = marc_subfield_structure.tagfield
944     AND marc_tag_structure.frameworkcode = marc_subfield_structure.frameworkcode
945 WHERE marc_subfield_structure.tab>=0
946 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield like 'items.%')
947 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield = 'biblioitems.itemtype')
948 AND marc_subfield_structure.kohafield <> 'biblio.biblionumber'
949 AND marc_subfield_structure.kohafield <>  'biblioitems.biblioitemnumber'
950 ORDER BY marc_subfield_structure.tagfield, tagsubfield|);
951   $rq->execute;
952   my $data=$rq->fetchall_arrayref({});
953   return $data;
954 }
955
956 1;
957
958 __END__
959
960 =head1 AUTHOR
961
962 Koha Team
963
964 =cut