3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
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
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.
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
25 use MIME::Base64 qw(encode_base64 decode_base64);
26 use Encode qw(encode decode);
28 use vars qw($VERSION @ISA @EXPORT $DEBUG);
37 &subfield_is_koha_internal_p
38 &GetPrinters &GetPrinter
39 &GetItemTypes &getitemtypeinfo
42 &getframeworks &getframeworkinfo
43 &getauthtypes &getauthtype
48 &getitemtypeimagesrcfromurl
50 &get_notforloan_label_of
54 &GetKohaAuthorisedValues
56 &GetManagedTagSubfields
67 C4::Koha - Perl Module containing convenience functions for Koha scripts
76 Koha.pm provides many functions for Koha scripts.
85 $slash_date = &slashifyDate($dash_date);
87 Takes a string of the form "DD-MM-YYYY" (or anything separated by
88 dashes), converts it to the form "YYYY/MM/DD", and returns the result.
94 # accepts a date of the form xx-xx-xx[xx] and returns it in the
96 my @dateOut = split( '-', shift );
97 return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
103 my $string = DisplayISBN( $isbn );
109 if (length ($isbn)<13){
111 if ( substr( $isbn, 0, 1 ) <= 7 ) {
112 $seg1 = substr( $isbn, 0, 1 );
114 elsif ( substr( $isbn, 0, 2 ) <= 94 ) {
115 $seg1 = substr( $isbn, 0, 2 );
117 elsif ( substr( $isbn, 0, 3 ) <= 995 ) {
118 $seg1 = substr( $isbn, 0, 3 );
120 elsif ( substr( $isbn, 0, 4 ) <= 9989 ) {
121 $seg1 = substr( $isbn, 0, 4 );
124 $seg1 = substr( $isbn, 0, 5 );
126 my $x = substr( $isbn, length($seg1) );
128 if ( substr( $x, 0, 2 ) <= 19 ) {
130 # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
131 $seg2 = substr( $x, 0, 2 );
133 elsif ( substr( $x, 0, 3 ) <= 699 ) {
134 $seg2 = substr( $x, 0, 3 );
136 elsif ( substr( $x, 0, 4 ) <= 8399 ) {
137 $seg2 = substr( $x, 0, 4 );
139 elsif ( substr( $x, 0, 5 ) <= 89999 ) {
140 $seg2 = substr( $x, 0, 5 );
142 elsif ( substr( $x, 0, 6 ) <= 9499999 ) {
143 $seg2 = substr( $x, 0, 6 );
146 $seg2 = substr( $x, 0, 7 );
148 my $seg3 = substr( $x, length($seg2) );
149 $seg3 = substr( $seg3, 0, length($seg3) - 1 );
150 my $seg4 = substr( $x, -1, 1 );
151 return "$seg1-$seg2-$seg3-$seg4";
154 $seg1 = substr( $isbn, 0, 3 );
156 if ( substr( $isbn, 3, 1 ) <= 7 ) {
157 $seg2 = substr( $isbn, 3, 1 );
159 elsif ( substr( $isbn, 3, 2 ) <= 94 ) {
160 $seg2 = substr( $isbn, 3, 2 );
162 elsif ( substr( $isbn, 3, 3 ) <= 995 ) {
163 $seg2 = substr( $isbn, 3, 3 );
165 elsif ( substr( $isbn, 3, 4 ) <= 9989 ) {
166 $seg2 = substr( $isbn, 3, 4 );
169 $seg2 = substr( $isbn, 3, 5 );
171 my $x = substr( $isbn, length($seg2) +3);
173 if ( substr( $x, 0, 2 ) <= 19 ) {
175 # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
176 $seg3 = substr( $x, 0, 2 );
178 elsif ( substr( $x, 0, 3 ) <= 699 ) {
179 $seg3 = substr( $x, 0, 3 );
181 elsif ( substr( $x, 0, 4 ) <= 8399 ) {
182 $seg3 = substr( $x, 0, 4 );
184 elsif ( substr( $x, 0, 5 ) <= 89999 ) {
185 $seg3 = substr( $x, 0, 5 );
187 elsif ( substr( $x, 0, 6 ) <= 9499999 ) {
188 $seg3 = substr( $x, 0, 6 );
191 $seg3 = substr( $x, 0, 7 );
193 my $seg4 = substr( $x, length($seg3) );
194 $seg4 = substr( $seg4, 0, length($seg4) - 1 );
195 my $seg5 = substr( $x, -1, 1 );
196 return "$seg1-$seg2-$seg3-$seg4-$seg5";
200 # FIXME.. this should be moved to a MARC-specific module
201 sub subfield_is_koha_internal_p ($) {
204 # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
205 # But real MARC subfields are always single-character
206 # so it really is safer just to check the length
208 return length $subfield != 1;
213 $itemtypes = &GetItemTypes();
215 Returns information about existing itemtypes.
217 build a HTML select with the following code :
219 =head3 in PERL SCRIPT
221 my $itemtypes = GetItemTypes;
223 foreach my $thisitemtype (sort keys %$itemtypes) {
224 my $selected = 1 if $thisitemtype eq $itemtype;
225 my %row =(value => $thisitemtype,
226 selected => $selected,
227 description => $itemtypes->{$thisitemtype}->{'description'},
229 push @itemtypesloop, \%row;
231 $template->param(itemtypeloop => \@itemtypesloop);
235 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
236 <select name="itemtype">
237 <option value="">Default</option>
238 <!-- TMPL_LOOP name="itemtypeloop" -->
239 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
242 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
243 <input type="submit" value="OK" class="button">
250 # returns a reference to a hash of references to branches...
252 my $dbh = C4::Context->dbh;
257 my $sth = $dbh->prepare($query);
259 while ( my $IT = $sth->fetchrow_hashref ) {
260 $itemtypes{ $IT->{'itemtype'} } = $IT;
262 return ( \%itemtypes );
265 sub get_itemtypeinfos_of {
274 WHERE itemtype IN (' . join( ',', map( { "'" . $_ . "'" } @itemtypes ) ) . ')
277 return get_infos_of( $query, 'itemtype' );
280 # this is temporary until we separate collection codes and item types
284 my $dbh = C4::Context->dbh;
287 "SELECT * FROM authorised_values ORDER BY authorised_value");
289 while ( my $data = $sth->fetchrow_hashref ) {
290 if ( $data->{category} eq "CCODE" ) {
292 $results[$count] = $data;
298 return ( $count, @results );
303 $authtypes = &getauthtypes();
305 Returns information about existing authtypes.
307 build a HTML select with the following code :
309 =head3 in PERL SCRIPT
311 my $authtypes = getauthtypes;
313 foreach my $thisauthtype (keys %$authtypes) {
314 my $selected = 1 if $thisauthtype eq $authtype;
315 my %row =(value => $thisauthtype,
316 selected => $selected,
317 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
319 push @authtypesloop, \%row;
321 $template->param(itemtypeloop => \@itemtypesloop);
325 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
326 <select name="authtype">
327 <!-- TMPL_LOOP name="authtypeloop" -->
328 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
331 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
332 <input type="submit" value="OK" class="button">
340 # returns a reference to a hash of references to authtypes...
342 my $dbh = C4::Context->dbh;
343 my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
345 while ( my $IT = $sth->fetchrow_hashref ) {
346 $authtypes{ $IT->{'authtypecode'} } = $IT;
348 return ( \%authtypes );
352 my ($authtypecode) = @_;
354 # returns a reference to a hash of references to authtypes...
356 my $dbh = C4::Context->dbh;
357 my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
358 $sth->execute($authtypecode);
359 my $res = $sth->fetchrow_hashref;
365 $frameworks = &getframework();
367 Returns information about existing frameworks
369 build a HTML select with the following code :
371 =head3 in PERL SCRIPT
373 my $frameworks = frameworks();
375 foreach my $thisframework (keys %$frameworks) {
376 my $selected = 1 if $thisframework eq $frameworkcode;
377 my %row =(value => $thisframework,
378 selected => $selected,
379 description => $frameworks->{$thisframework}->{'frameworktext'},
381 push @frameworksloop, \%row;
383 $template->param(frameworkloop => \@frameworksloop);
387 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
388 <select name="frameworkcode">
389 <option value="">Default</option>
390 <!-- TMPL_LOOP name="frameworkloop" -->
391 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
394 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
395 <input type="submit" value="OK" class="button">
403 # returns a reference to a hash of references to branches...
405 my $dbh = C4::Context->dbh;
406 my $sth = $dbh->prepare("select * from biblio_framework");
408 while ( my $IT = $sth->fetchrow_hashref ) {
409 $itemtypes{ $IT->{'frameworkcode'} } = $IT;
411 return ( \%itemtypes );
414 =head2 getframeworkinfo
416 $frameworkinfo = &getframeworkinfo($frameworkcode);
418 Returns information about an frameworkcode.
422 sub getframeworkinfo {
423 my ($frameworkcode) = @_;
424 my $dbh = C4::Context->dbh;
426 $dbh->prepare("select * from biblio_framework where frameworkcode=?");
427 $sth->execute($frameworkcode);
428 my $res = $sth->fetchrow_hashref;
432 =head2 getitemtypeinfo
434 $itemtype = &getitemtype($itemtype);
436 Returns information about an itemtype.
440 sub getitemtypeinfo {
442 my $dbh = C4::Context->dbh;
443 my $sth = $dbh->prepare("select * from itemtypes where itemtype=?");
444 $sth->execute($itemtype);
445 my $res = $sth->fetchrow_hashref;
447 $res->{imageurl} = getitemtypeimagesrcfromurl( $res->{imageurl} );
452 sub getitemtypeimagesrcfromurl {
455 if ( defined $imageurl and $imageurl !~ m/^http/ ) {
456 $imageurl = getitemtypeimagesrc() . '/' . $imageurl;
462 sub getitemtypeimagedir {
464 if ($src eq 'intranet') {
465 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
468 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('template') . '/itemtypeimg';
472 sub getitemtypeimagesrc {
474 if ($src eq 'intranet') {
475 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
478 return '/opac-tmpl' . '/' . C4::Context->preference('template') . '/itemtypeimg';
482 =head3 _getImagesFromDirectory
484 Find all of the image files in a directory in the filesystem
489 returns: a list of images in that directory.
491 Notes: this does not traverse into subdirectories. See
492 _getSubdirectoryNames for help with that.
493 Images are assumed to be files with .gif or .png file extensions.
494 The image names returned do not have the directory name on them.
498 sub _getImagesFromDirectory {
499 my $directoryname = shift;
500 return unless defined $directoryname;
501 return unless -d $directoryname;
503 if ( opendir ( my $dh, $directoryname ) ) {
504 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
508 warn "unable to opendir $directoryname: $!";
513 =head3 _getSubdirectoryNames
515 Find all of the directories in a directory in the filesystem
520 returns: a list of subdirectories in that directory.
522 Notes: this does not traverse into subdirectories. Only the first
523 level of subdirectories are returned.
524 The directory names returned don't have the parent directory name
529 sub _getSubdirectoryNames {
530 my $directoryname = shift;
531 return unless defined $directoryname;
532 return unless -d $directoryname;
534 if ( opendir ( my $dh, $directoryname ) ) {
535 my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
539 warn "unable to opendir $directoryname: $!";
546 returns: a listref of hashrefs. Each hash represents another collection of images.
547 { imagesetname => 'npl', # the name of the image set (npl is the original one)
548 images => listref of image hashrefs
551 each image is represented by a hashref like this:
552 { KohaImage => 'npl/image.gif',
553 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
554 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
555 checked => 0 or 1: was this the image passed to this method?
556 Note: I'd like to remove this somehow.
563 my $checked = $params{'checked'} || '';
565 my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
566 url => getitemtypeimagesrc('intranet'),
568 opac => { filesystem => getitemtypeimagedir('opac'),
569 url => getitemtypeimagesrc('opac'),
573 my @imagesets = (); # list of hasrefs of image set data to pass to template
574 my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
576 foreach my $imagesubdir ( @subdirectories ) {
577 my @imagelist = (); # hashrefs of image info
578 my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
579 foreach my $thisimage ( @imagenames ) {
581 { KohaImage => "$imagesubdir/$thisimage",
582 StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
583 OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
584 checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
588 push @imagesets, { imagesetname => $imagesubdir,
589 images => \@imagelist };
597 $printers = &GetPrinters();
598 @queues = keys %$printers;
600 Returns information about existing printer queues.
602 C<$printers> is a reference-to-hash whose keys are the print queues
603 defined in the printers table of the Koha database. The values are
604 references-to-hash, whose keys are the fields in the printers table.
610 my $dbh = C4::Context->dbh;
611 my $sth = $dbh->prepare("select * from printers");
613 while ( my $printer = $sth->fetchrow_hashref ) {
614 $printers{ $printer->{'printqueue'} } = $printer;
616 return ( \%printers );
621 $printer = GetPrinter( $query, $printers );
625 sub GetPrinter ($$) {
626 my ( $query, $printers ) = @_; # get printer for this query from printers
627 my $printer = $query->param('printer');
628 my %cookie = $query->cookie('userenv');
629 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
630 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
636 Returns the number of pages to display in a pagination bar, given the number
637 of items and the number of items per page.
642 my ( $nb_items, $nb_items_per_page ) = @_;
644 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
649 (@themes) = &getallthemes('opac');
650 (@themes) = &getallthemes('intranet');
652 Returns an array of all available themes.
660 if ( $type eq 'intranet' ) {
661 $htdocs = C4::Context->config('intrahtdocs');
664 $htdocs = C4::Context->config('opachtdocs');
666 opendir D, "$htdocs";
667 my @dirlist = readdir D;
668 foreach my $directory (@dirlist) {
669 -d "$htdocs/$directory/en" and push @themes, $directory;
676 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
679 link_value => 'su-to',
680 label_value => 'Topics',
682 [ '600', '601', '602', '603', '604', '605', '606', '610' ],
686 link_value => 'su-geo',
687 label_value => 'Places',
692 link_value => 'su-ut',
693 label_value => 'Titles',
694 tags => [ '500', '501', '502', '503', '504', ],
699 label_value => 'Authors',
700 tags => [ '700', '701', '702', ],
705 label_value => 'Series',
714 link_value => 'branch',
715 label_value => 'Libraries',
720 push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
725 link_value => 'su-to',
726 label_value => 'Topics',
732 # link_value => 'su-na',
733 # label_value => 'People and Organizations',
734 # tags => ['600', '610', '611'],
738 link_value => 'su-geo',
739 label_value => 'Places',
744 link_value => 'su-ut',
745 label_value => 'Titles',
751 label_value => 'Authors',
752 tags => [ '100', '110', '700', ],
757 label_value => 'Series',
758 tags => [ '440', '490', ],
764 link_value => 'branch',
765 label_value => 'Libraries',
770 push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
777 Return a href where a key is associated to a href. You give a query, the
778 name of the key among the fields returned by the query. If you also give as
779 third argument the name of the value, the function returns a href of scalar.
788 # generic href of any information on the item, href of href.
789 my $iteminfos_of = get_infos_of($query, 'itemnumber');
790 print $iteminfos_of->{$itemnumber}{barcode};
792 # specific information, href of scalar
793 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
794 print $barcode_of_item->{$itemnumber};
799 my ( $query, $key_name, $value_name ) = @_;
801 my $dbh = C4::Context->dbh;
803 my $sth = $dbh->prepare($query);
807 while ( my $row = $sth->fetchrow_hashref ) {
808 if ( defined $value_name ) {
809 $infos_of{ $row->{$key_name} } = $row->{$value_name};
812 $infos_of{ $row->{$key_name} } = $row;
820 =head2 get_notforloan_label_of
822 my $notforloan_label_of = get_notforloan_label_of();
824 Each authorised value of notforloan (information available in items and
825 itemtypes) is link to a single label.
827 Returns a href where keys are authorised values and values are corresponding
830 foreach my $authorised_value (keys %{$notforloan_label_of}) {
832 "authorised_value: %s => %s\n",
834 $notforloan_label_of->{$authorised_value}
840 # FIXME - why not use GetAuthorisedValues ??
842 sub get_notforloan_label_of {
843 my $dbh = C4::Context->dbh;
846 SELECT authorised_value
847 FROM marc_subfield_structure
848 WHERE kohafield = \'items.notforloan\'
851 my $sth = $dbh->prepare($query);
853 my ($statuscode) = $sth->fetchrow_array();
858 FROM authorised_values
861 $sth = $dbh->prepare($query);
862 $sth->execute($statuscode);
863 my %notforloan_label_of;
864 while ( my $row = $sth->fetchrow_hashref ) {
865 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
869 return \%notforloan_label_of;
873 my ( $position, $type ) = @_;
874 my $dbh = C4::Context->dbh;
875 my $strsth = "SELECT * FROM z3950servers where 1";
876 $strsth .= " AND position=\"$position\"" if ($position);
877 $strsth .= " AND type=\"$type\"" if ($type);
878 my $rq = $dbh->prepare($strsth);
880 my @primaryserverloop;
882 while ( my $data = $rq->fetchrow_hashref ) {
884 $cell{label} = $data->{'description'};
885 $cell{id} = $data->{'name'};
888 . ( $data->{port} ? ":" . $data->{port} : "" ) . "/"
890 if ( $data->{host} );
891 $cell{checked} = $data->{checked};
892 push @primaryserverloop,
894 label => $data->{description},
897 value => $data->{host} . ":"
898 . $data->{port} . "/"
900 encoding => ($data->{encoding}?$data->{encoding}:"iso-5426"),
901 checked => "checked",
902 icon => $data->{icon},
903 zed => $data->{type} eq 'zed',
904 opensearch => $data->{type} eq 'opensearch'
907 return \@primaryserverloop;
910 sub displaySecondaryServers {
912 # my $secondary_servers_loop = [
913 # { inner_sup_servers_loop => [
914 # {label => "Google", id=>"GOOG", value=>"google",icon => "google.ico",opensearch => "1"},
915 # {label => "Yahoo", id=>"YAH", value=>"yahoo", icon =>"yahoo.ico", zed => "1"},
916 # {label => "Worldcat", id=>"WCT", value=>"worldcat", icon => "worldcat.gif", zed => "1"},
917 # {label => "Library of Congress", id=>"LOC", name=> "server", value=>"z3950.loc.gov:7090/Voyager", icon =>"loc.ico", zed => "1"},
921 return; #$secondary_servers_loop;
924 =head2 GetAuthValCode
926 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
931 my ($kohafield,$fwcode) = @_;
932 my $dbh = C4::Context->dbh;
933 $fwcode='' unless $fwcode;
934 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
935 $sth->execute($kohafield,$fwcode);
936 my ($authvalcode) = $sth->fetchrow_array;
940 =head2 GetAuthorisedValues
942 $authvalues = GetAuthorisedValues($category);
944 this function get all authorised values from 'authosied_value' table into a reference to array which
945 each value containt an hashref.
947 Set C<$category> on input args if you want to limits your query to this one. This params is not mandatory.
951 sub GetAuthorisedValues {
952 my ($category,$selected) = @_;
955 my $dbh = C4::Context->dbh;
956 my $query = "SELECT * FROM authorised_values";
957 $query .= " WHERE category = '" . $category . "'" if $category;
959 my $sth = $dbh->prepare($query);
961 while (my $data=$sth->fetchrow_hashref) {
962 if ($selected eq $data->{'authorised_value'} ) {
963 $data->{'selected'} = 1;
965 $results[$count] = $data;
968 #my $data = $sth->fetchall_arrayref({});
969 return \@results; #$data;
972 =head2 GetKohaAuthorisedValues
974 Takes $kohafield, $fwcode as parameters.
975 Returns hashref of Code => description
977 if no authorised value category is defined for the kohafield.
981 sub GetKohaAuthorisedValues {
982 my ($kohafield,$fwcode,$codedvalue) = @_;
983 $fwcode='' unless $fwcode;
985 my $dbh = C4::Context->dbh;
986 my $avcode = GetAuthValCode($kohafield,$fwcode);
988 my $sth = $dbh->prepare("select authorised_value, lib from authorised_values where category=? ");
989 $sth->execute($avcode);
990 while ( my ($val, $lib) = $sth->fetchrow_array ) {
999 =head2 GetManagedTagSubfields
1003 $res = GetManagedTagSubfields();
1007 Returns a reference to a big hash of hash, with the Marc structure fro the given frameworkcode
1009 NOTE: This function is used only by the (incomplete) bulk editing feature. Since
1010 that feature currently does not deal with items and biblioitems changes
1011 correctly, those tags are specifically excluded from the list prepared
1014 For future reference, if a bulk item editing feature is implemented at some point, it
1015 needs some design thought -- for example, circulation status fields should not
1016 be changed willy-nilly.
1020 sub GetManagedTagSubfields{
1021 my $dbh=C4::Context->dbh;
1022 my $rq=$dbh->prepare(qq|
1024 DISTINCT CONCAT( marc_subfield_structure.tagfield, tagsubfield ) AS tagsubfield,
1025 marc_subfield_structure.liblibrarian as subfielddesc,
1026 marc_tag_structure.liblibrarian as tagdesc
1027 FROM marc_subfield_structure
1028 LEFT JOIN marc_tag_structure
1029 ON marc_tag_structure.tagfield = marc_subfield_structure.tagfield
1030 AND marc_tag_structure.frameworkcode = marc_subfield_structure.frameworkcode
1031 WHERE marc_subfield_structure.tab>=0
1032 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield like 'items.%')
1033 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield = 'biblioitems.itemtype')
1034 AND marc_subfield_structure.kohafield <> 'biblio.biblionumber'
1035 AND marc_subfield_structure.kohafield <> 'biblioitems.biblioitemnumber'
1036 ORDER BY marc_subfield_structure.tagfield, tagsubfield|);
1038 my $data=$rq->fetchall_arrayref({});
1042 =head2 str_to_base64
1046 my $base64 = str_to_base64($string_containing_unicode);
1050 Get a Base64 version of a string that is in UTF-8. This
1051 function can be used to convert an arbitrary coded value
1052 (like a branch code) into a form that can be safely concatenated
1053 with similarly encoded values for a HTML form input name, as
1054 in admin/issuingrules.pl.
1060 return encode_base64(encode("UTF-8", $in), '');
1063 =head2 base64_to_str
1067 my $base64 = base64_to_str($string_containing_unicode);
1071 Converse of C<str_to_base64()>.
1077 return decode("UTF-8", decode_base64($in));