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 vars qw($VERSION @ISA @EXPORT $DEBUG);
34 &subfield_is_koha_internal_p
35 &GetPrinters &GetPrinter
36 &GetItemTypes &getitemtypeinfo
39 &getframeworks &getframeworkinfo
40 &getauthtypes &getauthtype
45 &getitemtypeimagesrcfromurl
47 &get_notforloan_label_of
51 &GetAuthorisedValueCategories
52 &GetKohaAuthorisedValues
54 &GetManagedTagSubfields
63 C4::Koha - Perl Module containing convenience functions for Koha scripts
72 Koha.pm provides many functions for Koha scripts.
80 $slash_date = &slashifyDate($dash_date);
82 Takes a string of the form "DD-MM-YYYY" (or anything separated by
83 dashes), converts it to the form "YYYY/MM/DD", and returns the result.
89 # accepts a date of the form xx-xx-xx[xx] and returns it in the
91 my @dateOut = split( '-', shift );
92 return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
98 my $string = DisplayISBN( $isbn );
104 if (length ($isbn)<13){
106 if ( substr( $isbn, 0, 1 ) <= 7 ) {
107 $seg1 = substr( $isbn, 0, 1 );
109 elsif ( substr( $isbn, 0, 2 ) <= 94 ) {
110 $seg1 = substr( $isbn, 0, 2 );
112 elsif ( substr( $isbn, 0, 3 ) <= 995 ) {
113 $seg1 = substr( $isbn, 0, 3 );
115 elsif ( substr( $isbn, 0, 4 ) <= 9989 ) {
116 $seg1 = substr( $isbn, 0, 4 );
119 $seg1 = substr( $isbn, 0, 5 );
121 my $x = substr( $isbn, length($seg1) );
123 if ( substr( $x, 0, 2 ) <= 19 ) {
125 # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
126 $seg2 = substr( $x, 0, 2 );
128 elsif ( substr( $x, 0, 3 ) <= 699 ) {
129 $seg2 = substr( $x, 0, 3 );
131 elsif ( substr( $x, 0, 4 ) <= 8399 ) {
132 $seg2 = substr( $x, 0, 4 );
134 elsif ( substr( $x, 0, 5 ) <= 89999 ) {
135 $seg2 = substr( $x, 0, 5 );
137 elsif ( substr( $x, 0, 6 ) <= 9499999 ) {
138 $seg2 = substr( $x, 0, 6 );
141 $seg2 = substr( $x, 0, 7 );
143 my $seg3 = substr( $x, length($seg2) );
144 $seg3 = substr( $seg3, 0, length($seg3) - 1 );
145 my $seg4 = substr( $x, -1, 1 );
146 return "$seg1-$seg2-$seg3-$seg4";
149 $seg1 = substr( $isbn, 0, 3 );
151 if ( substr( $isbn, 3, 1 ) <= 7 ) {
152 $seg2 = substr( $isbn, 3, 1 );
154 elsif ( substr( $isbn, 3, 2 ) <= 94 ) {
155 $seg2 = substr( $isbn, 3, 2 );
157 elsif ( substr( $isbn, 3, 3 ) <= 995 ) {
158 $seg2 = substr( $isbn, 3, 3 );
160 elsif ( substr( $isbn, 3, 4 ) <= 9989 ) {
161 $seg2 = substr( $isbn, 3, 4 );
164 $seg2 = substr( $isbn, 3, 5 );
166 my $x = substr( $isbn, length($seg2) +3);
168 if ( substr( $x, 0, 2 ) <= 19 ) {
170 # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
171 $seg3 = substr( $x, 0, 2 );
173 elsif ( substr( $x, 0, 3 ) <= 699 ) {
174 $seg3 = substr( $x, 0, 3 );
176 elsif ( substr( $x, 0, 4 ) <= 8399 ) {
177 $seg3 = substr( $x, 0, 4 );
179 elsif ( substr( $x, 0, 5 ) <= 89999 ) {
180 $seg3 = substr( $x, 0, 5 );
182 elsif ( substr( $x, 0, 6 ) <= 9499999 ) {
183 $seg3 = substr( $x, 0, 6 );
186 $seg3 = substr( $x, 0, 7 );
188 my $seg4 = substr( $x, length($seg3) );
189 $seg4 = substr( $seg4, 0, length($seg4) - 1 );
190 my $seg5 = substr( $x, -1, 1 );
191 return "$seg1-$seg2-$seg3-$seg4-$seg5";
195 # FIXME.. this should be moved to a MARC-specific module
196 sub subfield_is_koha_internal_p ($) {
199 # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
200 # But real MARC subfields are always single-character
201 # so it really is safer just to check the length
203 return length $subfield != 1;
208 $itemtypes = &GetItemTypes();
210 Returns information about existing itemtypes.
212 build a HTML select with the following code :
214 =head3 in PERL SCRIPT
216 my $itemtypes = GetItemTypes;
218 foreach my $thisitemtype (sort keys %$itemtypes) {
219 my $selected = 1 if $thisitemtype eq $itemtype;
220 my %row =(value => $thisitemtype,
221 selected => $selected,
222 description => $itemtypes->{$thisitemtype}->{'description'},
224 push @itemtypesloop, \%row;
226 $template->param(itemtypeloop => \@itemtypesloop);
230 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
231 <select name="itemtype">
232 <option value="">Default</option>
233 <!-- TMPL_LOOP name="itemtypeloop" -->
234 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
237 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
238 <input type="submit" value="OK" class="button">
245 # returns a reference to a hash of references to branches...
247 my $dbh = C4::Context->dbh;
252 my $sth = $dbh->prepare($query);
254 while ( my $IT = $sth->fetchrow_hashref ) {
255 $itemtypes{ $IT->{'itemtype'} } = $IT;
257 return ( \%itemtypes );
260 sub get_itemtypeinfos_of {
263 my $placeholders = join( ', ', map { '?' } @itemtypes );
264 my $query = <<"END_SQL";
270 WHERE itemtype IN ( $placeholders )
273 return get_infos_of( $query, 'itemtype', undef, \@itemtypes );
276 # this is temporary until we separate collection codes and item types
280 my $dbh = C4::Context->dbh;
283 "SELECT * FROM authorised_values ORDER BY authorised_value");
285 while ( my $data = $sth->fetchrow_hashref ) {
286 if ( $data->{category} eq "CCODE" ) {
288 $results[$count] = $data;
294 return ( $count, @results );
299 $authtypes = &getauthtypes();
301 Returns information about existing authtypes.
303 build a HTML select with the following code :
305 =head3 in PERL SCRIPT
307 my $authtypes = getauthtypes;
309 foreach my $thisauthtype (keys %$authtypes) {
310 my $selected = 1 if $thisauthtype eq $authtype;
311 my %row =(value => $thisauthtype,
312 selected => $selected,
313 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
315 push @authtypesloop, \%row;
317 $template->param(itemtypeloop => \@itemtypesloop);
321 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
322 <select name="authtype">
323 <!-- TMPL_LOOP name="authtypeloop" -->
324 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
327 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
328 <input type="submit" value="OK" class="button">
336 # returns a reference to a hash of references to authtypes...
338 my $dbh = C4::Context->dbh;
339 my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
341 while ( my $IT = $sth->fetchrow_hashref ) {
342 $authtypes{ $IT->{'authtypecode'} } = $IT;
344 return ( \%authtypes );
348 my ($authtypecode) = @_;
350 # returns a reference to a hash of references to authtypes...
352 my $dbh = C4::Context->dbh;
353 my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
354 $sth->execute($authtypecode);
355 my $res = $sth->fetchrow_hashref;
361 $frameworks = &getframework();
363 Returns information about existing frameworks
365 build a HTML select with the following code :
367 =head3 in PERL SCRIPT
369 my $frameworks = frameworks();
371 foreach my $thisframework (keys %$frameworks) {
372 my $selected = 1 if $thisframework eq $frameworkcode;
373 my %row =(value => $thisframework,
374 selected => $selected,
375 description => $frameworks->{$thisframework}->{'frameworktext'},
377 push @frameworksloop, \%row;
379 $template->param(frameworkloop => \@frameworksloop);
383 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
384 <select name="frameworkcode">
385 <option value="">Default</option>
386 <!-- TMPL_LOOP name="frameworkloop" -->
387 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
390 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
391 <input type="submit" value="OK" class="button">
399 # returns a reference to a hash of references to branches...
401 my $dbh = C4::Context->dbh;
402 my $sth = $dbh->prepare("select * from biblio_framework");
404 while ( my $IT = $sth->fetchrow_hashref ) {
405 $itemtypes{ $IT->{'frameworkcode'} } = $IT;
407 return ( \%itemtypes );
410 =head2 getframeworkinfo
412 $frameworkinfo = &getframeworkinfo($frameworkcode);
414 Returns information about an frameworkcode.
418 sub getframeworkinfo {
419 my ($frameworkcode) = @_;
420 my $dbh = C4::Context->dbh;
422 $dbh->prepare("select * from biblio_framework where frameworkcode=?");
423 $sth->execute($frameworkcode);
424 my $res = $sth->fetchrow_hashref;
428 =head2 getitemtypeinfo
430 $itemtype = &getitemtype($itemtype);
432 Returns information about an itemtype.
436 sub getitemtypeinfo {
438 my $dbh = C4::Context->dbh;
439 my $sth = $dbh->prepare("select * from itemtypes where itemtype=?");
440 $sth->execute($itemtype);
441 my $res = $sth->fetchrow_hashref;
443 $res->{imageurl} = getitemtypeimagesrcfromurl( $res->{imageurl} );
448 sub getitemtypeimagesrcfromurl {
451 if ( defined $imageurl and $imageurl !~ m/^http/ ) {
452 $imageurl = getitemtypeimagesrc() . '/' . $imageurl;
458 =head2 getitemtypeimagedir
464 my $directory = getitemtypeimagedir( 'opac' );
466 pass in 'opac' or 'intranet'. Defaults to 'opac'.
468 returns the full path to the appropriate directory containing images.
474 sub getitemtypeimagedir {
476 $src = 'opac' unless defined $src;
478 if ($src eq 'intranet') {
479 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
482 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('template') . '/itemtypeimg';
486 sub getitemtypeimagesrc {
488 if ($src eq 'intranet') {
489 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
492 return '/opac-tmpl' . '/' . C4::Context->preference('template') . '/itemtypeimg';
496 =head3 _getImagesFromDirectory
498 Find all of the image files in a directory in the filesystem
503 returns: a list of images in that directory.
505 Notes: this does not traverse into subdirectories. See
506 _getSubdirectoryNames for help with that.
507 Images are assumed to be files with .gif or .png file extensions.
508 The image names returned do not have the directory name on them.
512 sub _getImagesFromDirectory {
513 my $directoryname = shift;
514 return unless defined $directoryname;
515 return unless -d $directoryname;
517 if ( opendir ( my $dh, $directoryname ) ) {
518 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
522 warn "unable to opendir $directoryname: $!";
527 =head3 _getSubdirectoryNames
529 Find all of the directories in a directory in the filesystem
534 returns: a list of subdirectories in that directory.
536 Notes: this does not traverse into subdirectories. Only the first
537 level of subdirectories are returned.
538 The directory names returned don't have the parent directory name
543 sub _getSubdirectoryNames {
544 my $directoryname = shift;
545 return unless defined $directoryname;
546 return unless -d $directoryname;
548 if ( opendir ( my $dh, $directoryname ) ) {
549 my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
553 warn "unable to opendir $directoryname: $!";
560 returns: a listref of hashrefs. Each hash represents another collection of images.
561 { imagesetname => 'npl', # the name of the image set (npl is the original one)
562 images => listref of image hashrefs
565 each image is represented by a hashref like this:
566 { KohaImage => 'npl/image.gif',
567 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
568 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
569 checked => 0 or 1: was this the image passed to this method?
570 Note: I'd like to remove this somehow.
577 my $checked = $params{'checked'} || '';
579 my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
580 url => getitemtypeimagesrc('intranet'),
582 opac => { filesystem => getitemtypeimagedir('opac'),
583 url => getitemtypeimagesrc('opac'),
587 my @imagesets = (); # list of hasrefs of image set data to pass to template
588 my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
590 foreach my $imagesubdir ( @subdirectories ) {
591 my @imagelist = (); # hashrefs of image info
592 my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
593 foreach my $thisimage ( @imagenames ) {
595 { KohaImage => "$imagesubdir/$thisimage",
596 StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
597 OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
598 checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
602 push @imagesets, { imagesetname => $imagesubdir,
603 images => \@imagelist };
611 $printers = &GetPrinters();
612 @queues = keys %$printers;
614 Returns information about existing printer queues.
616 C<$printers> is a reference-to-hash whose keys are the print queues
617 defined in the printers table of the Koha database. The values are
618 references-to-hash, whose keys are the fields in the printers table.
624 my $dbh = C4::Context->dbh;
625 my $sth = $dbh->prepare("select * from printers");
627 while ( my $printer = $sth->fetchrow_hashref ) {
628 $printers{ $printer->{'printqueue'} } = $printer;
630 return ( \%printers );
635 $printer = GetPrinter( $query, $printers );
639 sub GetPrinter ($$) {
640 my ( $query, $printers ) = @_; # get printer for this query from printers
641 my $printer = $query->param('printer');
642 my %cookie = $query->cookie('userenv');
643 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
644 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
650 Returns the number of pages to display in a pagination bar, given the number
651 of items and the number of items per page.
656 my ( $nb_items, $nb_items_per_page ) = @_;
658 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
663 (@themes) = &getallthemes('opac');
664 (@themes) = &getallthemes('intranet');
666 Returns an array of all available themes.
674 if ( $type eq 'intranet' ) {
675 $htdocs = C4::Context->config('intrahtdocs');
678 $htdocs = C4::Context->config('opachtdocs');
680 opendir D, "$htdocs";
681 my @dirlist = readdir D;
682 foreach my $directory (@dirlist) {
683 -d "$htdocs/$directory/en" and push @themes, $directory;
690 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
693 link_value => 'su-to',
694 label_value => 'Topics',
696 [ '600', '601', '602', '603', '604', '605', '606', '610' ],
700 link_value => 'su-geo',
701 label_value => 'Places',
706 link_value => 'su-ut',
707 label_value => 'Titles',
708 tags => [ '500', '501', '502', '503', '504', ],
713 label_value => 'Authors',
714 tags => [ '700', '701', '702', ],
719 label_value => 'Series',
728 link_value => 'branch',
729 label_value => 'Libraries',
734 push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
739 link_value => 'su-to',
740 label_value => 'Topics',
746 # link_value => 'su-na',
747 # label_value => 'People and Organizations',
748 # tags => ['600', '610', '611'],
752 link_value => 'su-geo',
753 label_value => 'Places',
758 link_value => 'su-ut',
759 label_value => 'Titles',
765 label_value => 'Authors',
766 tags => [ '100', '110', '700', ],
771 label_value => 'Series',
772 tags => [ '440', '490', ],
778 link_value => 'branch',
779 label_value => 'Libraries',
784 push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
791 Return a href where a key is associated to a href. You give a query,
792 the name of the key among the fields returned by the query. If you
793 also give as third argument the name of the value, the function
794 returns a href of scalar. The optional 4th argument is an arrayref of
795 items passed to the C<execute()> call. It is designed to bind
796 parameters to any placeholders in your SQL.
805 # generic href of any information on the item, href of href.
806 my $iteminfos_of = get_infos_of($query, 'itemnumber');
807 print $iteminfos_of->{$itemnumber}{barcode};
809 # specific information, href of scalar
810 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
811 print $barcode_of_item->{$itemnumber};
816 my ( $query, $key_name, $value_name, $bind_params ) = @_;
818 my $dbh = C4::Context->dbh;
820 my $sth = $dbh->prepare($query);
821 $sth->execute( @$bind_params );
824 while ( my $row = $sth->fetchrow_hashref ) {
825 if ( defined $value_name ) {
826 $infos_of{ $row->{$key_name} } = $row->{$value_name};
829 $infos_of{ $row->{$key_name} } = $row;
837 =head2 get_notforloan_label_of
839 my $notforloan_label_of = get_notforloan_label_of();
841 Each authorised value of notforloan (information available in items and
842 itemtypes) is link to a single label.
844 Returns a href where keys are authorised values and values are corresponding
847 foreach my $authorised_value (keys %{$notforloan_label_of}) {
849 "authorised_value: %s => %s\n",
851 $notforloan_label_of->{$authorised_value}
857 # FIXME - why not use GetAuthorisedValues ??
859 sub get_notforloan_label_of {
860 my $dbh = C4::Context->dbh;
863 SELECT authorised_value
864 FROM marc_subfield_structure
865 WHERE kohafield = \'items.notforloan\'
868 my $sth = $dbh->prepare($query);
870 my ($statuscode) = $sth->fetchrow_array();
875 FROM authorised_values
878 $sth = $dbh->prepare($query);
879 $sth->execute($statuscode);
880 my %notforloan_label_of;
881 while ( my $row = $sth->fetchrow_hashref ) {
882 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
886 return \%notforloan_label_of;
889 =head2 displayServers
893 my $servers = displayServers();
895 my $servers = displayServers( $position );
897 my $servers = displayServers( $position, $type );
901 displayServers returns a listref of hashrefs, each containing
902 information about available z3950 servers. Each hashref has a format
906 'checked' => 'checked',
907 'encoding' => 'MARC-8'
909 'id' => 'LIBRARY OF CONGRESS',
913 'value' => 'z3950.loc.gov:7090/',
921 my ( $position, $type ) = @_;
922 my $dbh = C4::Context->dbh;
924 my $strsth = 'SELECT * FROM z3950servers';
929 push @bind_params, $position;
930 push @where_clauses, ' position = ? ';
934 push @bind_params, $type;
935 push @where_clauses, ' type = ? ';
938 # reassemble where clause from where clause pieces
939 if (@where_clauses) {
940 $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
943 my $rq = $dbh->prepare($strsth);
944 $rq->execute(@bind_params);
945 my @primaryserverloop;
947 while ( my $data = $rq->fetchrow_hashref ) {
948 push @primaryserverloop,
949 { label => $data->{description},
952 value => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
953 encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
954 checked => "checked",
955 icon => $data->{icon},
956 zed => $data->{type} eq 'zed',
957 opensearch => $data->{type} eq 'opensearch'
960 return \@primaryserverloop;
963 sub displaySecondaryServers {
965 # my $secondary_servers_loop = [
966 # { inner_sup_servers_loop => [
967 # {label => "Google", id=>"GOOG", value=>"google",icon => "google.ico",opensearch => "1"},
968 # {label => "Yahoo", id=>"YAH", value=>"yahoo", icon =>"yahoo.ico", zed => "1"},
969 # {label => "Worldcat", id=>"WCT", value=>"worldcat", icon => "worldcat.gif", zed => "1"},
970 # {label => "Library of Congress", id=>"LOC", name=> "server", value=>"z3950.loc.gov:7090/Voyager", icon =>"loc.ico", zed => "1"},
974 return; #$secondary_servers_loop;
977 =head2 GetAuthValCode
979 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
984 my ($kohafield,$fwcode) = @_;
985 my $dbh = C4::Context->dbh;
986 $fwcode='' unless $fwcode;
987 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
988 $sth->execute($kohafield,$fwcode);
989 my ($authvalcode) = $sth->fetchrow_array;
993 =head2 GetAuthorisedValues
995 $authvalues = GetAuthorisedValues($category);
997 this function get all authorised values from 'authosied_value' table into a reference to array which
998 each value containt an hashref.
1000 Set C<$category> on input args if you want to limits your query to this one. This params is not mandatory.
1004 sub GetAuthorisedValues {
1005 my ($category,$selected) = @_;
1008 my $dbh = C4::Context->dbh;
1009 my $query = "SELECT * FROM authorised_values";
1010 $query .= " WHERE category = '" . $category . "'" if $category;
1012 my $sth = $dbh->prepare($query);
1014 while (my $data=$sth->fetchrow_hashref) {
1015 if ($selected eq $data->{'authorised_value'} ) {
1016 $data->{'selected'} = 1;
1018 $results[$count] = $data;
1021 #my $data = $sth->fetchall_arrayref({});
1022 return \@results; #$data;
1025 =head2 GetAuthorisedValueCategories
1027 $auth_categories = GetAuthorisedValueCategories();
1029 Return an arrayref of all of the available authorised
1034 sub GetAuthorisedValueCategories {
1035 my $dbh = C4::Context->dbh;
1036 my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1039 while (my $category = $sth->fetchrow_array) {
1040 push @results, $category;
1045 =head2 GetKohaAuthorisedValues
1047 Takes $kohafield, $fwcode as parameters.
1048 Returns hashref of Code => description
1050 if no authorised value category is defined for the kohafield.
1054 sub GetKohaAuthorisedValues {
1055 my ($kohafield,$fwcode,$codedvalue) = @_;
1056 $fwcode='' unless $fwcode;
1058 my $dbh = C4::Context->dbh;
1059 my $avcode = GetAuthValCode($kohafield,$fwcode);
1061 my $sth = $dbh->prepare("select authorised_value, lib from authorised_values where category=? ");
1062 $sth->execute($avcode);
1063 while ( my ($val, $lib) = $sth->fetchrow_array ) {
1064 $values{$val}= $lib;
1072 =head2 GetManagedTagSubfields
1076 $res = GetManagedTagSubfields();
1080 Returns a reference to a big hash of hash, with the Marc structure fro the given frameworkcode
1082 NOTE: This function is used only by the (incomplete) bulk editing feature. Since
1083 that feature currently does not deal with items and biblioitems changes
1084 correctly, those tags are specifically excluded from the list prepared
1087 For future reference, if a bulk item editing feature is implemented at some point, it
1088 needs some design thought -- for example, circulation status fields should not
1089 be changed willy-nilly.
1093 sub GetManagedTagSubfields{
1094 my $dbh=C4::Context->dbh;
1095 my $rq=$dbh->prepare(qq|
1097 DISTINCT CONCAT( marc_subfield_structure.tagfield, tagsubfield ) AS tagsubfield,
1098 marc_subfield_structure.liblibrarian as subfielddesc,
1099 marc_tag_structure.liblibrarian as tagdesc
1100 FROM marc_subfield_structure
1101 LEFT JOIN marc_tag_structure
1102 ON marc_tag_structure.tagfield = marc_subfield_structure.tagfield
1103 AND marc_tag_structure.frameworkcode = marc_subfield_structure.frameworkcode
1104 WHERE marc_subfield_structure.tab>=0
1105 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield like 'items.%')
1106 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield = 'biblioitems.itemtype')
1107 AND marc_subfield_structure.kohafield <> 'biblio.biblionumber'
1108 AND marc_subfield_structure.kohafield <> 'biblioitems.biblioitemnumber'
1109 ORDER BY marc_subfield_structure.tagfield, tagsubfield|);
1111 my $data=$rq->fetchall_arrayref({});
1115 =head2 display_marc_indicators
1119 # field is a MARC::Field object
1120 my $display_form = C4::Koha::display_marc_indicators($field);
1124 Generate a display form of the indicators of a variable
1125 MARC field, replacing any blanks with '#'.
1129 sub display_marc_indicators {
1131 my $indicators = '';
1132 if ($field->tag() >= 10) {
1133 $indicators = $field->indicator(1) . $field->indicator(2);
1134 $indicators =~ s/ /#/g;