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.
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} = getitemtypeimagesrcfromurl( $res->{imageurl} );
449 sub getitemtypeimagesrcfromurl {
452 if ( defined $imageurl and $imageurl !~ m/^http/ ) {
453 $imageurl = getitemtypeimagesrc() . '/' . $imageurl;
459 =head2 getitemtypeimagedir
465 my $directory = getitemtypeimagedir( 'opac' );
467 pass in 'opac' or 'intranet'. Defaults to 'opac'.
469 returns the full path to the appropriate directory containing images.
475 sub getitemtypeimagedir {
477 $src = 'opac' unless defined $src;
479 if ($src eq 'intranet') {
480 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
483 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('template') . '/itemtypeimg';
487 sub getitemtypeimagesrc {
489 if ($src eq 'intranet') {
490 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
493 return '/opac-tmpl' . '/' . C4::Context->preference('template') . '/itemtypeimg';
497 =head3 _getImagesFromDirectory
499 Find all of the image files in a directory in the filesystem
504 returns: a list of images in that directory.
506 Notes: this does not traverse into subdirectories. See
507 _getSubdirectoryNames for help with that.
508 Images are assumed to be files with .gif or .png file extensions.
509 The image names returned do not have the directory name on them.
513 sub _getImagesFromDirectory {
514 my $directoryname = shift;
515 return unless defined $directoryname;
516 return unless -d $directoryname;
518 if ( opendir ( my $dh, $directoryname ) ) {
519 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
523 warn "unable to opendir $directoryname: $!";
528 =head3 _getSubdirectoryNames
530 Find all of the directories in a directory in the filesystem
535 returns: a list of subdirectories in that directory.
537 Notes: this does not traverse into subdirectories. Only the first
538 level of subdirectories are returned.
539 The directory names returned don't have the parent directory name
544 sub _getSubdirectoryNames {
545 my $directoryname = shift;
546 return unless defined $directoryname;
547 return unless -d $directoryname;
549 if ( opendir ( my $dh, $directoryname ) ) {
550 my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
554 warn "unable to opendir $directoryname: $!";
561 returns: a listref of hashrefs. Each hash represents another collection of images.
562 { imagesetname => 'npl', # the name of the image set (npl is the original one)
563 images => listref of image hashrefs
566 each image is represented by a hashref like this:
567 { KohaImage => 'npl/image.gif',
568 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
569 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
570 checked => 0 or 1: was this the image passed to this method?
571 Note: I'd like to remove this somehow.
578 my $checked = $params{'checked'} || '';
580 my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
581 url => getitemtypeimagesrc('intranet'),
583 opac => { filesystem => getitemtypeimagedir('opac'),
584 url => getitemtypeimagesrc('opac'),
588 my @imagesets = (); # list of hasrefs of image set data to pass to template
589 my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
591 foreach my $imagesubdir ( @subdirectories ) {
592 my @imagelist = (); # hashrefs of image info
593 my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
594 foreach my $thisimage ( @imagenames ) {
596 { KohaImage => "$imagesubdir/$thisimage",
597 StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
598 OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
599 checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
603 push @imagesets, { imagesetname => $imagesubdir,
604 images => \@imagelist };
612 $printers = &GetPrinters();
613 @queues = keys %$printers;
615 Returns information about existing printer queues.
617 C<$printers> is a reference-to-hash whose keys are the print queues
618 defined in the printers table of the Koha database. The values are
619 references-to-hash, whose keys are the fields in the printers table.
625 my $dbh = C4::Context->dbh;
626 my $sth = $dbh->prepare("select * from printers");
628 while ( my $printer = $sth->fetchrow_hashref ) {
629 $printers{ $printer->{'printqueue'} } = $printer;
631 return ( \%printers );
636 $printer = GetPrinter( $query, $printers );
640 sub GetPrinter ($$) {
641 my ( $query, $printers ) = @_; # get printer for this query from printers
642 my $printer = $query->param('printer');
643 my %cookie = $query->cookie('userenv');
644 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
645 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
651 Returns the number of pages to display in a pagination bar, given the number
652 of items and the number of items per page.
657 my ( $nb_items, $nb_items_per_page ) = @_;
659 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
664 (@themes) = &getallthemes('opac');
665 (@themes) = &getallthemes('intranet');
667 Returns an array of all available themes.
675 if ( $type eq 'intranet' ) {
676 $htdocs = C4::Context->config('intrahtdocs');
679 $htdocs = C4::Context->config('opachtdocs');
681 opendir D, "$htdocs";
682 my @dirlist = readdir D;
683 foreach my $directory (@dirlist) {
684 -d "$htdocs/$directory/en" and push @themes, $directory;
691 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
694 link_value => 'su-to',
695 label_value => 'Topics',
697 [ '600', '601', '602', '603', '604', '605', '606', '610' ],
701 link_value => 'su-geo',
702 label_value => 'Places',
707 link_value => 'su-ut',
708 label_value => 'Titles',
709 tags => [ '500', '501', '502', '503', '504', ],
714 label_value => 'Authors',
715 tags => [ '700', '701', '702', ],
720 label_value => 'Series',
729 link_value => 'branch',
730 label_value => 'Libraries',
735 push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
740 link_value => 'su-to',
741 label_value => 'Topics',
747 # link_value => 'su-na',
748 # label_value => 'People and Organizations',
749 # tags => ['600', '610', '611'],
753 link_value => 'su-geo',
754 label_value => 'Places',
759 link_value => 'su-ut',
760 label_value => 'Titles',
766 label_value => 'Authors',
767 tags => [ '100', '110', '700', ],
772 label_value => 'Series',
773 tags => [ '440', '490', ],
779 link_value => 'branch',
780 label_value => 'Libraries',
785 push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
792 Return a href where a key is associated to a href. You give a query,
793 the name of the key among the fields returned by the query. If you
794 also give as third argument the name of the value, the function
795 returns a href of scalar. The optional 4th argument is an arrayref of
796 items passed to the C<execute()> call. It is designed to bind
797 parameters to any placeholders in your SQL.
806 # generic href of any information on the item, href of href.
807 my $iteminfos_of = get_infos_of($query, 'itemnumber');
808 print $iteminfos_of->{$itemnumber}{barcode};
810 # specific information, href of scalar
811 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
812 print $barcode_of_item->{$itemnumber};
817 my ( $query, $key_name, $value_name, $bind_params ) = @_;
819 my $dbh = C4::Context->dbh;
821 my $sth = $dbh->prepare($query);
822 $sth->execute( @$bind_params );
825 while ( my $row = $sth->fetchrow_hashref ) {
826 if ( defined $value_name ) {
827 $infos_of{ $row->{$key_name} } = $row->{$value_name};
830 $infos_of{ $row->{$key_name} } = $row;
838 =head2 get_notforloan_label_of
840 my $notforloan_label_of = get_notforloan_label_of();
842 Each authorised value of notforloan (information available in items and
843 itemtypes) is link to a single label.
845 Returns a href where keys are authorised values and values are corresponding
848 foreach my $authorised_value (keys %{$notforloan_label_of}) {
850 "authorised_value: %s => %s\n",
852 $notforloan_label_of->{$authorised_value}
858 # FIXME - why not use GetAuthorisedValues ??
860 sub get_notforloan_label_of {
861 my $dbh = C4::Context->dbh;
864 SELECT authorised_value
865 FROM marc_subfield_structure
866 WHERE kohafield = \'items.notforloan\'
869 my $sth = $dbh->prepare($query);
871 my ($statuscode) = $sth->fetchrow_array();
876 FROM authorised_values
879 $sth = $dbh->prepare($query);
880 $sth->execute($statuscode);
881 my %notforloan_label_of;
882 while ( my $row = $sth->fetchrow_hashref ) {
883 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
887 return \%notforloan_label_of;
890 =head2 displayServers
894 my $servers = displayServers();
896 my $servers = displayServers( $position );
898 my $servers = displayServers( $position, $type );
902 displayServers returns a listref of hashrefs, each containing
903 information about available z3950 servers. Each hashref has a format
907 'checked' => 'checked',
908 'encoding' => 'MARC-8'
910 'id' => 'LIBRARY OF CONGRESS',
914 'value' => 'z3950.loc.gov:7090/',
922 my ( $position, $type ) = @_;
923 my $dbh = C4::Context->dbh;
925 my $strsth = 'SELECT * FROM z3950servers';
930 push @bind_params, $position;
931 push @where_clauses, ' position = ? ';
935 push @bind_params, $type;
936 push @where_clauses, ' type = ? ';
939 # reassemble where clause from where clause pieces
940 if (@where_clauses) {
941 $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
944 my $rq = $dbh->prepare($strsth);
945 $rq->execute(@bind_params);
946 my @primaryserverloop;
948 while ( my $data = $rq->fetchrow_hashref ) {
949 push @primaryserverloop,
950 { label => $data->{description},
953 value => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
954 encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
955 checked => "checked",
956 icon => $data->{icon},
957 zed => $data->{type} eq 'zed',
958 opensearch => $data->{type} eq 'opensearch'
961 return \@primaryserverloop;
964 sub displaySecondaryServers {
966 # my $secondary_servers_loop = [
967 # { inner_sup_servers_loop => [
968 # {label => "Google", id=>"GOOG", value=>"google",icon => "google.ico",opensearch => "1"},
969 # {label => "Yahoo", id=>"YAH", value=>"yahoo", icon =>"yahoo.ico", zed => "1"},
970 # {label => "Worldcat", id=>"WCT", value=>"worldcat", icon => "worldcat.gif", zed => "1"},
971 # {label => "Library of Congress", id=>"LOC", name=> "server", value=>"z3950.loc.gov:7090/Voyager", icon =>"loc.ico", zed => "1"},
975 return; #$secondary_servers_loop;
978 =head2 GetAuthValCode
980 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
985 my ($kohafield,$fwcode) = @_;
986 my $dbh = C4::Context->dbh;
987 $fwcode='' unless $fwcode;
988 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
989 $sth->execute($kohafield,$fwcode);
990 my ($authvalcode) = $sth->fetchrow_array;
994 =head2 GetAuthorisedValues
996 $authvalues = GetAuthorisedValues($category);
998 this function get all authorised values from 'authosied_value' table into a reference to array which
999 each value containt an hashref.
1001 Set C<$category> on input args if you want to limits your query to this one. This params is not mandatory.
1005 sub GetAuthorisedValues {
1006 my ($category,$selected) = @_;
1009 my $dbh = C4::Context->dbh;
1010 my $query = "SELECT * FROM authorised_values";
1011 $query .= " WHERE category = '" . $category . "'" if $category;
1013 my $sth = $dbh->prepare($query);
1015 while (my $data=$sth->fetchrow_hashref) {
1016 if ($selected eq $data->{'authorised_value'} ) {
1017 $data->{'selected'} = 1;
1019 $results[$count] = $data;
1022 #my $data = $sth->fetchall_arrayref({});
1023 return \@results; #$data;
1026 =head2 GetAuthorisedValueCategories
1028 $auth_categories = GetAuthorisedValueCategories();
1030 Return an arrayref of all of the available authorised
1035 sub GetAuthorisedValueCategories {
1036 my $dbh = C4::Context->dbh;
1037 my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1040 while (my $category = $sth->fetchrow_array) {
1041 push @results, $category;
1046 =head2 GetKohaAuthorisedValues
1048 Takes $kohafield, $fwcode as parameters.
1049 Returns hashref of Code => description
1051 if no authorised value category is defined for the kohafield.
1055 sub GetKohaAuthorisedValues {
1056 my ($kohafield,$fwcode,$codedvalue) = @_;
1057 $fwcode='' unless $fwcode;
1059 my $dbh = C4::Context->dbh;
1060 my $avcode = GetAuthValCode($kohafield,$fwcode);
1062 my $sth = $dbh->prepare("select authorised_value, lib from authorised_values where category=? ");
1063 $sth->execute($avcode);
1064 while ( my ($val, $lib) = $sth->fetchrow_array ) {
1065 $values{$val}= $lib;
1073 =head2 GetManagedTagSubfields
1077 $res = GetManagedTagSubfields();
1081 Returns a reference to a big hash of hash, with the Marc structure fro the given frameworkcode
1083 NOTE: This function is used only by the (incomplete) bulk editing feature. Since
1084 that feature currently does not deal with items and biblioitems changes
1085 correctly, those tags are specifically excluded from the list prepared
1088 For future reference, if a bulk item editing feature is implemented at some point, it
1089 needs some design thought -- for example, circulation status fields should not
1090 be changed willy-nilly.
1094 sub GetManagedTagSubfields{
1095 my $dbh=C4::Context->dbh;
1096 my $rq=$dbh->prepare(qq|
1098 DISTINCT CONCAT( marc_subfield_structure.tagfield, tagsubfield ) AS tagsubfield,
1099 marc_subfield_structure.liblibrarian as subfielddesc,
1100 marc_tag_structure.liblibrarian as tagdesc
1101 FROM marc_subfield_structure
1102 LEFT JOIN marc_tag_structure
1103 ON marc_tag_structure.tagfield = marc_subfield_structure.tagfield
1104 AND marc_tag_structure.frameworkcode = marc_subfield_structure.frameworkcode
1105 WHERE marc_subfield_structure.tab>=0
1106 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield like 'items.%')
1107 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield = 'biblioitems.itemtype')
1108 AND marc_subfield_structure.kohafield <> 'biblio.biblionumber'
1109 AND marc_subfield_structure.kohafield <> 'biblioitems.biblioitemnumber'
1110 ORDER BY marc_subfield_structure.tagfield, tagsubfield|);
1112 my $data=$rq->fetchall_arrayref({});
1116 =head2 display_marc_indicators
1120 # field is a MARC::Field object
1121 my $display_form = C4::Koha::display_marc_indicators($field);
1125 Generate a display form of the indicators of a variable
1126 MARC field, replacing any blanks with '#'.
1130 sub display_marc_indicators {
1132 my $indicators = '';
1133 if ($field->tag() >= 10) {
1134 $indicators = $field->indicator(1) . $field->indicator(2);
1135 $indicators =~ s/ /#/g;