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
46 &getitemtypeimagesrcfromurl
48 &get_notforloan_label_of
51 &getitemtypeimagelocation
53 &GetAuthorisedValueCategories
54 &GetKohaAuthorisedValues
56 &GetManagedTagSubfields
65 C4::Koha - Perl Module containing convenience functions for Koha scripts
74 Koha.pm provides many functions for Koha scripts.
82 $slash_date = &slashifyDate($dash_date);
84 Takes a string of the form "DD-MM-YYYY" (or anything separated by
85 dashes), converts it to the form "YYYY/MM/DD", and returns the result.
91 # accepts a date of the form xx-xx-xx[xx] and returns it in the
93 my @dateOut = split( '-', shift );
94 return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
100 my $string = DisplayISBN( $isbn );
106 if (length ($isbn)<13){
108 if ( substr( $isbn, 0, 1 ) <= 7 ) {
109 $seg1 = substr( $isbn, 0, 1 );
111 elsif ( substr( $isbn, 0, 2 ) <= 94 ) {
112 $seg1 = substr( $isbn, 0, 2 );
114 elsif ( substr( $isbn, 0, 3 ) <= 995 ) {
115 $seg1 = substr( $isbn, 0, 3 );
117 elsif ( substr( $isbn, 0, 4 ) <= 9989 ) {
118 $seg1 = substr( $isbn, 0, 4 );
121 $seg1 = substr( $isbn, 0, 5 );
123 my $x = substr( $isbn, length($seg1) );
125 if ( substr( $x, 0, 2 ) <= 19 ) {
127 # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
128 $seg2 = substr( $x, 0, 2 );
130 elsif ( substr( $x, 0, 3 ) <= 699 ) {
131 $seg2 = substr( $x, 0, 3 );
133 elsif ( substr( $x, 0, 4 ) <= 8399 ) {
134 $seg2 = substr( $x, 0, 4 );
136 elsif ( substr( $x, 0, 5 ) <= 89999 ) {
137 $seg2 = substr( $x, 0, 5 );
139 elsif ( substr( $x, 0, 6 ) <= 9499999 ) {
140 $seg2 = substr( $x, 0, 6 );
143 $seg2 = substr( $x, 0, 7 );
145 my $seg3 = substr( $x, length($seg2) );
146 $seg3 = substr( $seg3, 0, length($seg3) - 1 );
147 my $seg4 = substr( $x, -1, 1 );
148 return "$seg1-$seg2-$seg3-$seg4";
151 $seg1 = substr( $isbn, 0, 3 );
153 if ( substr( $isbn, 3, 1 ) <= 7 ) {
154 $seg2 = substr( $isbn, 3, 1 );
156 elsif ( substr( $isbn, 3, 2 ) <= 94 ) {
157 $seg2 = substr( $isbn, 3, 2 );
159 elsif ( substr( $isbn, 3, 3 ) <= 995 ) {
160 $seg2 = substr( $isbn, 3, 3 );
162 elsif ( substr( $isbn, 3, 4 ) <= 9989 ) {
163 $seg2 = substr( $isbn, 3, 4 );
166 $seg2 = substr( $isbn, 3, 5 );
168 my $x = substr( $isbn, length($seg2) +3);
170 if ( substr( $x, 0, 2 ) <= 19 ) {
172 # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
173 $seg3 = substr( $x, 0, 2 );
175 elsif ( substr( $x, 0, 3 ) <= 699 ) {
176 $seg3 = substr( $x, 0, 3 );
178 elsif ( substr( $x, 0, 4 ) <= 8399 ) {
179 $seg3 = substr( $x, 0, 4 );
181 elsif ( substr( $x, 0, 5 ) <= 89999 ) {
182 $seg3 = substr( $x, 0, 5 );
184 elsif ( substr( $x, 0, 6 ) <= 9499999 ) {
185 $seg3 = substr( $x, 0, 6 );
188 $seg3 = substr( $x, 0, 7 );
190 my $seg4 = substr( $x, length($seg3) );
191 $seg4 = substr( $seg4, 0, length($seg4) - 1 );
192 my $seg5 = substr( $x, -1, 1 );
193 return "$seg1-$seg2-$seg3-$seg4-$seg5";
197 # FIXME.. this should be moved to a MARC-specific module
198 sub subfield_is_koha_internal_p ($) {
201 # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
202 # But real MARC subfields are always single-character
203 # so it really is safer just to check the length
205 return length $subfield != 1;
210 $itemtypes = &GetItemTypes();
212 Returns information about existing itemtypes.
214 build a HTML select with the following code :
216 =head3 in PERL SCRIPT
218 my $itemtypes = GetItemTypes;
220 foreach my $thisitemtype (sort keys %$itemtypes) {
221 my $selected = 1 if $thisitemtype eq $itemtype;
222 my %row =(value => $thisitemtype,
223 selected => $selected,
224 description => $itemtypes->{$thisitemtype}->{'description'},
226 push @itemtypesloop, \%row;
228 $template->param(itemtypeloop => \@itemtypesloop);
232 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
233 <select name="itemtype">
234 <option value="">Default</option>
235 <!-- TMPL_LOOP name="itemtypeloop" -->
236 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
239 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
240 <input type="submit" value="OK" class="button">
247 # returns a reference to a hash of references to branches...
249 my $dbh = C4::Context->dbh;
254 my $sth = $dbh->prepare($query);
256 while ( my $IT = $sth->fetchrow_hashref ) {
257 $itemtypes{ $IT->{'itemtype'} } = $IT;
259 return ( \%itemtypes );
262 sub get_itemtypeinfos_of {
265 my $placeholders = join( ', ', map { '?' } @itemtypes );
266 my $query = <<"END_SQL";
272 WHERE itemtype IN ( $placeholders )
275 return get_infos_of( $query, 'itemtype', undef, \@itemtypes );
278 # this is temporary until we separate collection codes and item types
282 my $dbh = C4::Context->dbh;
285 "SELECT * FROM authorised_values ORDER BY authorised_value");
287 while ( my $data = $sth->fetchrow_hashref ) {
288 if ( $data->{category} eq "CCODE" ) {
290 $results[$count] = $data;
296 return ( $count, @results );
301 $authtypes = &getauthtypes();
303 Returns information about existing authtypes.
305 build a HTML select with the following code :
307 =head3 in PERL SCRIPT
309 my $authtypes = getauthtypes;
311 foreach my $thisauthtype (keys %$authtypes) {
312 my $selected = 1 if $thisauthtype eq $authtype;
313 my %row =(value => $thisauthtype,
314 selected => $selected,
315 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
317 push @authtypesloop, \%row;
319 $template->param(itemtypeloop => \@itemtypesloop);
323 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
324 <select name="authtype">
325 <!-- TMPL_LOOP name="authtypeloop" -->
326 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
329 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
330 <input type="submit" value="OK" class="button">
338 # returns a reference to a hash of references to authtypes...
340 my $dbh = C4::Context->dbh;
341 my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
343 while ( my $IT = $sth->fetchrow_hashref ) {
344 $authtypes{ $IT->{'authtypecode'} } = $IT;
346 return ( \%authtypes );
350 my ($authtypecode) = @_;
352 # returns a reference to a hash of references to authtypes...
354 my $dbh = C4::Context->dbh;
355 my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
356 $sth->execute($authtypecode);
357 my $res = $sth->fetchrow_hashref;
363 $frameworks = &getframework();
365 Returns information about existing frameworks
367 build a HTML select with the following code :
369 =head3 in PERL SCRIPT
371 my $frameworks = frameworks();
373 foreach my $thisframework (keys %$frameworks) {
374 my $selected = 1 if $thisframework eq $frameworkcode;
375 my %row =(value => $thisframework,
376 selected => $selected,
377 description => $frameworks->{$thisframework}->{'frameworktext'},
379 push @frameworksloop, \%row;
381 $template->param(frameworkloop => \@frameworksloop);
385 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
386 <select name="frameworkcode">
387 <option value="">Default</option>
388 <!-- TMPL_LOOP name="frameworkloop" -->
389 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
392 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
393 <input type="submit" value="OK" class="button">
401 # returns a reference to a hash of references to branches...
403 my $dbh = C4::Context->dbh;
404 my $sth = $dbh->prepare("select * from biblio_framework");
406 while ( my $IT = $sth->fetchrow_hashref ) {
407 $itemtypes{ $IT->{'frameworkcode'} } = $IT;
409 return ( \%itemtypes );
412 =head2 getframeworkinfo
414 $frameworkinfo = &getframeworkinfo($frameworkcode);
416 Returns information about an frameworkcode.
420 sub getframeworkinfo {
421 my ($frameworkcode) = @_;
422 my $dbh = C4::Context->dbh;
424 $dbh->prepare("select * from biblio_framework where frameworkcode=?");
425 $sth->execute($frameworkcode);
426 my $res = $sth->fetchrow_hashref;
430 =head2 getitemtypeinfo
432 $itemtype = &getitemtype($itemtype);
434 Returns information about an itemtype.
438 sub getitemtypeinfo {
440 my $dbh = C4::Context->dbh;
441 my $sth = $dbh->prepare("select * from itemtypes where itemtype=?");
442 $sth->execute($itemtype);
443 my $res = $sth->fetchrow_hashref;
445 $res->{imageurl} = getitemtypeimagesrcfromurl( $res->{imageurl} );
450 sub getitemtypeimagesrcfromurl {
453 if ( defined $imageurl and $imageurl !~ m/^http/ ) {
454 $imageurl = getitemtypeimagesrc() . '/' . $imageurl;
460 =head2 getitemtypeimagedir
466 my $directory = getitemtypeimagedir( 'opac' );
468 pass in 'opac' or 'intranet'. Defaults to 'opac'.
470 returns the full path to the appropriate directory containing images.
476 sub getitemtypeimagedir {
478 $src = 'opac' unless defined $src;
480 if ($src eq 'intranet') {
481 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
484 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('template') . '/itemtypeimg';
488 sub getitemtypeimagesrc {
490 if ($src eq 'intranet') {
491 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
494 return '/opac-tmpl' . '/' . C4::Context->preference('template') . '/itemtypeimg';
498 sub getitemtypeimagelocation($$) {
499 my ( $src, $image ) = @_;
501 return if ( !$image );
503 my $scheme = ( uri_split( $image ) )[0];
505 return $image if ( $scheme );
507 return getitemtypeimagesrc( $src ) . '/' . $image;
510 =head3 _getImagesFromDirectory
512 Find all of the image files in a directory in the filesystem
517 returns: a list of images in that directory.
519 Notes: this does not traverse into subdirectories. See
520 _getSubdirectoryNames for help with that.
521 Images are assumed to be files with .gif or .png file extensions.
522 The image names returned do not have the directory name on them.
526 sub _getImagesFromDirectory {
527 my $directoryname = shift;
528 return unless defined $directoryname;
529 return unless -d $directoryname;
531 if ( opendir ( my $dh, $directoryname ) ) {
532 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
536 warn "unable to opendir $directoryname: $!";
541 =head3 _getSubdirectoryNames
543 Find all of the directories in a directory in the filesystem
548 returns: a list of subdirectories in that directory.
550 Notes: this does not traverse into subdirectories. Only the first
551 level of subdirectories are returned.
552 The directory names returned don't have the parent directory name
557 sub _getSubdirectoryNames {
558 my $directoryname = shift;
559 return unless defined $directoryname;
560 return unless -d $directoryname;
562 if ( opendir ( my $dh, $directoryname ) ) {
563 my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
567 warn "unable to opendir $directoryname: $!";
574 returns: a listref of hashrefs. Each hash represents another collection of images.
575 { imagesetname => 'npl', # the name of the image set (npl is the original one)
576 images => listref of image hashrefs
579 each image is represented by a hashref like this:
580 { KohaImage => 'npl/image.gif',
581 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
582 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
583 checked => 0 or 1: was this the image passed to this method?
584 Note: I'd like to remove this somehow.
591 my $checked = $params{'checked'} || '';
593 my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
594 url => getitemtypeimagesrc('intranet'),
596 opac => { filesystem => getitemtypeimagedir('opac'),
597 url => getitemtypeimagesrc('opac'),
601 my @imagesets = (); # list of hasrefs of image set data to pass to template
602 my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
604 foreach my $imagesubdir ( @subdirectories ) {
605 my @imagelist = (); # hashrefs of image info
606 my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
607 foreach my $thisimage ( @imagenames ) {
609 { KohaImage => "$imagesubdir/$thisimage",
610 StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
611 OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
612 checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
616 push @imagesets, { imagesetname => $imagesubdir,
617 images => \@imagelist };
625 $printers = &GetPrinters();
626 @queues = keys %$printers;
628 Returns information about existing printer queues.
630 C<$printers> is a reference-to-hash whose keys are the print queues
631 defined in the printers table of the Koha database. The values are
632 references-to-hash, whose keys are the fields in the printers table.
638 my $dbh = C4::Context->dbh;
639 my $sth = $dbh->prepare("select * from printers");
641 while ( my $printer = $sth->fetchrow_hashref ) {
642 $printers{ $printer->{'printqueue'} } = $printer;
644 return ( \%printers );
649 $printer = GetPrinter( $query, $printers );
653 sub GetPrinter ($$) {
654 my ( $query, $printers ) = @_; # get printer for this query from printers
655 my $printer = $query->param('printer');
656 my %cookie = $query->cookie('userenv');
657 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
658 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
664 Returns the number of pages to display in a pagination bar, given the number
665 of items and the number of items per page.
670 my ( $nb_items, $nb_items_per_page ) = @_;
672 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
677 (@themes) = &getallthemes('opac');
678 (@themes) = &getallthemes('intranet');
680 Returns an array of all available themes.
688 if ( $type eq 'intranet' ) {
689 $htdocs = C4::Context->config('intrahtdocs');
692 $htdocs = C4::Context->config('opachtdocs');
694 opendir D, "$htdocs";
695 my @dirlist = readdir D;
696 foreach my $directory (@dirlist) {
697 -d "$htdocs/$directory/en" and push @themes, $directory;
704 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
707 link_value => 'su-to',
708 label_value => 'Topics',
710 [ '600', '601', '602', '603', '604', '605', '606', '610' ],
714 link_value => 'su-geo',
715 label_value => 'Places',
720 link_value => 'su-ut',
721 label_value => 'Titles',
722 tags => [ '500', '501', '502', '503', '504', ],
727 label_value => 'Authors',
728 tags => [ '700', '701', '702', ],
733 label_value => 'Series',
742 link_value => 'branch',
743 label_value => 'Libraries',
748 push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
753 link_value => 'su-to',
754 label_value => 'Topics',
760 # link_value => 'su-na',
761 # label_value => 'People and Organizations',
762 # tags => ['600', '610', '611'],
766 link_value => 'su-geo',
767 label_value => 'Places',
772 link_value => 'su-ut',
773 label_value => 'Titles',
779 label_value => 'Authors',
780 tags => [ '100', '110', '700', ],
785 label_value => 'Series',
786 tags => [ '440', '490', ],
792 link_value => 'branch',
793 label_value => 'Libraries',
798 push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
805 Return a href where a key is associated to a href. You give a query,
806 the name of the key among the fields returned by the query. If you
807 also give as third argument the name of the value, the function
808 returns a href of scalar. The optional 4th argument is an arrayref of
809 items passed to the C<execute()> call. It is designed to bind
810 parameters to any placeholders in your SQL.
819 # generic href of any information on the item, href of href.
820 my $iteminfos_of = get_infos_of($query, 'itemnumber');
821 print $iteminfos_of->{$itemnumber}{barcode};
823 # specific information, href of scalar
824 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
825 print $barcode_of_item->{$itemnumber};
830 my ( $query, $key_name, $value_name, $bind_params ) = @_;
832 my $dbh = C4::Context->dbh;
834 my $sth = $dbh->prepare($query);
835 $sth->execute( @$bind_params );
838 while ( my $row = $sth->fetchrow_hashref ) {
839 if ( defined $value_name ) {
840 $infos_of{ $row->{$key_name} } = $row->{$value_name};
843 $infos_of{ $row->{$key_name} } = $row;
851 =head2 get_notforloan_label_of
853 my $notforloan_label_of = get_notforloan_label_of();
855 Each authorised value of notforloan (information available in items and
856 itemtypes) is link to a single label.
858 Returns a href where keys are authorised values and values are corresponding
861 foreach my $authorised_value (keys %{$notforloan_label_of}) {
863 "authorised_value: %s => %s\n",
865 $notforloan_label_of->{$authorised_value}
871 # FIXME - why not use GetAuthorisedValues ??
873 sub get_notforloan_label_of {
874 my $dbh = C4::Context->dbh;
877 SELECT authorised_value
878 FROM marc_subfield_structure
879 WHERE kohafield = \'items.notforloan\'
882 my $sth = $dbh->prepare($query);
884 my ($statuscode) = $sth->fetchrow_array();
889 FROM authorised_values
892 $sth = $dbh->prepare($query);
893 $sth->execute($statuscode);
894 my %notforloan_label_of;
895 while ( my $row = $sth->fetchrow_hashref ) {
896 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
900 return \%notforloan_label_of;
903 =head2 displayServers
907 my $servers = displayServers();
909 my $servers = displayServers( $position );
911 my $servers = displayServers( $position, $type );
915 displayServers returns a listref of hashrefs, each containing
916 information about available z3950 servers. Each hashref has a format
920 'checked' => 'checked',
921 'encoding' => 'MARC-8'
923 'id' => 'LIBRARY OF CONGRESS',
927 'value' => 'z3950.loc.gov:7090/',
935 my ( $position, $type ) = @_;
936 my $dbh = C4::Context->dbh;
938 my $strsth = 'SELECT * FROM z3950servers';
943 push @bind_params, $position;
944 push @where_clauses, ' position = ? ';
948 push @bind_params, $type;
949 push @where_clauses, ' type = ? ';
952 # reassemble where clause from where clause pieces
953 if (@where_clauses) {
954 $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
957 my $rq = $dbh->prepare($strsth);
958 $rq->execute(@bind_params);
959 my @primaryserverloop;
961 while ( my $data = $rq->fetchrow_hashref ) {
962 push @primaryserverloop,
963 { label => $data->{description},
966 value => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
967 encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
968 checked => "checked",
969 icon => $data->{icon},
970 zed => $data->{type} eq 'zed',
971 opensearch => $data->{type} eq 'opensearch'
974 return \@primaryserverloop;
977 sub displaySecondaryServers {
979 # my $secondary_servers_loop = [
980 # { inner_sup_servers_loop => [
981 # {label => "Google", id=>"GOOG", value=>"google",icon => "google.ico",opensearch => "1"},
982 # {label => "Yahoo", id=>"YAH", value=>"yahoo", icon =>"yahoo.ico", zed => "1"},
983 # {label => "Worldcat", id=>"WCT", value=>"worldcat", icon => "worldcat.gif", zed => "1"},
984 # {label => "Library of Congress", id=>"LOC", name=> "server", value=>"z3950.loc.gov:7090/Voyager", icon =>"loc.ico", zed => "1"},
988 return; #$secondary_servers_loop;
991 =head2 GetAuthValCode
993 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
998 my ($kohafield,$fwcode) = @_;
999 my $dbh = C4::Context->dbh;
1000 $fwcode='' unless $fwcode;
1001 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
1002 $sth->execute($kohafield,$fwcode);
1003 my ($authvalcode) = $sth->fetchrow_array;
1004 return $authvalcode;
1007 =head2 GetAuthorisedValues
1009 $authvalues = GetAuthorisedValues($category);
1011 this function get all authorised values from 'authosied_value' table into a reference to array which
1012 each value containt an hashref.
1014 Set C<$category> on input args if you want to limits your query to this one. This params is not mandatory.
1018 sub GetAuthorisedValues {
1019 my ($category,$selected) = @_;
1022 my $dbh = C4::Context->dbh;
1023 my $query = "SELECT * FROM authorised_values";
1024 $query .= " WHERE category = '" . $category . "'" if $category;
1026 my $sth = $dbh->prepare($query);
1028 while (my $data=$sth->fetchrow_hashref) {
1029 if ($selected eq $data->{'authorised_value'} ) {
1030 $data->{'selected'} = 1;
1032 $results[$count] = $data;
1035 #my $data = $sth->fetchall_arrayref({});
1036 return \@results; #$data;
1039 =head2 GetAuthorisedValueCategories
1041 $auth_categories = GetAuthorisedValueCategories();
1043 Return an arrayref of all of the available authorised
1048 sub GetAuthorisedValueCategories {
1049 my $dbh = C4::Context->dbh;
1050 my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1053 while (my $category = $sth->fetchrow_array) {
1054 push @results, $category;
1059 =head2 GetKohaAuthorisedValues
1061 Takes $kohafield, $fwcode as parameters.
1062 Returns hashref of Code => description
1064 if no authorised value category is defined for the kohafield.
1068 sub GetKohaAuthorisedValues {
1069 my ($kohafield,$fwcode,$codedvalue) = @_;
1070 $fwcode='' unless $fwcode;
1072 my $dbh = C4::Context->dbh;
1073 my $avcode = GetAuthValCode($kohafield,$fwcode);
1075 my $sth = $dbh->prepare("select authorised_value, lib from authorised_values where category=? ");
1076 $sth->execute($avcode);
1077 while ( my ($val, $lib) = $sth->fetchrow_array ) {
1078 $values{$val}= $lib;
1086 =head2 GetManagedTagSubfields
1090 $res = GetManagedTagSubfields();
1094 Returns a reference to a big hash of hash, with the Marc structure fro the given frameworkcode
1096 NOTE: This function is used only by the (incomplete) bulk editing feature. Since
1097 that feature currently does not deal with items and biblioitems changes
1098 correctly, those tags are specifically excluded from the list prepared
1101 For future reference, if a bulk item editing feature is implemented at some point, it
1102 needs some design thought -- for example, circulation status fields should not
1103 be changed willy-nilly.
1107 sub GetManagedTagSubfields{
1108 my $dbh=C4::Context->dbh;
1109 my $rq=$dbh->prepare(qq|
1111 DISTINCT CONCAT( marc_subfield_structure.tagfield, tagsubfield ) AS tagsubfield,
1112 marc_subfield_structure.liblibrarian as subfielddesc,
1113 marc_tag_structure.liblibrarian as tagdesc
1114 FROM marc_subfield_structure
1115 LEFT JOIN marc_tag_structure
1116 ON marc_tag_structure.tagfield = marc_subfield_structure.tagfield
1117 AND marc_tag_structure.frameworkcode = marc_subfield_structure.frameworkcode
1118 WHERE marc_subfield_structure.tab>=0
1119 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield like 'items.%')
1120 AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield = 'biblioitems.itemtype')
1121 AND marc_subfield_structure.kohafield <> 'biblio.biblionumber'
1122 AND marc_subfield_structure.kohafield <> 'biblioitems.biblioitemnumber'
1123 ORDER BY marc_subfield_structure.tagfield, tagsubfield|);
1125 my $data=$rq->fetchall_arrayref({});
1129 =head2 display_marc_indicators
1133 # field is a MARC::Field object
1134 my $display_form = C4::Koha::display_marc_indicators($field);
1138 Generate a display form of the indicators of a variable
1139 MARC field, replacing any blanks with '#'.
1143 sub display_marc_indicators {
1145 my $indicators = '';
1146 if ($field->tag() >= 10) {
1147 $indicators = $field->indicator(1) . $field->indicator(2);
1148 $indicators =~ s/ /#/g;