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
24 use URI::Split qw(uri_split);
26 use vars qw($VERSION @ISA @EXPORT $DEBUG);
35 &subfield_is_koha_internal_p
36 &GetPrinters &GetPrinter
37 &GetItemTypes &getitemtypeinfo
40 &getframeworks &getframeworkinfo
41 &getauthtypes &getauthtype
47 &get_notforloan_label_of
50 &getitemtypeimagelocation
52 &GetAuthorisedValueCategories
53 &GetKohaAuthorisedValues
55 &GetManagedTagSubfields
64 C4::Koha - Perl Module containing convenience functions for Koha scripts
73 Koha.pm provides many functions for Koha scripts.
81 $slash_date = &slashifyDate($dash_date);
83 Takes a string of the form "DD-MM-YYYY" (or anything separated by
84 dashes), converts it to the form "YYYY/MM/DD", and returns the result.
90 # accepts a date of the form xx-xx-xx[xx] and returns it in the
92 my @dateOut = split( '-', shift );
93 return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
99 my $string = DisplayISBN( $isbn );
105 if (length ($isbn)<13){
107 if ( substr( $isbn, 0, 1 ) <= 7 ) {
108 $seg1 = substr( $isbn, 0, 1 );
110 elsif ( substr( $isbn, 0, 2 ) <= 94 ) {
111 $seg1 = substr( $isbn, 0, 2 );
113 elsif ( substr( $isbn, 0, 3 ) <= 995 ) {
114 $seg1 = substr( $isbn, 0, 3 );
116 elsif ( substr( $isbn, 0, 4 ) <= 9989 ) {
117 $seg1 = substr( $isbn, 0, 4 );
120 $seg1 = substr( $isbn, 0, 5 );
122 my $x = substr( $isbn, length($seg1) );
124 if ( substr( $x, 0, 2 ) <= 19 ) {
126 # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
127 $seg2 = substr( $x, 0, 2 );
129 elsif ( substr( $x, 0, 3 ) <= 699 ) {
130 $seg2 = substr( $x, 0, 3 );
132 elsif ( substr( $x, 0, 4 ) <= 8399 ) {
133 $seg2 = substr( $x, 0, 4 );
135 elsif ( substr( $x, 0, 5 ) <= 89999 ) {
136 $seg2 = substr( $x, 0, 5 );
138 elsif ( substr( $x, 0, 6 ) <= 9499999 ) {
139 $seg2 = substr( $x, 0, 6 );
142 $seg2 = substr( $x, 0, 7 );
144 my $seg3 = substr( $x, length($seg2) );
145 $seg3 = substr( $seg3, 0, length($seg3) - 1 );
146 my $seg4 = substr( $x, -1, 1 );
147 return "$seg1-$seg2-$seg3-$seg4";
150 $seg1 = substr( $isbn, 0, 3 );
152 if ( substr( $isbn, 3, 1 ) <= 7 ) {
153 $seg2 = substr( $isbn, 3, 1 );
155 elsif ( substr( $isbn, 3, 2 ) <= 94 ) {
156 $seg2 = substr( $isbn, 3, 2 );
158 elsif ( substr( $isbn, 3, 3 ) <= 995 ) {
159 $seg2 = substr( $isbn, 3, 3 );
161 elsif ( substr( $isbn, 3, 4 ) <= 9989 ) {
162 $seg2 = substr( $isbn, 3, 4 );
165 $seg2 = substr( $isbn, 3, 5 );
167 my $x = substr( $isbn, length($seg2) +3);
169 if ( substr( $x, 0, 2 ) <= 19 ) {
171 # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
172 $seg3 = substr( $x, 0, 2 );
174 elsif ( substr( $x, 0, 3 ) <= 699 ) {
175 $seg3 = substr( $x, 0, 3 );
177 elsif ( substr( $x, 0, 4 ) <= 8399 ) {
178 $seg3 = substr( $x, 0, 4 );
180 elsif ( substr( $x, 0, 5 ) <= 89999 ) {
181 $seg3 = substr( $x, 0, 5 );
183 elsif ( substr( $x, 0, 6 ) <= 9499999 ) {
184 $seg3 = substr( $x, 0, 6 );
187 $seg3 = substr( $x, 0, 7 );
189 my $seg4 = substr( $x, length($seg3) );
190 $seg4 = substr( $seg4, 0, length($seg4) - 1 );
191 my $seg5 = substr( $x, -1, 1 );
192 return "$seg1-$seg2-$seg3-$seg4-$seg5";
196 # FIXME.. this should be moved to a MARC-specific module
197 sub subfield_is_koha_internal_p ($) {
200 # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
201 # But real MARC subfields are always single-character
202 # so it really is safer just to check the length
204 return length $subfield != 1;
209 $itemtypes = &GetItemTypes();
211 Returns information about existing itemtypes.
213 build a HTML select with the following code :
215 =head3 in PERL SCRIPT
217 my $itemtypes = GetItemTypes;
219 foreach my $thisitemtype (sort keys %$itemtypes) {
220 my $selected = 1 if $thisitemtype eq $itemtype;
221 my %row =(value => $thisitemtype,
222 selected => $selected,
223 description => $itemtypes->{$thisitemtype}->{'description'},
225 push @itemtypesloop, \%row;
227 $template->param(itemtypeloop => \@itemtypesloop);
231 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
232 <select name="itemtype">
233 <option value="">Default</option>
234 <!-- TMPL_LOOP name="itemtypeloop" -->
235 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
238 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
239 <input type="submit" value="OK" class="button">
246 # returns a reference to a hash of references to itemtypes...
248 my $dbh = C4::Context->dbh;
253 my $sth = $dbh->prepare($query);
255 while ( my $IT = $sth->fetchrow_hashref ) {
256 $itemtypes{ $IT->{'itemtype'} } = $IT;
258 return ( \%itemtypes );
261 sub get_itemtypeinfos_of {
264 my $placeholders = join( ', ', map { '?' } @itemtypes );
265 my $query = <<"END_SQL";
271 WHERE itemtype IN ( $placeholders )
274 return get_infos_of( $query, 'itemtype', undef, \@itemtypes );
277 # this is temporary until we separate collection codes and item types
281 my $dbh = C4::Context->dbh;
284 "SELECT * FROM authorised_values ORDER BY authorised_value");
286 while ( my $data = $sth->fetchrow_hashref ) {
287 if ( $data->{category} eq "CCODE" ) {
289 $results[$count] = $data;
295 return ( $count, @results );
300 $authtypes = &getauthtypes();
302 Returns information about existing authtypes.
304 build a HTML select with the following code :
306 =head3 in PERL SCRIPT
308 my $authtypes = getauthtypes;
310 foreach my $thisauthtype (keys %$authtypes) {
311 my $selected = 1 if $thisauthtype eq $authtype;
312 my %row =(value => $thisauthtype,
313 selected => $selected,
314 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
316 push @authtypesloop, \%row;
318 $template->param(itemtypeloop => \@itemtypesloop);
322 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
323 <select name="authtype">
324 <!-- TMPL_LOOP name="authtypeloop" -->
325 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
328 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
329 <input type="submit" value="OK" class="button">
337 # returns a reference to a hash of references to authtypes...
339 my $dbh = C4::Context->dbh;
340 my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
342 while ( my $IT = $sth->fetchrow_hashref ) {
343 $authtypes{ $IT->{'authtypecode'} } = $IT;
345 return ( \%authtypes );
349 my ($authtypecode) = @_;
351 # returns a reference to a hash of references to authtypes...
353 my $dbh = C4::Context->dbh;
354 my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
355 $sth->execute($authtypecode);
356 my $res = $sth->fetchrow_hashref;
362 $frameworks = &getframework();
364 Returns information about existing frameworks
366 build a HTML select with the following code :
368 =head3 in PERL SCRIPT
370 my $frameworks = frameworks();
372 foreach my $thisframework (keys %$frameworks) {
373 my $selected = 1 if $thisframework eq $frameworkcode;
374 my %row =(value => $thisframework,
375 selected => $selected,
376 description => $frameworks->{$thisframework}->{'frameworktext'},
378 push @frameworksloop, \%row;
380 $template->param(frameworkloop => \@frameworksloop);
384 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
385 <select name="frameworkcode">
386 <option value="">Default</option>
387 <!-- TMPL_LOOP name="frameworkloop" -->
388 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
391 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
392 <input type="submit" value="OK" class="button">
400 # returns a reference to a hash of references to branches...
402 my $dbh = C4::Context->dbh;
403 my $sth = $dbh->prepare("select * from biblio_framework");
405 while ( my $IT = $sth->fetchrow_hashref ) {
406 $itemtypes{ $IT->{'frameworkcode'} } = $IT;
408 return ( \%itemtypes );
411 =head2 getframeworkinfo
413 $frameworkinfo = &getframeworkinfo($frameworkcode);
415 Returns information about an frameworkcode.
419 sub getframeworkinfo {
420 my ($frameworkcode) = @_;
421 my $dbh = C4::Context->dbh;
423 $dbh->prepare("select * from biblio_framework where frameworkcode=?");
424 $sth->execute($frameworkcode);
425 my $res = $sth->fetchrow_hashref;
429 =head2 getitemtypeinfo
431 $itemtype = &getitemtype($itemtype);
433 Returns information about an itemtype.
437 sub getitemtypeinfo {
439 my $dbh = C4::Context->dbh;
440 my $sth = $dbh->prepare("select * from itemtypes where itemtype=?");
441 $sth->execute($itemtype);
442 my $res = $sth->fetchrow_hashref;
444 $res->{imageurl} = getitemtypeimagelocation( 'intranet', $res->{imageurl} );
449 =head2 getitemtypeimagedir
455 my $directory = getitemtypeimagedir( 'opac' );
457 pass in 'opac' or 'intranet'. Defaults to 'opac'.
459 returns the full path to the appropriate directory containing images.
465 sub getitemtypeimagedir {
466 my $src = shift || 'opac';
467 if ($src eq 'intranet') {
468 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
470 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('template') . '/itemtypeimg';
474 sub getitemtypeimagesrc {
475 my $src = shift || 'opac';
476 if ($src eq 'intranet') {
477 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
479 return '/opac-tmpl' . '/' . C4::Context->preference('template') . '/itemtypeimg';
483 sub getitemtypeimagelocation($$) {
484 my ( $src, $image ) = @_;
486 return '' if ( !$image );
488 my $scheme = ( uri_split( $image ) )[0];
490 return $image if ( $scheme );
492 return getitemtypeimagesrc( $src ) . '/' . $image;
495 =head3 _getImagesFromDirectory
497 Find all of the image files in a directory in the filesystem
502 returns: a list of images in that directory.
504 Notes: this does not traverse into subdirectories. See
505 _getSubdirectoryNames for help with that.
506 Images are assumed to be files with .gif or .png file extensions.
507 The image names returned do not have the directory name on them.
511 sub _getImagesFromDirectory {
512 my $directoryname = shift;
513 return unless defined $directoryname;
514 return unless -d $directoryname;
516 if ( opendir ( my $dh, $directoryname ) ) {
517 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
521 warn "unable to opendir $directoryname: $!";
526 =head3 _getSubdirectoryNames
528 Find all of the directories in a directory in the filesystem
533 returns: a list of subdirectories in that directory.
535 Notes: this does not traverse into subdirectories. Only the first
536 level of subdirectories are returned.
537 The directory names returned don't have the parent directory name
542 sub _getSubdirectoryNames {
543 my $directoryname = shift;
544 return unless defined $directoryname;
545 return unless -d $directoryname;
547 if ( opendir ( my $dh, $directoryname ) ) {
548 my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
552 warn "unable to opendir $directoryname: $!";
559 returns: a listref of hashrefs. Each hash represents another collection of images.
560 { imagesetname => 'npl', # the name of the image set (npl is the original one)
561 images => listref of image hashrefs
564 each image is represented by a hashref like this:
565 { KohaImage => 'npl/image.gif',
566 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
567 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
568 checked => 0 or 1: was this the image passed to this method?
569 Note: I'd like to remove this somehow.
576 my $checked = $params{'checked'} || '';
578 my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
579 url => getitemtypeimagesrc('intranet'),
581 opac => { filesystem => getitemtypeimagedir('opac'),
582 url => getitemtypeimagesrc('opac'),
586 my @imagesets = (); # list of hasrefs of image set data to pass to template
587 my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
589 foreach my $imagesubdir ( @subdirectories ) {
590 my @imagelist = (); # hashrefs of image info
591 my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
592 foreach my $thisimage ( @imagenames ) {
594 { KohaImage => "$imagesubdir/$thisimage",
595 StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
596 OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
597 checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
601 push @imagesets, { imagesetname => $imagesubdir,
602 images => \@imagelist };
610 $printers = &GetPrinters();
611 @queues = keys %$printers;
613 Returns information about existing printer queues.
615 C<$printers> is a reference-to-hash whose keys are the print queues
616 defined in the printers table of the Koha database. The values are
617 references-to-hash, whose keys are the fields in the printers table.
623 my $dbh = C4::Context->dbh;
624 my $sth = $dbh->prepare("select * from printers");
626 while ( my $printer = $sth->fetchrow_hashref ) {
627 $printers{ $printer->{'printqueue'} } = $printer;
629 return ( \%printers );
634 $printer = GetPrinter( $query, $printers );
638 sub GetPrinter ($$) {
639 my ( $query, $printers ) = @_; # get printer for this query from printers
640 my $printer = $query->param('printer');
641 my %cookie = $query->cookie('userenv');
642 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
643 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
649 Returns the number of pages to display in a pagination bar, given the number
650 of items and the number of items per page.
655 my ( $nb_items, $nb_items_per_page ) = @_;
657 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
662 (@themes) = &getallthemes('opac');
663 (@themes) = &getallthemes('intranet');
665 Returns an array of all available themes.
673 if ( $type eq 'intranet' ) {
674 $htdocs = C4::Context->config('intrahtdocs');
677 $htdocs = C4::Context->config('opachtdocs');
679 opendir D, "$htdocs";
680 my @dirlist = readdir D;
681 foreach my $directory (@dirlist) {
682 -d "$htdocs/$directory/en" and push @themes, $directory;
689 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
692 link_value => 'su-to',
693 label_value => 'Topics',
695 [ '600', '601', '602', '603', '604', '605', '606', '610' ],
699 link_value => 'su-geo',
700 label_value => 'Places',
705 link_value => 'su-ut',
706 label_value => 'Titles',
707 tags => [ '500', '501', '502', '503', '504', ],
712 label_value => 'Authors',
713 tags => [ '700', '701', '702', ],
718 label_value => 'Series',
727 link_value => 'branch',
728 label_value => 'Libraries',
733 push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
738 link_value => 'su-to',
739 label_value => 'Topics',
745 # link_value => 'su-na',
746 # label_value => 'People and Organizations',
747 # tags => ['600', '610', '611'],
751 link_value => 'su-geo',
752 label_value => 'Places',
757 link_value => 'su-ut',
758 label_value => 'Titles',
764 label_value => 'Authors',
765 tags => [ '100', '110', '700', ],
770 label_value => 'Series',
771 tags => [ '440', '490', ],
777 link_value => 'branch',
778 label_value => 'Libraries',
783 push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
790 Return a href where a key is associated to a href. You give a query,
791 the name of the key among the fields returned by the query. If you
792 also give as third argument the name of the value, the function
793 returns a href of scalar. The optional 4th argument is an arrayref of
794 items passed to the C<execute()> call. It is designed to bind
795 parameters to any placeholders in your SQL.
804 # generic href of any information on the item, href of href.
805 my $iteminfos_of = get_infos_of($query, 'itemnumber');
806 print $iteminfos_of->{$itemnumber}{barcode};
808 # specific information, href of scalar
809 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
810 print $barcode_of_item->{$itemnumber};
815 my ( $query, $key_name, $value_name, $bind_params ) = @_;
817 my $dbh = C4::Context->dbh;
819 my $sth = $dbh->prepare($query);
820 $sth->execute( @$bind_params );
823 while ( my $row = $sth->fetchrow_hashref ) {
824 if ( defined $value_name ) {
825 $infos_of{ $row->{$key_name} } = $row->{$value_name};
828 $infos_of{ $row->{$key_name} } = $row;
836 =head2 get_notforloan_label_of
838 my $notforloan_label_of = get_notforloan_label_of();
840 Each authorised value of notforloan (information available in items and
841 itemtypes) is link to a single label.
843 Returns a href where keys are authorised values and values are corresponding
846 foreach my $authorised_value (keys %{$notforloan_label_of}) {
848 "authorised_value: %s => %s\n",
850 $notforloan_label_of->{$authorised_value}
856 # FIXME - why not use GetAuthorisedValues ??
858 sub get_notforloan_label_of {
859 my $dbh = C4::Context->dbh;
862 SELECT authorised_value
863 FROM marc_subfield_structure
864 WHERE kohafield = \'items.notforloan\'
867 my $sth = $dbh->prepare($query);
869 my ($statuscode) = $sth->fetchrow_array();
874 FROM authorised_values
877 $sth = $dbh->prepare($query);
878 $sth->execute($statuscode);
879 my %notforloan_label_of;
880 while ( my $row = $sth->fetchrow_hashref ) {
881 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
885 return \%notforloan_label_of;
888 =head2 displayServers
892 my $servers = displayServers();
894 my $servers = displayServers( $position );
896 my $servers = displayServers( $position, $type );
900 displayServers returns a listref of hashrefs, each containing
901 information about available z3950 servers. Each hashref has a format
905 'checked' => 'checked',
906 'encoding' => 'MARC-8'
908 'id' => 'LIBRARY OF CONGRESS',
912 'value' => 'z3950.loc.gov:7090/',
920 my ( $position, $type ) = @_;
921 my $dbh = C4::Context->dbh;
923 my $strsth = 'SELECT * FROM z3950servers';
928 push @bind_params, $position;
929 push @where_clauses, ' position = ? ';
933 push @bind_params, $type;
934 push @where_clauses, ' type = ? ';
937 # reassemble where clause from where clause pieces
938 if (@where_clauses) {
939 $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
942 my $rq = $dbh->prepare($strsth);
943 $rq->execute(@bind_params);
944 my @primaryserverloop;
946 while ( my $data = $rq->fetchrow_hashref ) {
947 push @primaryserverloop,
948 { label => $data->{description},
951 value => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
952 encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
953 checked => "checked",
954 icon => $data->{icon},
955 zed => $data->{type} eq 'zed',
956 opensearch => $data->{type} eq 'opensearch'
959 return \@primaryserverloop;
962 sub displaySecondaryServers {
964 # my $secondary_servers_loop = [
965 # { inner_sup_servers_loop => [
966 # {label => "Google", id=>"GOOG", value=>"google",icon => "google.ico",opensearch => "1"},
967 # {label => "Yahoo", id=>"YAH", value=>"yahoo", icon =>"yahoo.ico", zed => "1"},
968 # {label => "Worldcat", id=>"WCT", value=>"worldcat", icon => "worldcat.gif", zed => "1"},
969 # {label => "Library of Congress", id=>"LOC", name=> "server", value=>"z3950.loc.gov:7090/Voyager", icon =>"loc.ico", zed => "1"},
973 return; #$secondary_servers_loop;
976 =head2 GetAuthValCode
978 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
983 my ($kohafield,$fwcode) = @_;
984 my $dbh = C4::Context->dbh;
985 $fwcode='' unless $fwcode;
986 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
987 $sth->execute($kohafield,$fwcode);
988 my ($authvalcode) = $sth->fetchrow_array;
992 =head2 GetAuthorisedValues
994 $authvalues = GetAuthorisedValues([$category], [$selected]);
996 This function returns all authorised values from the'authosied_value' table in a reference to array of hashrefs.
998 C<$category> returns authorised values for just one category (optional).
1002 sub GetAuthorisedValues {
1003 my ($category,$selected) = @_;
1005 my $dbh = C4::Context->dbh;
1006 my $query = "SELECT * FROM authorised_values";
1007 $query .= " WHERE category = '" . $category . "'" if $category;
1009 my $sth = $dbh->prepare($query);
1011 while (my $data=$sth->fetchrow_hashref) {
1012 if ($selected eq $data->{'authorised_value'} ) {
1013 $data->{'selected'} = 1;
1015 push @results, $data;
1017 #my $data = $sth->fetchall_arrayref({});
1018 return \@results; #$data;
1021 =head2 GetAuthorisedValueCategories
1023 $auth_categories = GetAuthorisedValueCategories();
1025 Return an arrayref of all of the available authorised
1030 sub GetAuthorisedValueCategories {
1031 my $dbh = C4::Context->dbh;
1032 my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1035 while (my $category = $sth->fetchrow_array) {
1036 push @results, $category;
1041 =head2 GetKohaAuthorisedValues
1043 Takes $kohafield, $fwcode as parameters.
1044 Returns hashref of Code => description
1046 if no authorised value category is defined for the kohafield.
1050 sub GetKohaAuthorisedValues {
1051 my ($kohafield,$fwcode,$codedvalue) = @_;
1052 $fwcode='' unless $fwcode;
1054 my $dbh = C4::Context->dbh;
1055 my $avcode = GetAuthValCode($kohafield,$fwcode);
1057 my $sth = $dbh->prepare("select authorised_value, lib from authorised_values where category=? ");
1058 $sth->execute($avcode);
1059 while ( my ($val, $lib) = $sth->fetchrow_array ) {
1060 $values{$val}= $lib;
1068 =head2 GetManagedTagSubfields
1072 $res = GetManagedTagSubfields();
1076 Returns a reference to a big hash of hash, with the Marc structure fro the given frameworkcode
1078 NOTE: This function is used only by the (incomplete) bulk editing feature. Since
1079 that feature currently does not deal with items and biblioitems changes
1080 correctly, those tags are specifically excluded from the list prepared
1083 For future reference, if a bulk item editing feature is implemented at some point, it
1084 needs some design thought -- for example, circulation status fields should not
1085 be changed willy-nilly.
1089 sub GetManagedTagSubfields{
1090 my $dbh=C4::Context->dbh;
1091 my $rq=$dbh->prepare(qq|
1093 DISTINCT CONCAT( marc_subfield_structure.tagfield, tagsubfield ) AS tagsubfield,
1094 marc_subfield_structure.liblibrarian as subfielddesc,
1095 marc_tag_structure.liblibrarian as tagdesc
1096 FROM marc_subfield_structure
1097 LEFT JOIN marc_tag_structure
1098 ON marc_tag_structure.tagfield = marc_subfield_structure.tagfield
1099 AND marc_tag_structure.frameworkcode = marc_subfield_structure.frameworkcode
1100 WHERE marc_subfield_structure.tab>=0
1101 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield like 'items.%')
1102 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield = 'biblioitems.itemtype')
1103 AND marc_subfield_structure.kohafield <> 'biblio.biblionumber'
1104 AND marc_subfield_structure.kohafield <> 'biblioitems.biblioitemnumber'
1105 ORDER BY marc_subfield_structure.tagfield, tagsubfield|);
1107 my $data=$rq->fetchall_arrayref({});
1111 =head2 display_marc_indicators
1115 # field is a MARC::Field object
1116 my $display_form = C4::Koha::display_marc_indicators($field);
1120 Generate a display form of the indicators of a variable
1121 MARC field, replacing any blanks with '#'.
1125 sub display_marc_indicators {
1127 my $indicators = '';
1128 if ($field->tag() >= 10) {
1129 $indicators = $field->indicator(1) . $field->indicator(2);
1130 $indicators =~ s/ /#/g;