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 branches...
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 {
467 $src = 'opac' unless defined $src;
469 if ($src eq 'intranet') {
470 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
473 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('template') . '/itemtypeimg';
477 sub getitemtypeimagesrc {
479 if ($src eq 'intranet') {
480 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
483 return '/opac-tmpl' . '/' . C4::Context->preference('template') . '/itemtypeimg';
487 sub getitemtypeimagelocation($$) {
488 my ( $src, $image ) = @_;
490 return if ( !$image );
492 my $scheme = ( uri_split( $image ) )[0];
494 return $image if ( $scheme );
496 return getitemtypeimagesrc( $src ) . '/' . $image;
499 =head3 _getImagesFromDirectory
501 Find all of the image files in a directory in the filesystem
506 returns: a list of images in that directory.
508 Notes: this does not traverse into subdirectories. See
509 _getSubdirectoryNames for help with that.
510 Images are assumed to be files with .gif or .png file extensions.
511 The image names returned do not have the directory name on them.
515 sub _getImagesFromDirectory {
516 my $directoryname = shift;
517 return unless defined $directoryname;
518 return unless -d $directoryname;
520 if ( opendir ( my $dh, $directoryname ) ) {
521 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
525 warn "unable to opendir $directoryname: $!";
530 =head3 _getSubdirectoryNames
532 Find all of the directories in a directory in the filesystem
537 returns: a list of subdirectories in that directory.
539 Notes: this does not traverse into subdirectories. Only the first
540 level of subdirectories are returned.
541 The directory names returned don't have the parent directory name
546 sub _getSubdirectoryNames {
547 my $directoryname = shift;
548 return unless defined $directoryname;
549 return unless -d $directoryname;
551 if ( opendir ( my $dh, $directoryname ) ) {
552 my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
556 warn "unable to opendir $directoryname: $!";
563 returns: a listref of hashrefs. Each hash represents another collection of images.
564 { imagesetname => 'npl', # the name of the image set (npl is the original one)
565 images => listref of image hashrefs
568 each image is represented by a hashref like this:
569 { KohaImage => 'npl/image.gif',
570 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
571 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
572 checked => 0 or 1: was this the image passed to this method?
573 Note: I'd like to remove this somehow.
580 my $checked = $params{'checked'} || '';
582 my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
583 url => getitemtypeimagesrc('intranet'),
585 opac => { filesystem => getitemtypeimagedir('opac'),
586 url => getitemtypeimagesrc('opac'),
590 my @imagesets = (); # list of hasrefs of image set data to pass to template
591 my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
593 foreach my $imagesubdir ( @subdirectories ) {
594 my @imagelist = (); # hashrefs of image info
595 my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
596 foreach my $thisimage ( @imagenames ) {
598 { KohaImage => "$imagesubdir/$thisimage",
599 StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
600 OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
601 checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
605 push @imagesets, { imagesetname => $imagesubdir,
606 images => \@imagelist };
614 $printers = &GetPrinters();
615 @queues = keys %$printers;
617 Returns information about existing printer queues.
619 C<$printers> is a reference-to-hash whose keys are the print queues
620 defined in the printers table of the Koha database. The values are
621 references-to-hash, whose keys are the fields in the printers table.
627 my $dbh = C4::Context->dbh;
628 my $sth = $dbh->prepare("select * from printers");
630 while ( my $printer = $sth->fetchrow_hashref ) {
631 $printers{ $printer->{'printqueue'} } = $printer;
633 return ( \%printers );
638 $printer = GetPrinter( $query, $printers );
642 sub GetPrinter ($$) {
643 my ( $query, $printers ) = @_; # get printer for this query from printers
644 my $printer = $query->param('printer');
645 my %cookie = $query->cookie('userenv');
646 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
647 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
653 Returns the number of pages to display in a pagination bar, given the number
654 of items and the number of items per page.
659 my ( $nb_items, $nb_items_per_page ) = @_;
661 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
666 (@themes) = &getallthemes('opac');
667 (@themes) = &getallthemes('intranet');
669 Returns an array of all available themes.
677 if ( $type eq 'intranet' ) {
678 $htdocs = C4::Context->config('intrahtdocs');
681 $htdocs = C4::Context->config('opachtdocs');
683 opendir D, "$htdocs";
684 my @dirlist = readdir D;
685 foreach my $directory (@dirlist) {
686 -d "$htdocs/$directory/en" and push @themes, $directory;
693 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
696 link_value => 'su-to',
697 label_value => 'Topics',
699 [ '600', '601', '602', '603', '604', '605', '606', '610' ],
703 link_value => 'su-geo',
704 label_value => 'Places',
709 link_value => 'su-ut',
710 label_value => 'Titles',
711 tags => [ '500', '501', '502', '503', '504', ],
716 label_value => 'Authors',
717 tags => [ '700', '701', '702', ],
722 label_value => 'Series',
731 link_value => 'branch',
732 label_value => 'Libraries',
737 push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
742 link_value => 'su-to',
743 label_value => 'Topics',
749 # link_value => 'su-na',
750 # label_value => 'People and Organizations',
751 # tags => ['600', '610', '611'],
755 link_value => 'su-geo',
756 label_value => 'Places',
761 link_value => 'su-ut',
762 label_value => 'Titles',
768 label_value => 'Authors',
769 tags => [ '100', '110', '700', ],
774 label_value => 'Series',
775 tags => [ '440', '490', ],
781 link_value => 'branch',
782 label_value => 'Libraries',
787 push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
794 Return a href where a key is associated to a href. You give a query,
795 the name of the key among the fields returned by the query. If you
796 also give as third argument the name of the value, the function
797 returns a href of scalar. The optional 4th argument is an arrayref of
798 items passed to the C<execute()> call. It is designed to bind
799 parameters to any placeholders in your SQL.
808 # generic href of any information on the item, href of href.
809 my $iteminfos_of = get_infos_of($query, 'itemnumber');
810 print $iteminfos_of->{$itemnumber}{barcode};
812 # specific information, href of scalar
813 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
814 print $barcode_of_item->{$itemnumber};
819 my ( $query, $key_name, $value_name, $bind_params ) = @_;
821 my $dbh = C4::Context->dbh;
823 my $sth = $dbh->prepare($query);
824 $sth->execute( @$bind_params );
827 while ( my $row = $sth->fetchrow_hashref ) {
828 if ( defined $value_name ) {
829 $infos_of{ $row->{$key_name} } = $row->{$value_name};
832 $infos_of{ $row->{$key_name} } = $row;
840 =head2 get_notforloan_label_of
842 my $notforloan_label_of = get_notforloan_label_of();
844 Each authorised value of notforloan (information available in items and
845 itemtypes) is link to a single label.
847 Returns a href where keys are authorised values and values are corresponding
850 foreach my $authorised_value (keys %{$notforloan_label_of}) {
852 "authorised_value: %s => %s\n",
854 $notforloan_label_of->{$authorised_value}
860 # FIXME - why not use GetAuthorisedValues ??
862 sub get_notforloan_label_of {
863 my $dbh = C4::Context->dbh;
866 SELECT authorised_value
867 FROM marc_subfield_structure
868 WHERE kohafield = \'items.notforloan\'
871 my $sth = $dbh->prepare($query);
873 my ($statuscode) = $sth->fetchrow_array();
878 FROM authorised_values
881 $sth = $dbh->prepare($query);
882 $sth->execute($statuscode);
883 my %notforloan_label_of;
884 while ( my $row = $sth->fetchrow_hashref ) {
885 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
889 return \%notforloan_label_of;
892 =head2 displayServers
896 my $servers = displayServers();
898 my $servers = displayServers( $position );
900 my $servers = displayServers( $position, $type );
904 displayServers returns a listref of hashrefs, each containing
905 information about available z3950 servers. Each hashref has a format
909 'checked' => 'checked',
910 'encoding' => 'MARC-8'
912 'id' => 'LIBRARY OF CONGRESS',
916 'value' => 'z3950.loc.gov:7090/',
924 my ( $position, $type ) = @_;
925 my $dbh = C4::Context->dbh;
927 my $strsth = 'SELECT * FROM z3950servers';
932 push @bind_params, $position;
933 push @where_clauses, ' position = ? ';
937 push @bind_params, $type;
938 push @where_clauses, ' type = ? ';
941 # reassemble where clause from where clause pieces
942 if (@where_clauses) {
943 $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
946 my $rq = $dbh->prepare($strsth);
947 $rq->execute(@bind_params);
948 my @primaryserverloop;
950 while ( my $data = $rq->fetchrow_hashref ) {
951 push @primaryserverloop,
952 { label => $data->{description},
955 value => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
956 encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
957 checked => "checked",
958 icon => $data->{icon},
959 zed => $data->{type} eq 'zed',
960 opensearch => $data->{type} eq 'opensearch'
963 return \@primaryserverloop;
966 sub displaySecondaryServers {
968 # my $secondary_servers_loop = [
969 # { inner_sup_servers_loop => [
970 # {label => "Google", id=>"GOOG", value=>"google",icon => "google.ico",opensearch => "1"},
971 # {label => "Yahoo", id=>"YAH", value=>"yahoo", icon =>"yahoo.ico", zed => "1"},
972 # {label => "Worldcat", id=>"WCT", value=>"worldcat", icon => "worldcat.gif", zed => "1"},
973 # {label => "Library of Congress", id=>"LOC", name=> "server", value=>"z3950.loc.gov:7090/Voyager", icon =>"loc.ico", zed => "1"},
977 return; #$secondary_servers_loop;
980 =head2 GetAuthValCode
982 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
987 my ($kohafield,$fwcode) = @_;
988 my $dbh = C4::Context->dbh;
989 $fwcode='' unless $fwcode;
990 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
991 $sth->execute($kohafield,$fwcode);
992 my ($authvalcode) = $sth->fetchrow_array;
996 =head2 GetAuthorisedValues
998 $authvalues = GetAuthorisedValues($category);
1000 this function get all authorised values from 'authosied_value' table into a reference to array which
1001 each value containt an hashref.
1003 Set C<$category> on input args if you want to limits your query to this one. This params is not mandatory.
1007 sub GetAuthorisedValues {
1008 my ($category,$selected) = @_;
1011 my $dbh = C4::Context->dbh;
1012 my $query = "SELECT * FROM authorised_values";
1013 $query .= " WHERE category = '" . $category . "'" if $category;
1015 my $sth = $dbh->prepare($query);
1017 while (my $data=$sth->fetchrow_hashref) {
1018 if ($selected eq $data->{'authorised_value'} ) {
1019 $data->{'selected'} = 1;
1021 $results[$count] = $data;
1024 #my $data = $sth->fetchall_arrayref({});
1025 return \@results; #$data;
1028 =head2 GetAuthorisedValueCategories
1030 $auth_categories = GetAuthorisedValueCategories();
1032 Return an arrayref of all of the available authorised
1037 sub GetAuthorisedValueCategories {
1038 my $dbh = C4::Context->dbh;
1039 my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1042 while (my $category = $sth->fetchrow_array) {
1043 push @results, $category;
1048 =head2 GetKohaAuthorisedValues
1050 Takes $kohafield, $fwcode as parameters.
1051 Returns hashref of Code => description
1053 if no authorised value category is defined for the kohafield.
1057 sub GetKohaAuthorisedValues {
1058 my ($kohafield,$fwcode,$codedvalue) = @_;
1059 $fwcode='' unless $fwcode;
1061 my $dbh = C4::Context->dbh;
1062 my $avcode = GetAuthValCode($kohafield,$fwcode);
1064 my $sth = $dbh->prepare("select authorised_value, lib from authorised_values where category=? ");
1065 $sth->execute($avcode);
1066 while ( my ($val, $lib) = $sth->fetchrow_array ) {
1067 $values{$val}= $lib;
1075 =head2 GetManagedTagSubfields
1079 $res = GetManagedTagSubfields();
1083 Returns a reference to a big hash of hash, with the Marc structure fro the given frameworkcode
1085 NOTE: This function is used only by the (incomplete) bulk editing feature. Since
1086 that feature currently does not deal with items and biblioitems changes
1087 correctly, those tags are specifically excluded from the list prepared
1090 For future reference, if a bulk item editing feature is implemented at some point, it
1091 needs some design thought -- for example, circulation status fields should not
1092 be changed willy-nilly.
1096 sub GetManagedTagSubfields{
1097 my $dbh=C4::Context->dbh;
1098 my $rq=$dbh->prepare(qq|
1100 DISTINCT CONCAT( marc_subfield_structure.tagfield, tagsubfield ) AS tagsubfield,
1101 marc_subfield_structure.liblibrarian as subfielddesc,
1102 marc_tag_structure.liblibrarian as tagdesc
1103 FROM marc_subfield_structure
1104 LEFT JOIN marc_tag_structure
1105 ON marc_tag_structure.tagfield = marc_subfield_structure.tagfield
1106 AND marc_tag_structure.frameworkcode = marc_subfield_structure.frameworkcode
1107 WHERE marc_subfield_structure.tab>=0
1108 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield like 'items.%')
1109 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield = 'biblioitems.itemtype')
1110 AND marc_subfield_structure.kohafield <> 'biblio.biblionumber'
1111 AND marc_subfield_structure.kohafield <> 'biblioitems.biblioitemnumber'
1112 ORDER BY marc_subfield_structure.tagfield, tagsubfield|);
1114 my $data=$rq->fetchall_arrayref({});
1118 =head2 display_marc_indicators
1122 # field is a MARC::Field object
1123 my $display_form = C4::Koha::display_marc_indicators($field);
1127 Generate a display form of the indicators of a variable
1128 MARC field, replacing any blanks with '#'.
1132 sub display_marc_indicators {
1134 my $indicators = '';
1135 if ($field->tag() >= 10) {
1136 $indicators = $field->indicator(1) . $field->indicator(2);
1137 $indicators =~ s/ /#/g;