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 &GetAuthorisedValueCategories
55 &GetKohaAuthorisedValues
57 &GetManagedTagSubfields
68 C4::Koha - Perl Module containing convenience functions for Koha scripts
77 Koha.pm provides many functions for Koha scripts.
86 $slash_date = &slashifyDate($dash_date);
88 Takes a string of the form "DD-MM-YYYY" (or anything separated by
89 dashes), converts it to the form "YYYY/MM/DD", and returns the result.
95 # accepts a date of the form xx-xx-xx[xx] and returns it in the
97 my @dateOut = split( '-', shift );
98 return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
104 my $string = DisplayISBN( $isbn );
110 if (length ($isbn)<13){
112 if ( substr( $isbn, 0, 1 ) <= 7 ) {
113 $seg1 = substr( $isbn, 0, 1 );
115 elsif ( substr( $isbn, 0, 2 ) <= 94 ) {
116 $seg1 = substr( $isbn, 0, 2 );
118 elsif ( substr( $isbn, 0, 3 ) <= 995 ) {
119 $seg1 = substr( $isbn, 0, 3 );
121 elsif ( substr( $isbn, 0, 4 ) <= 9989 ) {
122 $seg1 = substr( $isbn, 0, 4 );
125 $seg1 = substr( $isbn, 0, 5 );
127 my $x = substr( $isbn, length($seg1) );
129 if ( substr( $x, 0, 2 ) <= 19 ) {
131 # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
132 $seg2 = substr( $x, 0, 2 );
134 elsif ( substr( $x, 0, 3 ) <= 699 ) {
135 $seg2 = substr( $x, 0, 3 );
137 elsif ( substr( $x, 0, 4 ) <= 8399 ) {
138 $seg2 = substr( $x, 0, 4 );
140 elsif ( substr( $x, 0, 5 ) <= 89999 ) {
141 $seg2 = substr( $x, 0, 5 );
143 elsif ( substr( $x, 0, 6 ) <= 9499999 ) {
144 $seg2 = substr( $x, 0, 6 );
147 $seg2 = substr( $x, 0, 7 );
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";
155 $seg1 = substr( $isbn, 0, 3 );
157 if ( substr( $isbn, 3, 1 ) <= 7 ) {
158 $seg2 = substr( $isbn, 3, 1 );
160 elsif ( substr( $isbn, 3, 2 ) <= 94 ) {
161 $seg2 = substr( $isbn, 3, 2 );
163 elsif ( substr( $isbn, 3, 3 ) <= 995 ) {
164 $seg2 = substr( $isbn, 3, 3 );
166 elsif ( substr( $isbn, 3, 4 ) <= 9989 ) {
167 $seg2 = substr( $isbn, 3, 4 );
170 $seg2 = substr( $isbn, 3, 5 );
172 my $x = substr( $isbn, length($seg2) +3);
174 if ( substr( $x, 0, 2 ) <= 19 ) {
176 # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
177 $seg3 = substr( $x, 0, 2 );
179 elsif ( substr( $x, 0, 3 ) <= 699 ) {
180 $seg3 = substr( $x, 0, 3 );
182 elsif ( substr( $x, 0, 4 ) <= 8399 ) {
183 $seg3 = substr( $x, 0, 4 );
185 elsif ( substr( $x, 0, 5 ) <= 89999 ) {
186 $seg3 = substr( $x, 0, 5 );
188 elsif ( substr( $x, 0, 6 ) <= 9499999 ) {
189 $seg3 = substr( $x, 0, 6 );
192 $seg3 = substr( $x, 0, 7 );
194 my $seg4 = substr( $x, length($seg3) );
195 $seg4 = substr( $seg4, 0, length($seg4) - 1 );
196 my $seg5 = substr( $x, -1, 1 );
197 return "$seg1-$seg2-$seg3-$seg4-$seg5";
201 # FIXME.. this should be moved to a MARC-specific module
202 sub subfield_is_koha_internal_p
($) {
205 # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
206 # But real MARC subfields are always single-character
207 # so it really is safer just to check the length
209 return length $subfield != 1;
214 $itemtypes = &GetItemTypes();
216 Returns information about existing itemtypes.
218 build a HTML select with the following code :
220 =head3 in PERL SCRIPT
222 my $itemtypes = GetItemTypes;
224 foreach my $thisitemtype (sort keys %$itemtypes) {
225 my $selected = 1 if $thisitemtype eq $itemtype;
226 my %row =(value => $thisitemtype,
227 selected => $selected,
228 description => $itemtypes->{$thisitemtype}->{'description'},
230 push @itemtypesloop, \%row;
232 $template->param(itemtypeloop => \@itemtypesloop);
236 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
237 <select name="itemtype">
238 <option value="">Default</option>
239 <!-- TMPL_LOOP name="itemtypeloop" -->
240 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
243 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
244 <input type="submit" value="OK" class="button">
251 # returns a reference to a hash of references to branches...
253 my $dbh = C4
::Context
->dbh;
258 my $sth = $dbh->prepare($query);
260 while ( my $IT = $sth->fetchrow_hashref ) {
261 $itemtypes{ $IT->{'itemtype'} } = $IT;
263 return ( \
%itemtypes );
266 sub get_itemtypeinfos_of
{
275 WHERE itemtype IN (' . join( ',', map( { "'" . $_ . "'" } @itemtypes ) ) . ')
278 return get_infos_of
( $query, 'itemtype' );
281 # this is temporary until we separate collection codes and item types
285 my $dbh = C4
::Context
->dbh;
288 "SELECT * FROM authorised_values ORDER BY authorised_value");
290 while ( my $data = $sth->fetchrow_hashref ) {
291 if ( $data->{category
} eq "CCODE" ) {
293 $results[$count] = $data;
299 return ( $count, @results );
304 $authtypes = &getauthtypes();
306 Returns information about existing authtypes.
308 build a HTML select with the following code :
310 =head3 in PERL SCRIPT
312 my $authtypes = getauthtypes;
314 foreach my $thisauthtype (keys %$authtypes) {
315 my $selected = 1 if $thisauthtype eq $authtype;
316 my %row =(value => $thisauthtype,
317 selected => $selected,
318 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
320 push @authtypesloop, \%row;
322 $template->param(itemtypeloop => \@itemtypesloop);
326 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
327 <select name="authtype">
328 <!-- TMPL_LOOP name="authtypeloop" -->
329 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
332 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
333 <input type="submit" value="OK" class="button">
341 # returns a reference to a hash of references to authtypes...
343 my $dbh = C4
::Context
->dbh;
344 my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
346 while ( my $IT = $sth->fetchrow_hashref ) {
347 $authtypes{ $IT->{'authtypecode'} } = $IT;
349 return ( \
%authtypes );
353 my ($authtypecode) = @_;
355 # returns a reference to a hash of references to authtypes...
357 my $dbh = C4
::Context
->dbh;
358 my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
359 $sth->execute($authtypecode);
360 my $res = $sth->fetchrow_hashref;
366 $frameworks = &getframework();
368 Returns information about existing frameworks
370 build a HTML select with the following code :
372 =head3 in PERL SCRIPT
374 my $frameworks = frameworks();
376 foreach my $thisframework (keys %$frameworks) {
377 my $selected = 1 if $thisframework eq $frameworkcode;
378 my %row =(value => $thisframework,
379 selected => $selected,
380 description => $frameworks->{$thisframework}->{'frameworktext'},
382 push @frameworksloop, \%row;
384 $template->param(frameworkloop => \@frameworksloop);
388 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
389 <select name="frameworkcode">
390 <option value="">Default</option>
391 <!-- TMPL_LOOP name="frameworkloop" -->
392 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
395 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
396 <input type="submit" value="OK" class="button">
404 # returns a reference to a hash of references to branches...
406 my $dbh = C4
::Context
->dbh;
407 my $sth = $dbh->prepare("select * from biblio_framework");
409 while ( my $IT = $sth->fetchrow_hashref ) {
410 $itemtypes{ $IT->{'frameworkcode'} } = $IT;
412 return ( \
%itemtypes );
415 =head2 getframeworkinfo
417 $frameworkinfo = &getframeworkinfo($frameworkcode);
419 Returns information about an frameworkcode.
423 sub getframeworkinfo
{
424 my ($frameworkcode) = @_;
425 my $dbh = C4
::Context
->dbh;
427 $dbh->prepare("select * from biblio_framework where frameworkcode=?");
428 $sth->execute($frameworkcode);
429 my $res = $sth->fetchrow_hashref;
433 =head2 getitemtypeinfo
435 $itemtype = &getitemtype($itemtype);
437 Returns information about an itemtype.
441 sub getitemtypeinfo
{
443 my $dbh = C4
::Context
->dbh;
444 my $sth = $dbh->prepare("select * from itemtypes where itemtype=?");
445 $sth->execute($itemtype);
446 my $res = $sth->fetchrow_hashref;
448 $res->{imageurl
} = getitemtypeimagesrcfromurl
( $res->{imageurl
} );
453 sub getitemtypeimagesrcfromurl
{
456 if ( defined $imageurl and $imageurl !~ m/^http/ ) {
457 $imageurl = getitemtypeimagesrc
() . '/' . $imageurl;
463 sub getitemtypeimagedir
{
465 if ($src eq 'intranet') {
466 return C4
::Context
->config('intrahtdocs') . '/' .C4
::Context
->preference('template') . '/img/itemtypeimg';
469 return C4
::Context
->config('opachtdocs') . '/' . C4
::Context
->preference('template') . '/itemtypeimg';
473 sub getitemtypeimagesrc
{
475 if ($src eq 'intranet') {
476 return '/intranet-tmpl' . '/' . C4
::Context
->preference('template') . '/img/itemtypeimg';
479 return '/opac-tmpl' . '/' . C4
::Context
->preference('template') . '/itemtypeimg';
483 =head3 _getImagesFromDirectory
485 Find all of the image files in a directory in the filesystem
490 returns: a list of images in that directory.
492 Notes: this does not traverse into subdirectories. See
493 _getSubdirectoryNames for help with that.
494 Images are assumed to be files with .gif or .png file extensions.
495 The image names returned do not have the directory name on them.
499 sub _getImagesFromDirectory
{
500 my $directoryname = shift;
501 return unless defined $directoryname;
502 return unless -d
$directoryname;
504 if ( opendir ( my $dh, $directoryname ) ) {
505 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
509 warn "unable to opendir $directoryname: $!";
514 =head3 _getSubdirectoryNames
516 Find all of the directories in a directory in the filesystem
521 returns: a list of subdirectories in that directory.
523 Notes: this does not traverse into subdirectories. Only the first
524 level of subdirectories are returned.
525 The directory names returned don't have the parent directory name
530 sub _getSubdirectoryNames
{
531 my $directoryname = shift;
532 return unless defined $directoryname;
533 return unless -d
$directoryname;
535 if ( opendir ( my $dh, $directoryname ) ) {
536 my @directories = grep { -d File
::Spec
->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
540 warn "unable to opendir $directoryname: $!";
547 returns: a listref of hashrefs. Each hash represents another collection of images.
548 { imagesetname => 'npl', # the name of the image set (npl is the original one)
549 images => listref of image hashrefs
552 each image is represented by a hashref like this:
553 { KohaImage => 'npl/image.gif',
554 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
555 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
556 checked => 0 or 1: was this the image passed to this method?
557 Note: I'd like to remove this somehow.
564 my $checked = $params{'checked'} || '';
566 my $paths = { staff
=> { filesystem
=> getitemtypeimagedir
('intranet'),
567 url
=> getitemtypeimagesrc
('intranet'),
569 opac
=> { filesystem
=> getitemtypeimagedir
('opac'),
570 url
=> getitemtypeimagesrc
('opac'),
574 my @imagesets = (); # list of hasrefs of image set data to pass to template
575 my @subdirectories = _getSubdirectoryNames
( $paths->{'staff'}{'filesystem'} );
577 foreach my $imagesubdir ( @subdirectories ) {
578 my @imagelist = (); # hashrefs of image info
579 my @imagenames = _getImagesFromDirectory
( File
::Spec
->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
580 foreach my $thisimage ( @imagenames ) {
582 { KohaImage
=> "$imagesubdir/$thisimage",
583 StaffImageUrl
=> join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
584 OpacImageUrl
=> join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
585 checked
=> "$imagesubdir/$thisimage" eq $checked ?
1 : 0,
589 push @imagesets, { imagesetname
=> $imagesubdir,
590 images
=> \
@imagelist };
598 $printers = &GetPrinters();
599 @queues = keys %$printers;
601 Returns information about existing printer queues.
603 C<$printers> is a reference-to-hash whose keys are the print queues
604 defined in the printers table of the Koha database. The values are
605 references-to-hash, whose keys are the fields in the printers table.
611 my $dbh = C4
::Context
->dbh;
612 my $sth = $dbh->prepare("select * from printers");
614 while ( my $printer = $sth->fetchrow_hashref ) {
615 $printers{ $printer->{'printqueue'} } = $printer;
617 return ( \
%printers );
622 $printer = GetPrinter( $query, $printers );
626 sub GetPrinter
($$) {
627 my ( $query, $printers ) = @_; # get printer for this query from printers
628 my $printer = $query->param('printer');
629 my %cookie = $query->cookie('userenv');
630 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
631 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
637 Returns the number of pages to display in a pagination bar, given the number
638 of items and the number of items per page.
643 my ( $nb_items, $nb_items_per_page ) = @_;
645 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
650 (@themes) = &getallthemes('opac');
651 (@themes) = &getallthemes('intranet');
653 Returns an array of all available themes.
661 if ( $type eq 'intranet' ) {
662 $htdocs = C4
::Context
->config('intrahtdocs');
665 $htdocs = C4
::Context
->config('opachtdocs');
667 opendir D
, "$htdocs";
668 my @dirlist = readdir D
;
669 foreach my $directory (@dirlist) {
670 -d
"$htdocs/$directory/en" and push @themes, $directory;
677 if ( C4
::Context
->preference("marcflavour") eq "UNIMARC" ) {
680 link_value
=> 'su-to',
681 label_value
=> 'Topics',
683 [ '600', '601', '602', '603', '604', '605', '606', '610' ],
687 link_value
=> 'su-geo',
688 label_value
=> 'Places',
693 link_value
=> 'su-ut',
694 label_value
=> 'Titles',
695 tags
=> [ '500', '501', '502', '503', '504', ],
700 label_value
=> 'Authors',
701 tags
=> [ '700', '701', '702', ],
706 label_value
=> 'Series',
715 link_value
=> 'branch',
716 label_value
=> 'Libraries',
721 push @
$facets, $library_facet unless C4
::Context
->preference("singleBranchMode");
726 link_value
=> 'su-to',
727 label_value
=> 'Topics',
733 # link_value => 'su-na',
734 # label_value => 'People and Organizations',
735 # tags => ['600', '610', '611'],
739 link_value
=> 'su-geo',
740 label_value
=> 'Places',
745 link_value
=> 'su-ut',
746 label_value
=> 'Titles',
752 label_value
=> 'Authors',
753 tags
=> [ '100', '110', '700', ],
758 label_value
=> 'Series',
759 tags
=> [ '440', '490', ],
765 link_value
=> 'branch',
766 label_value
=> 'Libraries',
771 push @
$facets, $library_facet unless C4
::Context
->preference("singleBranchMode");
778 Return a href where a key is associated to a href. You give a query, the
779 name of the key among the fields returned by the query. If you also give as
780 third argument the name of the value, the function returns a href of scalar.
789 # generic href of any information on the item, href of href.
790 my $iteminfos_of = get_infos_of($query, 'itemnumber');
791 print $iteminfos_of->{$itemnumber}{barcode};
793 # specific information, href of scalar
794 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
795 print $barcode_of_item->{$itemnumber};
800 my ( $query, $key_name, $value_name ) = @_;
802 my $dbh = C4
::Context
->dbh;
804 my $sth = $dbh->prepare($query);
808 while ( my $row = $sth->fetchrow_hashref ) {
809 if ( defined $value_name ) {
810 $infos_of{ $row->{$key_name} } = $row->{$value_name};
813 $infos_of{ $row->{$key_name} } = $row;
821 =head2 get_notforloan_label_of
823 my $notforloan_label_of = get_notforloan_label_of();
825 Each authorised value of notforloan (information available in items and
826 itemtypes) is link to a single label.
828 Returns a href where keys are authorised values and values are corresponding
831 foreach my $authorised_value (keys %{$notforloan_label_of}) {
833 "authorised_value: %s => %s\n",
835 $notforloan_label_of->{$authorised_value}
841 # FIXME - why not use GetAuthorisedValues ??
843 sub get_notforloan_label_of
{
844 my $dbh = C4
::Context
->dbh;
847 SELECT authorised_value
848 FROM marc_subfield_structure
849 WHERE kohafield = \'items.notforloan\'
852 my $sth = $dbh->prepare($query);
854 my ($statuscode) = $sth->fetchrow_array();
859 FROM authorised_values
862 $sth = $dbh->prepare($query);
863 $sth->execute($statuscode);
864 my %notforloan_label_of;
865 while ( my $row = $sth->fetchrow_hashref ) {
866 $notforloan_label_of{ $row->{authorised_value
} } = $row->{lib
};
870 return \
%notforloan_label_of;
874 my ( $position, $type ) = @_;
875 my $dbh = C4
::Context
->dbh;
876 my $strsth = "SELECT * FROM z3950servers where 1";
877 $strsth .= " AND position=\"$position\"" if ($position);
878 $strsth .= " AND type=\"$type\"" if ($type);
879 my $rq = $dbh->prepare($strsth);
881 my @primaryserverloop;
883 while ( my $data = $rq->fetchrow_hashref ) {
885 $cell{label
} = $data->{'description'};
886 $cell{id
} = $data->{'name'};
889 . ( $data->{port
} ?
":" . $data->{port
} : "" ) . "/"
891 if ( $data->{host
} );
892 $cell{checked
} = $data->{checked
};
893 push @primaryserverloop,
895 label
=> $data->{description
},
898 value
=> $data->{host
} . ":"
899 . $data->{port
} . "/"
901 encoding
=> ($data->{encoding
}?
$data->{encoding
}:"iso-5426"),
902 checked
=> "checked",
903 icon
=> $data->{icon
},
904 zed
=> $data->{type
} eq 'zed',
905 opensearch
=> $data->{type
} eq 'opensearch'
908 return \
@primaryserverloop;
911 sub displaySecondaryServers
{
913 # my $secondary_servers_loop = [
914 # { inner_sup_servers_loop => [
915 # {label => "Google", id=>"GOOG", value=>"google",icon => "google.ico",opensearch => "1"},
916 # {label => "Yahoo", id=>"YAH", value=>"yahoo", icon =>"yahoo.ico", zed => "1"},
917 # {label => "Worldcat", id=>"WCT", value=>"worldcat", icon => "worldcat.gif", zed => "1"},
918 # {label => "Library of Congress", id=>"LOC", name=> "server", value=>"z3950.loc.gov:7090/Voyager", icon =>"loc.ico", zed => "1"},
922 return; #$secondary_servers_loop;
925 =head2 GetAuthValCode
927 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
932 my ($kohafield,$fwcode) = @_;
933 my $dbh = C4
::Context
->dbh;
934 $fwcode='' unless $fwcode;
935 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
936 $sth->execute($kohafield,$fwcode);
937 my ($authvalcode) = $sth->fetchrow_array;
941 =head2 GetAuthorisedValues
943 $authvalues = GetAuthorisedValues($category);
945 this function get all authorised values from 'authosied_value' table into a reference to array which
946 each value containt an hashref.
948 Set C<$category> on input args if you want to limits your query to this one. This params is not mandatory.
952 sub GetAuthorisedValues
{
953 my ($category,$selected) = @_;
956 my $dbh = C4
::Context
->dbh;
957 my $query = "SELECT * FROM authorised_values";
958 $query .= " WHERE category = '" . $category . "'" if $category;
960 my $sth = $dbh->prepare($query);
962 while (my $data=$sth->fetchrow_hashref) {
963 if ($selected eq $data->{'authorised_value'} ) {
964 $data->{'selected'} = 1;
966 $results[$count] = $data;
969 #my $data = $sth->fetchall_arrayref({});
970 return \
@results; #$data;
973 =head2 GetAuthorisedValueCategories
975 $auth_categories = GetAuthorisedValueCategories();
977 Return an arrayref of all of the available authorised
982 sub GetAuthorisedValueCategories
{
983 my $dbh = C4
::Context
->dbh;
984 my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
987 while (my $category = $sth->fetchrow_array) {
988 push @results, $category;
993 =head2 GetKohaAuthorisedValues
995 Takes $kohafield, $fwcode as parameters.
996 Returns hashref of Code => description
998 if no authorised value category is defined for the kohafield.
1002 sub GetKohaAuthorisedValues
{
1003 my ($kohafield,$fwcode,$codedvalue) = @_;
1004 $fwcode='' unless $fwcode;
1006 my $dbh = C4
::Context
->dbh;
1007 my $avcode = GetAuthValCode
($kohafield,$fwcode);
1009 my $sth = $dbh->prepare("select authorised_value, lib from authorised_values where category=? ");
1010 $sth->execute($avcode);
1011 while ( my ($val, $lib) = $sth->fetchrow_array ) {
1012 $values{$val}= $lib;
1020 =head2 GetManagedTagSubfields
1024 $res = GetManagedTagSubfields();
1028 Returns a reference to a big hash of hash, with the Marc structure fro the given frameworkcode
1030 NOTE: This function is used only by the (incomplete) bulk editing feature. Since
1031 that feature currently does not deal with items and biblioitems changes
1032 correctly, those tags are specifically excluded from the list prepared
1035 For future reference, if a bulk item editing feature is implemented at some point, it
1036 needs some design thought -- for example, circulation status fields should not
1037 be changed willy-nilly.
1041 sub GetManagedTagSubfields
{
1042 my $dbh=C4
::Context
->dbh;
1043 my $rq=$dbh->prepare(qq|
1045 DISTINCT CONCAT
( marc_subfield_structure
.tagfield
, tagsubfield
) AS tagsubfield
,
1046 marc_subfield_structure
.liblibrarian as subfielddesc
,
1047 marc_tag_structure
.liblibrarian as tagdesc
1048 FROM marc_subfield_structure
1049 LEFT JOIN marc_tag_structure
1050 ON marc_tag_structure
.tagfield
= marc_subfield_structure
.tagfield
1051 AND marc_tag_structure
.frameworkcode
= marc_subfield_structure
.frameworkcode
1052 WHERE marc_subfield_structure
.tab
>=0
1053 AND marc_tag_structure
.tagfield NOT IN
(SELECT tagfield FROM marc_subfield_structure WHERE kohafield like
'items.%')
1054 AND marc_tag_structure
.tagfield NOT IN
(SELECT tagfield FROM marc_subfield_structure WHERE kohafield
= 'biblioitems.itemtype')
1055 AND marc_subfield_structure
.kohafield
<> 'biblio.biblionumber'
1056 AND marc_subfield_structure
.kohafield
<> 'biblioitems.biblioitemnumber'
1057 ORDER BY marc_subfield_structure
.tagfield
, tagsubfield
|);
1059 my $data=$rq->fetchall_arrayref({});
1063 =head2 str_to_base64
1067 my $base64 = str_to_base64($string_containing_unicode);
1071 Get a Base64 version of a string that is in UTF-8. This
1072 function can be used to convert an arbitrary coded value
1073 (like a branch code) into a form that can be safely concatenated
1074 with similarly encoded values for a HTML form input name, as
1075 in admin/issuingrules.pl.
1081 return encode_base64
(encode
("UTF-8", $in), '');
1084 =head2 base64_to_str
1088 my $base64 = base64_to_str($string_containing_unicode);
1092 Converse of C<str_to_base64()>.
1098 return decode
("UTF-8", decode_base64
($in));