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;
891 my ( $position, $type ) = @_;
892 my $dbh = C4::Context->dbh;
894 my $strsth = 'SELECT * FROM z3950servers';
899 push @bind_params, $position;
900 push @where_clauses, ' position = ? ';
904 push @bind_params, $type;
905 push @where_clauses, ' type = ? ';
908 if ( @where_clauses ) {
909 $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
912 my $rq = $dbh->prepare($strsth);
913 $rq->execute( @bind_params );
914 my @primaryserverloop;
916 while ( my $data = $rq->fetchrow_hashref ) {
918 $cell{label} = $data->{'description'};
919 $cell{id} = $data->{'name'};
922 . ( $data->{port} ? ":" . $data->{port} : "" ) . "/"
924 if ( $data->{host} );
925 $cell{checked} = $data->{checked};
926 push @primaryserverloop,
928 label => $data->{description},
931 value => $data->{host} . ":"
932 . $data->{port} . "/"
934 encoding => ($data->{encoding}?$data->{encoding}:"iso-5426"),
935 checked => "checked",
936 icon => $data->{icon},
937 zed => $data->{type} eq 'zed',
938 opensearch => $data->{type} eq 'opensearch'
941 return \@primaryserverloop;
944 sub displaySecondaryServers {
946 # my $secondary_servers_loop = [
947 # { inner_sup_servers_loop => [
948 # {label => "Google", id=>"GOOG", value=>"google",icon => "google.ico",opensearch => "1"},
949 # {label => "Yahoo", id=>"YAH", value=>"yahoo", icon =>"yahoo.ico", zed => "1"},
950 # {label => "Worldcat", id=>"WCT", value=>"worldcat", icon => "worldcat.gif", zed => "1"},
951 # {label => "Library of Congress", id=>"LOC", name=> "server", value=>"z3950.loc.gov:7090/Voyager", icon =>"loc.ico", zed => "1"},
955 return; #$secondary_servers_loop;
958 =head2 GetAuthValCode
960 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
965 my ($kohafield,$fwcode) = @_;
966 my $dbh = C4::Context->dbh;
967 $fwcode='' unless $fwcode;
968 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
969 $sth->execute($kohafield,$fwcode);
970 my ($authvalcode) = $sth->fetchrow_array;
974 =head2 GetAuthorisedValues
976 $authvalues = GetAuthorisedValues($category);
978 this function get all authorised values from 'authosied_value' table into a reference to array which
979 each value containt an hashref.
981 Set C<$category> on input args if you want to limits your query to this one. This params is not mandatory.
985 sub GetAuthorisedValues {
986 my ($category,$selected) = @_;
989 my $dbh = C4::Context->dbh;
990 my $query = "SELECT * FROM authorised_values";
991 $query .= " WHERE category = '" . $category . "'" if $category;
993 my $sth = $dbh->prepare($query);
995 while (my $data=$sth->fetchrow_hashref) {
996 if ($selected eq $data->{'authorised_value'} ) {
997 $data->{'selected'} = 1;
999 $results[$count] = $data;
1002 #my $data = $sth->fetchall_arrayref({});
1003 return \@results; #$data;
1006 =head2 GetAuthorisedValueCategories
1008 $auth_categories = GetAuthorisedValueCategories();
1010 Return an arrayref of all of the available authorised
1015 sub GetAuthorisedValueCategories {
1016 my $dbh = C4::Context->dbh;
1017 my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1020 while (my $category = $sth->fetchrow_array) {
1021 push @results, $category;
1026 =head2 GetKohaAuthorisedValues
1028 Takes $kohafield, $fwcode as parameters.
1029 Returns hashref of Code => description
1031 if no authorised value category is defined for the kohafield.
1035 sub GetKohaAuthorisedValues {
1036 my ($kohafield,$fwcode,$codedvalue) = @_;
1037 $fwcode='' unless $fwcode;
1039 my $dbh = C4::Context->dbh;
1040 my $avcode = GetAuthValCode($kohafield,$fwcode);
1042 my $sth = $dbh->prepare("select authorised_value, lib from authorised_values where category=? ");
1043 $sth->execute($avcode);
1044 while ( my ($val, $lib) = $sth->fetchrow_array ) {
1045 $values{$val}= $lib;
1053 =head2 GetManagedTagSubfields
1057 $res = GetManagedTagSubfields();
1061 Returns a reference to a big hash of hash, with the Marc structure fro the given frameworkcode
1063 NOTE: This function is used only by the (incomplete) bulk editing feature. Since
1064 that feature currently does not deal with items and biblioitems changes
1065 correctly, those tags are specifically excluded from the list prepared
1068 For future reference, if a bulk item editing feature is implemented at some point, it
1069 needs some design thought -- for example, circulation status fields should not
1070 be changed willy-nilly.
1074 sub GetManagedTagSubfields{
1075 my $dbh=C4::Context->dbh;
1076 my $rq=$dbh->prepare(qq|
1078 DISTINCT CONCAT( marc_subfield_structure.tagfield, tagsubfield ) AS tagsubfield,
1079 marc_subfield_structure.liblibrarian as subfielddesc,
1080 marc_tag_structure.liblibrarian as tagdesc
1081 FROM marc_subfield_structure
1082 LEFT JOIN marc_tag_structure
1083 ON marc_tag_structure.tagfield = marc_subfield_structure.tagfield
1084 AND marc_tag_structure.frameworkcode = marc_subfield_structure.frameworkcode
1085 WHERE marc_subfield_structure.tab>=0
1086 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield like 'items.%')
1087 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield = 'biblioitems.itemtype')
1088 AND marc_subfield_structure.kohafield <> 'biblio.biblionumber'
1089 AND marc_subfield_structure.kohafield <> 'biblioitems.biblioitemnumber'
1090 ORDER BY marc_subfield_structure.tagfield, tagsubfield|);
1092 my $data=$rq->fetchall_arrayref({});
1096 =head2 display_marc_indicators
1100 # field is a MARC::Field object
1101 my $display_form = C4::Koha::display_marc_indicators($field);
1105 Generate a display form of the indicators of a variable
1106 MARC field, replacing any blanks with '#'.
1110 sub display_marc_indicators {
1112 my $indicators = '';
1113 if ($field->tag() >= 10) {
1114 $indicators = $field->indicator(1) . $field->indicator(2);
1115 $indicators =~ s/ /#/g;