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