3 # Copyright 2000-2002 Katipo Communications
4 # Parts Copyright 2010 Nelsonville Public Library
5 # Parts copyright 2010 BibLibre
7 # This file is part of Koha.
9 # Koha is free software; you can redistribute it and/or modify it
10 # under the terms of the GNU General Public License as published by
11 # the Free Software Foundation; either version 3 of the License, or
12 # (at your option) any later version.
14 # Koha is distributed in the hope that it will be useful, but
15 # WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 # GNU General Public License for more details.
19 # You should have received a copy of the GNU General Public License
20 # along with Koha; if not, see <http://www.gnu.org/licenses>.
24 #use warnings; FIXME - Bug 2505
27 use C4::Branch qw(GetBranchesCount);
29 use Koha::DateUtils qw(dt_from_string);
30 use DateTime::Format::MySQL;
32 use autouse 'Data::cselectall_arrayref' => qw(Dumper);
33 use DBI qw(:sql_types);
34 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $DEBUG);
37 $VERSION = 3.07.00.049;
42 &subfield_is_koha_internal_p
43 &GetPrinters &GetPrinter
44 &GetItemTypes &getitemtypeinfo
45 &GetItemTypesCategorized &GetItemTypesByCategory
46 &GetSupportName &GetSupportList
48 &getframeworks &getframeworkinfo
50 &getauthtypes &getauthtype
56 &get_notforloan_label_of
59 &getitemtypeimagelocation
61 &GetAuthorisedValueCategories
62 &IsAuthorisedValueCategory
63 &GetKohaAuthorisedValues
64 &GetKohaAuthorisedValuesFromField
65 &GetKohaAuthorisedValuesMapping
66 &GetKohaAuthorisedValueLib
67 &GetAuthorisedValueByCode
68 &GetKohaImageurlFromAuthorisedValues
74 &GetNormalizedOCLCNumber
84 @EXPORT_OK = qw( GetDailyQuote );
89 C4::Koha - Perl Module containing convenience functions for Koha scripts
97 Koha.pm provides many functions for Koha scripts.
105 $slash_date = &slashifyDate($dash_date);
107 Takes a string of the form "DD-MM-YYYY" (or anything separated by
108 dashes), converts it to the form "YYYY/MM/DD", and returns the result.
114 # accepts a date of the form xx-xx-xx[xx] and returns it in the
116 my @dateOut = split( '-', shift );
117 return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
120 # FIXME.. this should be moved to a MARC-specific module
121 sub subfield_is_koha_internal_p {
124 # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
125 # But real MARC subfields are always single-character
126 # so it really is safer just to check the length
128 return length $subfield != 1;
131 =head2 GetSupportName
133 $itemtypename = &GetSupportName($codestring);
135 Returns a string with the name of the itemtype.
141 return if (! $codestring);
143 my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
144 if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
151 my $sth = C4::Context->dbh->prepare($query);
152 $sth->execute($codestring);
153 ($resultstring)=$sth->fetchrow;
154 return $resultstring;
157 C4::Context->dbh->prepare(
158 "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
160 $sth->execute( $advanced_search_types, $codestring );
161 my $data = $sth->fetchrow_hashref;
162 return $$data{'lib'};
166 =head2 GetSupportList
168 $itemtypes = &GetSupportList();
170 Returns an array ref containing informations about Support (since itemtype is rather a circulation code when item-level-itypes is used).
172 build a HTML select with the following code :
174 =head3 in PERL SCRIPT
176 my $itemtypes = GetSupportList();
177 $template->param(itemtypeloop => $itemtypes);
181 <select name="itemtype" id="itemtype">
182 <option value=""></option>
183 [% FOREACH itemtypeloo IN itemtypeloop %]
184 [% IF ( itemtypeloo.selected ) %]
185 <option value="[% itemtypeloo.itemtype %]" selected="selected">[% itemtypeloo.description %]</option>
187 <option value="[% itemtypeloo.itemtype %]">[% itemtypeloo.description %]</option>
195 my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
196 if (!$advanced_search_types or $advanced_search_types =~ /itemtypes/) {
197 return GetItemTypes( style => 'array' );
199 my $advsearchtypes = GetAuthorisedValues($advanced_search_types);
200 my @results= map {{itemtype=>$$_{authorised_value},description=>$$_{lib},imageurl=>$$_{imageurl}}} @$advsearchtypes;
206 $itemtypes = &GetItemTypes( style => $style );
208 Returns information about existing itemtypes.
211 style: either 'array' or 'hash', defaults to 'hash'.
212 'array' returns an arrayref,
213 'hash' return a hashref with the itemtype value as the key
215 build a HTML select with the following code :
217 =head3 in PERL SCRIPT
219 my $itemtypes = GetItemTypes;
221 foreach my $thisitemtype (sort keys %$itemtypes) {
222 my $selected = 1 if $thisitemtype eq $itemtype;
223 my %row =(value => $thisitemtype,
224 selected => $selected,
225 description => $itemtypes->{$thisitemtype}->{'description'},
227 push @itemtypesloop, \%row;
229 $template->param(itemtypeloop => \@itemtypesloop);
233 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
234 <select name="itemtype">
235 <option value="">Default</option>
236 <!-- TMPL_LOOP name="itemtypeloop" -->
237 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
240 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
241 <input type="submit" value="OK" class="button">
248 my $style = defined( $params{'style'} ) ? $params{'style'} : 'hash';
250 require C4::Languages;
251 my $language = C4::Languages::getlanguage();
252 # returns a reference to a hash of references to itemtypes...
253 my $dbh = C4::Context->dbh;
257 itemtypes.description,
258 itemtypes.rentalcharge,
259 itemtypes.notforloan,
262 itemtypes.checkinmsg,
263 itemtypes.checkinmsgtype,
264 itemtypes.sip_media_type,
265 itemtypes.hideinopac,
266 itemtypes.searchcategory,
267 COALESCE( localization.translation, itemtypes.description ) AS translated_description
269 LEFT JOIN localization ON itemtypes.itemtype = localization.code
270 AND localization.entity = 'itemtypes'
271 AND localization.lang = ?
274 my $sth = $dbh->prepare($query);
275 $sth->execute( $language );
277 if ( $style eq 'hash' ) {
279 while ( my $IT = $sth->fetchrow_hashref ) {
280 $itemtypes{ $IT->{'itemtype'} } = $IT;
282 return ( \%itemtypes );
284 return [ sort { lc $a->{translated_description} cmp lc $b->{translated_description} } @{ $sth->fetchall_arrayref( {} ) } ];
288 =head2 GetItemTypesCategorized
290 $categories = GetItemTypesCategorized();
292 Returns a hashref containing search categories.
293 A search category will be put in the hash if at least one of its itemtypes is visible in OPAC.
294 The categories must be part of Authorized Values (ITEMTYPECAT)
298 sub GetItemTypesCategorized {
299 my $dbh = C4::Context->dbh;
300 # Order is important, so that partially hidden (some items are not visible in OPAC) search
301 # categories will be visible. hideinopac=0 must be last.
303 SELECT itemtype, description, imageurl, hideinopac, 0 as 'iscat' FROM itemtypes WHERE ISNULL(searchcategory) or length(searchcategory) = 0
305 SELECT DISTINCT searchcategory AS `itemtype`,
306 authorised_values.lib_opac AS description,
307 authorised_values.imageurl AS imageurl,
308 hideinopac, 1 as 'iscat'
310 LEFT JOIN authorised_values ON searchcategory = authorised_value
311 WHERE searchcategory > '' and hideinopac=1
313 SELECT DISTINCT searchcategory AS `itemtype`,
314 authorised_values.lib_opac AS description,
315 authorised_values.imageurl AS imageurl,
316 hideinopac, 1 as 'iscat'
318 LEFT JOIN authorised_values ON searchcategory = authorised_value
319 WHERE searchcategory > '' and hideinopac=0
321 return ($dbh->selectall_hashref($query,'itemtype'));
324 =head2 GetItemTypesByCategory
326 @results = GetItemTypesByCategory( $searchcategory );
328 Returns the itemtype code of all itemtypes included in a searchcategory.
332 sub GetItemTypesByCategory {
336 my $dbh = C4::Context->dbh;
337 my $query = qq|SELECT itemtype FROM itemtypes WHERE searchcategory=?|;
338 my $tmp=$dbh->selectcol_arrayref($query,undef,$category);
342 sub get_itemtypeinfos_of {
345 my $placeholders = join( ', ', map { '?' } @itemtypes );
346 my $query = <<"END_SQL";
352 WHERE itemtype IN ( $placeholders )
355 return get_infos_of( $query, 'itemtype', undef, \@itemtypes );
360 $authtypes = &getauthtypes();
362 Returns information about existing authtypes.
364 build a HTML select with the following code :
366 =head3 in PERL SCRIPT
368 my $authtypes = getauthtypes;
370 foreach my $thisauthtype (keys %$authtypes) {
371 my $selected = 1 if $thisauthtype eq $authtype;
372 my %row =(value => $thisauthtype,
373 selected => $selected,
374 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
376 push @authtypesloop, \%row;
378 $template->param(itemtypeloop => \@itemtypesloop);
382 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
383 <select name="authtype">
384 <!-- TMPL_LOOP name="authtypeloop" -->
385 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
388 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
389 <input type="submit" value="OK" class="button">
397 # returns a reference to a hash of references to authtypes...
399 my $dbh = C4::Context->dbh;
400 my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
402 while ( my $IT = $sth->fetchrow_hashref ) {
403 $authtypes{ $IT->{'authtypecode'} } = $IT;
405 return ( \%authtypes );
409 my ($authtypecode) = @_;
411 # returns a reference to a hash of references to authtypes...
413 my $dbh = C4::Context->dbh;
414 my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
415 $sth->execute($authtypecode);
416 my $res = $sth->fetchrow_hashref;
422 $frameworks = &getframework();
424 Returns information about existing frameworks
426 build a HTML select with the following code :
428 =head3 in PERL SCRIPT
430 my $frameworks = getframeworks();
432 foreach my $thisframework (keys %$frameworks) {
433 my $selected = 1 if $thisframework eq $frameworkcode;
435 value => $thisframework,
436 selected => $selected,
437 description => $frameworks->{$thisframework}->{'frameworktext'},
439 push @frameworksloop, \%row;
441 $template->param(frameworkloop => \@frameworksloop);
445 <form action="[% script_name %] method=post>
446 <select name="frameworkcode">
447 <option value="">Default</option>
448 [% FOREACH framework IN frameworkloop %]
449 [% IF ( framework.selected ) %]
450 <option value="[% framework.value %]" selected="selected">[% framework.description %]</option>
452 <option value="[% framework.value %]">[% framework.description %]</option>
456 <input type=text name=searchfield value="[% searchfield %]">
457 <input type="submit" value="OK" class="button">
464 # returns a reference to a hash of references to branches...
466 my $dbh = C4::Context->dbh;
467 my $sth = $dbh->prepare("select * from biblio_framework");
469 while ( my $IT = $sth->fetchrow_hashref ) {
470 $itemtypes{ $IT->{'frameworkcode'} } = $IT;
472 return ( \%itemtypes );
475 =head2 GetFrameworksLoop
477 $frameworks = GetFrameworksLoop( $frameworkcode );
479 Returns the loop suggested on getframework(), but ordered by framework description.
481 build a HTML select with the following code :
483 =head3 in PERL SCRIPT
485 $template->param( frameworkloop => GetFrameworksLoop( $frameworkcode ) );
489 Same as getframework()
491 <form action="[% script_name %] method=post>
492 <select name="frameworkcode">
493 <option value="">Default</option>
494 [% FOREACH framework IN frameworkloop %]
495 [% IF ( framework.selected ) %]
496 <option value="[% framework.value %]" selected="selected">[% framework.description %]</option>
498 <option value="[% framework.value %]">[% framework.description %]</option>
502 <input type=text name=searchfield value="[% searchfield %]">
503 <input type="submit" value="OK" class="button">
508 sub GetFrameworksLoop {
509 my $frameworkcode = shift;
510 my $frameworks = getframeworks();
512 foreach my $thisframework (sort { uc($frameworks->{$a}->{'frameworktext'}) cmp uc($frameworks->{$b}->{'frameworktext'}) } keys %$frameworks) {
513 my $selected = ( $thisframework eq $frameworkcode ) ? 1 : undef;
515 value => $thisframework,
516 selected => $selected,
517 description => $frameworks->{$thisframework}->{'frameworktext'},
519 push @frameworkloop, \%row;
521 return \@frameworkloop;
524 =head2 getframeworkinfo
526 $frameworkinfo = &getframeworkinfo($frameworkcode);
528 Returns information about an frameworkcode.
532 sub getframeworkinfo {
533 my ($frameworkcode) = @_;
534 my $dbh = C4::Context->dbh;
536 $dbh->prepare("select * from biblio_framework where frameworkcode=?");
537 $sth->execute($frameworkcode);
538 my $res = $sth->fetchrow_hashref;
542 =head2 getitemtypeinfo
544 $itemtype = &getitemtypeinfo($itemtype, [$interface]);
546 Returns information about an itemtype. The optional $interface argument
547 sets which interface ('opac' or 'intranet') to return the imageurl for.
548 Defaults to intranet.
552 sub getitemtypeinfo {
553 my ($itemtype, $interface) = @_;
554 my $dbh = C4::Context->dbh;
555 require C4::Languages;
556 my $language = C4::Languages::getlanguage();
557 my $it = $dbh->selectrow_hashref(q|
560 itemtypes.description,
561 itemtypes.rentalcharge,
562 itemtypes.notforloan,
565 itemtypes.checkinmsg,
566 itemtypes.checkinmsgtype,
567 itemtypes.sip_media_type,
568 COALESCE( localization.translation, itemtypes.description ) AS translated_description
570 LEFT JOIN localization ON itemtypes.itemtype = localization.code
571 AND localization.entity = 'itemtypes'
572 AND localization.lang = ?
573 WHERE itemtypes.itemtype = ?
574 |, undef, $language, $itemtype );
576 $it->{imageurl} = getitemtypeimagelocation( ( ( defined $interface && $interface eq 'opac' ) ? 'opac' : 'intranet' ), $it->{imageurl} );
581 =head2 getitemtypeimagedir
583 my $directory = getitemtypeimagedir( 'opac' );
585 pass in 'opac' or 'intranet'. Defaults to 'opac'.
587 returns the full path to the appropriate directory containing images.
591 sub getitemtypeimagedir {
592 my $src = shift || 'opac';
593 if ($src eq 'intranet') {
594 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
596 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
600 sub getitemtypeimagesrc {
601 my $src = shift || 'opac';
602 if ($src eq 'intranet') {
603 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
605 return '/opac-tmpl' . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
609 sub getitemtypeimagelocation {
610 my ( $src, $image ) = @_;
612 return '' if ( !$image );
615 my $scheme = ( URI::Split::uri_split( $image ) )[0];
617 return $image if ( $scheme );
619 return getitemtypeimagesrc( $src ) . '/' . $image;
622 =head3 _getImagesFromDirectory
624 Find all of the image files in a directory in the filesystem
626 parameters: a directory name
628 returns: a list of images in that directory.
630 Notes: this does not traverse into subdirectories. See
631 _getSubdirectoryNames for help with that.
632 Images are assumed to be files with .gif or .png file extensions.
633 The image names returned do not have the directory name on them.
637 sub _getImagesFromDirectory {
638 my $directoryname = shift;
639 return unless defined $directoryname;
640 return unless -d $directoryname;
642 if ( opendir ( my $dh, $directoryname ) ) {
643 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
645 @images = sort(@images);
648 warn "unable to opendir $directoryname: $!";
653 =head3 _getSubdirectoryNames
655 Find all of the directories in a directory in the filesystem
657 parameters: a directory name
659 returns: a list of subdirectories in that directory.
661 Notes: this does not traverse into subdirectories. Only the first
662 level of subdirectories are returned.
663 The directory names returned don't have the parent directory name on them.
667 sub _getSubdirectoryNames {
668 my $directoryname = shift;
669 return unless defined $directoryname;
670 return unless -d $directoryname;
672 if ( opendir ( my $dh, $directoryname ) ) {
673 my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
677 warn "unable to opendir $directoryname: $!";
684 returns: a listref of hashrefs. Each hash represents another collection of images.
686 { imagesetname => 'npl', # the name of the image set (npl is the original one)
687 images => listref of image hashrefs
690 each image is represented by a hashref like this:
692 { KohaImage => 'npl/image.gif',
693 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
694 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
695 checked => 0 or 1: was this the image passed to this method?
696 Note: I'd like to remove this somehow.
703 my $checked = $params{'checked'} || '';
705 my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
706 url => getitemtypeimagesrc('intranet'),
708 opac => { filesystem => getitemtypeimagedir('opac'),
709 url => getitemtypeimagesrc('opac'),
713 my @imagesets = (); # list of hasrefs of image set data to pass to template
714 my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
715 foreach my $imagesubdir ( @subdirectories ) {
716 warn $imagesubdir if $DEBUG;
717 my @imagelist = (); # hashrefs of image info
718 my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
719 my $imagesetactive = 0;
720 foreach my $thisimage ( @imagenames ) {
722 { KohaImage => "$imagesubdir/$thisimage",
723 StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
724 OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
725 checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
728 $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
730 push @imagesets, { imagesetname => $imagesubdir,
731 imagesetactive => $imagesetactive,
732 images => \@imagelist };
740 $printers = &GetPrinters();
741 @queues = keys %$printers;
743 Returns information about existing printer queues.
745 C<$printers> is a reference-to-hash whose keys are the print queues
746 defined in the printers table of the Koha database. The values are
747 references-to-hash, whose keys are the fields in the printers table.
753 my $dbh = C4::Context->dbh;
754 my $sth = $dbh->prepare("select * from printers");
756 while ( my $printer = $sth->fetchrow_hashref ) {
757 $printers{ $printer->{'printqueue'} } = $printer;
759 return ( \%printers );
764 $printer = GetPrinter( $query, $printers );
769 my ( $query, $printers ) = @_; # get printer for this query from printers
770 my $printer = $query->param('printer');
771 my %cookie = $query->cookie('userenv');
772 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
773 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
779 Returns the number of pages to display in a pagination bar, given the number
780 of items and the number of items per page.
785 my ( $nb_items, $nb_items_per_page ) = @_;
787 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
792 (@themes) = &getallthemes('opac');
793 (@themes) = &getallthemes('intranet');
795 Returns an array of all available themes.
803 if ( $type eq 'intranet' ) {
804 $htdocs = C4::Context->config('intrahtdocs');
807 $htdocs = C4::Context->config('opachtdocs');
809 opendir D, "$htdocs";
810 my @dirlist = readdir D;
811 foreach my $directory (@dirlist) {
812 next if $directory eq 'lib';
813 -d "$htdocs/$directory/en" and push @themes, $directory;
820 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
825 tags => [ qw/ 600ab 601ab 602a 604at 605a 606ax 610a / ],
831 tags => [ qw/ 607a / ],
837 tags => [ qw/ 500a 501a 503a / ],
843 tags => [ qw/ 700ab 701ab 702ab / ],
844 sep => C4::Context->preference("UNIMARCAuthorsFacetsSeparator"),
849 tags => [ qw/ 225a / ],
855 tags => [ qw/ 995e / ],
859 unless ( C4::Context->preference("singleBranchMode")
860 || GetBranchesCount() == 1 )
862 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
863 if ( $DisplayLibraryFacets eq 'both'
864 || $DisplayLibraryFacets eq 'holding' )
869 idx => 'holdingbranch',
870 label => 'HoldingLibrary',
871 tags => [qw / 995c /],
876 if ( $DisplayLibraryFacets eq 'both'
877 || $DisplayLibraryFacets eq 'home' )
883 label => 'HomeLibrary',
884 tags => [qw / 995b /],
895 tags => [ qw/ 650a / ],
900 # label => 'People and Organizations',
901 # tags => [ qw/ 600a 610a 611a / ],
907 tags => [ qw/ 651a / ],
913 tags => [ qw/ 630a / ],
919 tags => [ qw/ 100a 110a 700a / ],
925 tags => [ qw/ 440a 490a / ],
930 label => 'ItemTypes',
931 tags => [ qw/ 952y 942c / ],
937 tags => [ qw / 952c / ],
941 unless ( C4::Context->preference("singleBranchMode")
942 || GetBranchesCount() == 1 )
944 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
945 if ( $DisplayLibraryFacets eq 'both'
946 || $DisplayLibraryFacets eq 'holding' )
951 idx => 'holdingbranch',
952 label => 'HoldingLibrary',
953 tags => [qw / 952b /],
958 if ( $DisplayLibraryFacets eq 'both'
959 || $DisplayLibraryFacets eq 'home' )
965 label => 'HomeLibrary',
966 tags => [qw / 952a /],
977 Return a href where a key is associated to a href. You give a query,
978 the name of the key among the fields returned by the query. If you
979 also give as third argument the name of the value, the function
980 returns a href of scalar. The optional 4th argument is an arrayref of
981 items passed to the C<execute()> call. It is designed to bind
982 parameters to any placeholders in your SQL.
991 # generic href of any information on the item, href of href.
992 my $iteminfos_of = get_infos_of($query, 'itemnumber');
993 print $iteminfos_of->{$itemnumber}{barcode};
995 # specific information, href of scalar
996 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
997 print $barcode_of_item->{$itemnumber};
1002 my ( $query, $key_name, $value_name, $bind_params ) = @_;
1004 my $dbh = C4::Context->dbh;
1006 my $sth = $dbh->prepare($query);
1007 $sth->execute( @$bind_params );
1010 while ( my $row = $sth->fetchrow_hashref ) {
1011 if ( defined $value_name ) {
1012 $infos_of{ $row->{$key_name} } = $row->{$value_name};
1015 $infos_of{ $row->{$key_name} } = $row;
1023 =head2 get_notforloan_label_of
1025 my $notforloan_label_of = get_notforloan_label_of();
1027 Each authorised value of notforloan (information available in items and
1028 itemtypes) is link to a single label.
1030 Returns a href where keys are authorised values and values are corresponding
1033 foreach my $authorised_value (keys %{$notforloan_label_of}) {
1035 "authorised_value: %s => %s\n",
1037 $notforloan_label_of->{$authorised_value}
1043 # FIXME - why not use GetAuthorisedValues ??
1045 sub get_notforloan_label_of {
1046 my $dbh = C4::Context->dbh;
1049 SELECT authorised_value
1050 FROM marc_subfield_structure
1051 WHERE kohafield = \'items.notforloan\'
1054 my $sth = $dbh->prepare($query);
1056 my ($statuscode) = $sth->fetchrow_array();
1061 FROM authorised_values
1064 $sth = $dbh->prepare($query);
1065 $sth->execute($statuscode);
1066 my %notforloan_label_of;
1067 while ( my $row = $sth->fetchrow_hashref ) {
1068 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
1072 return \%notforloan_label_of;
1075 =head2 displayServers
1077 my $servers = displayServers();
1078 my $servers = displayServers( $position );
1079 my $servers = displayServers( $position, $type );
1081 displayServers returns a listref of hashrefs, each containing
1082 information about available z3950 servers. Each hashref has a format
1086 'checked' => 'checked',
1087 'encoding' => 'utf8',
1089 'id' => 'LIBRARY OF CONGRESS',
1093 'value' => 'lx2.loc.gov:210/',
1099 sub displayServers {
1100 my ( $position, $type ) = @_;
1101 my $dbh = C4::Context->dbh;
1103 my $strsth = 'SELECT * FROM z3950servers';
1108 push @bind_params, $position;
1109 push @where_clauses, ' position = ? ';
1113 push @bind_params, $type;
1114 push @where_clauses, ' type = ? ';
1117 # reassemble where clause from where clause pieces
1118 if (@where_clauses) {
1119 $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
1122 my $rq = $dbh->prepare($strsth);
1123 $rq->execute(@bind_params);
1124 my @primaryserverloop;
1126 while ( my $data = $rq->fetchrow_hashref ) {
1127 push @primaryserverloop,
1128 { label => $data->{description},
1129 id => $data->{name},
1131 value => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
1132 encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
1133 checked => "checked",
1134 icon => $data->{icon},
1135 zed => $data->{type} eq 'zed',
1136 opensearch => $data->{type} eq 'opensearch'
1139 return \@primaryserverloop;
1143 =head2 GetKohaImageurlFromAuthorisedValues
1145 $authhorised_value = GetKohaImageurlFromAuthorisedValues( $category, $authvalcode );
1147 Return the first url of the authorised value image represented by $lib.
1151 sub GetKohaImageurlFromAuthorisedValues {
1152 my ( $category, $lib ) = @_;
1153 my $dbh = C4::Context->dbh;
1154 my $sth = $dbh->prepare("SELECT imageurl FROM authorised_values WHERE category=? AND lib =?");
1155 $sth->execute( $category, $lib );
1156 while ( my $data = $sth->fetchrow_hashref ) {
1157 return $data->{'imageurl'};
1161 =head2 GetAuthValCode
1163 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
1167 sub GetAuthValCode {
1168 my ($kohafield,$fwcode) = @_;
1169 my $dbh = C4::Context->dbh;
1170 $fwcode='' unless $fwcode;
1171 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
1172 $sth->execute($kohafield,$fwcode);
1173 my ($authvalcode) = $sth->fetchrow_array;
1174 return $authvalcode;
1177 =head2 GetAuthValCodeFromField
1179 $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
1181 C<$subfield> can be undefined
1185 sub GetAuthValCodeFromField {
1186 my ($field,$subfield,$fwcode) = @_;
1187 my $dbh = C4::Context->dbh;
1188 $fwcode='' unless $fwcode;
1190 if (defined $subfield) {
1191 $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
1192 $sth->execute($field,$subfield,$fwcode);
1194 $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
1195 $sth->execute($field,$fwcode);
1197 my ($authvalcode) = $sth->fetchrow_array;
1198 return $authvalcode;
1201 =head2 GetAuthorisedValues
1203 $authvalues = GetAuthorisedValues([$category], [$selected]);
1205 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
1207 C<$category> returns authorised values for just one category (optional).
1209 C<$selected> adds a "selected => 1" entry to the hash if the
1210 authorised_value matches it. B<NOTE:> this feature should be considered
1211 deprecated as it may be removed in the future.
1213 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1217 sub GetAuthorisedValues {
1218 my ( $category, $selected, $opac ) = @_;
1220 # TODO: the "selected" feature should be replaced by a utility function
1221 # somewhere else, it doesn't belong in here. For starters it makes
1222 # caching much more complicated. Or just let the UI logic handle it, it's
1225 # Is this cached already?
1226 $opac = $opac ? 1 : 0; # normalise to be safe
1228 C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1229 my $selected_key = defined($selected) ? $selected : '';
1231 "AuthorisedValues-$category-$selected_key-$opac-$branch_limit";
1232 my $cache = Koha::Cache->get_instance();
1233 my $result = $cache->get_from_cache($cache_key);
1234 return $result if $result;
1237 my $dbh = C4::Context->dbh;
1239 SELECT DISTINCT av.*
1240 FROM authorised_values av
1243 LEFT JOIN authorised_values_branches ON ( id = av_id )
1248 push @where_strings, "category = ?";
1249 push @where_args, $category;
1252 push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
1253 push @where_args, $branch_limit;
1255 if(@where_strings > 0) {
1256 $query .= " WHERE " . join(" AND ", @where_strings);
1258 $query .= ' ORDER BY category, ' . (
1259 $opac ? 'COALESCE(lib_opac, lib)'
1263 my $sth = $dbh->prepare($query);
1265 $sth->execute( @where_args );
1266 while (my $data=$sth->fetchrow_hashref) {
1267 if ( defined $selected and $selected eq $data->{authorised_value} ) {
1268 $data->{selected} = 1;
1271 $data->{selected} = 0;
1274 if ($opac && $data->{lib_opac}) {
1275 $data->{lib} = $data->{lib_opac};
1277 push @results, $data;
1281 # We can't cache for long because of that "selected" thing which
1282 # makes it impossible to clear the cache without iterating through every
1283 # value, which sucks. This'll cover this request, and not a whole lot more.
1284 $cache->set_in_cache( $cache_key, \@results, { deepcopy => 1, expiry => 5 } );
1288 =head2 GetAuthorisedValueCategories
1290 $auth_categories = GetAuthorisedValueCategories();
1292 Return an arrayref of all of the available authorised
1297 sub GetAuthorisedValueCategories {
1298 my $dbh = C4::Context->dbh;
1299 my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1302 while (defined (my $category = $sth->fetchrow_array) ) {
1303 push @results, $category;
1308 =head2 IsAuthorisedValueCategory
1310 $is_auth_val_category = IsAuthorisedValueCategory($category);
1312 Returns whether a given category name is a valid one
1316 sub IsAuthorisedValueCategory {
1317 my $category = shift;
1320 FROM authorised_values
1324 my $sth = C4::Context->dbh->prepare($query);
1325 $sth->execute($category);
1326 $sth->fetchrow ? return 1
1330 =head2 GetAuthorisedValueByCode
1332 $authorised_value = GetAuthorisedValueByCode( $category, $authvalcode, $opac );
1334 Return the lib attribute from authorised_values from the row identified
1335 by the passed category and code
1339 sub GetAuthorisedValueByCode {
1340 my ( $category, $authvalcode, $opac ) = @_;
1342 my $field = $opac ? 'lib_opac' : 'lib';
1343 my $dbh = C4::Context->dbh;
1344 my $sth = $dbh->prepare("SELECT $field FROM authorised_values WHERE category=? AND authorised_value =?");
1345 $sth->execute( $category, $authvalcode );
1346 while ( my $data = $sth->fetchrow_hashref ) {
1347 return $data->{ $field };
1351 =head2 GetKohaAuthorisedValues
1353 Takes $kohafield, $fwcode as parameters.
1355 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1357 Returns hashref of Code => description
1359 Returns undef if no authorised value category is defined for the kohafield.
1363 sub GetKohaAuthorisedValues {
1364 my ($kohafield,$fwcode,$opac) = @_;
1365 $fwcode='' unless $fwcode;
1367 my $dbh = C4::Context->dbh;
1368 my $avcode = GetAuthValCode($kohafield,$fwcode);
1370 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1371 $sth->execute($avcode);
1372 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1373 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1381 =head2 GetKohaAuthorisedValuesFromField
1383 Takes $field, $subfield, $fwcode as parameters.
1385 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1386 $subfield can be undefined
1388 Returns hashref of Code => description
1390 Returns undef if no authorised value category is defined for the given field and subfield
1394 sub GetKohaAuthorisedValuesFromField {
1395 my ($field, $subfield, $fwcode,$opac) = @_;
1396 $fwcode='' unless $fwcode;
1398 my $dbh = C4::Context->dbh;
1399 my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1401 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1402 $sth->execute($avcode);
1403 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1404 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1412 =head2 GetKohaAuthorisedValuesMapping
1414 Takes a hash as a parameter. The interface key indicates the
1415 description to use in the mapping.
1418 "{kohafield},{frameworkcode},{authorised_value}" => "{description}"
1419 for all the kohafields, frameworkcodes, and authorised values.
1421 Returns undef if nothing is found.
1425 sub GetKohaAuthorisedValuesMapping {
1426 my ($parameter) = @_;
1427 my $interface = $parameter->{'interface'} // '';
1429 my $query_mapping = q{
1430 SELECT TA.kohafield,TA.authorised_value AS category,
1431 TA.frameworkcode,TB.authorised_value,
1432 IF(TB.lib_opac>'',TB.lib_opac,TB.lib) AS OPAC,
1433 TB.lib AS Intranet,TB.lib_opac
1434 FROM marc_subfield_structure AS TA JOIN
1435 authorised_values as TB ON
1436 TA.authorised_value=TB.category
1437 WHERE TA.kohafield>'' AND TA.authorised_value>'';
1439 my $dbh = C4::Context->dbh;
1440 my $sth = $dbh->prepare($query_mapping);
1443 if ($interface eq 'opac') {
1444 while (my $row = $sth->fetchrow_hashref) {
1445 $avmapping->{$row->{kohafield}.",".$row->{frameworkcode}.",".$row->{authorised_value}} = $row->{OPAC};
1449 while (my $row = $sth->fetchrow_hashref) {
1450 $avmapping->{$row->{kohafield}.",".$row->{frameworkcode}.",".$row->{authorised_value}} = $row->{Intranet};
1458 my $escaped_string = C4::Koha::xml_escape($string);
1460 Convert &, <, >, ', and " in a string to XML entities
1466 return '' unless defined $str;
1467 $str =~ s/&/&/g;
1470 $str =~ s/'/'/g;
1471 $str =~ s/"/"/g;
1475 =head2 GetKohaAuthorisedValueLib
1477 Takes $category, $authorised_value as parameters.
1479 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1481 Returns authorised value description
1485 sub GetKohaAuthorisedValueLib {
1486 my ($category,$authorised_value,$opac) = @_;
1488 my $dbh = C4::Context->dbh;
1489 my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1490 $sth->execute($category,$authorised_value);
1491 my $data = $sth->fetchrow_hashref;
1492 $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1496 =head2 AddAuthorisedValue
1498 AddAuthorisedValue($category, $authorised_value, $lib, $lib_opac, $imageurl);
1500 Create a new authorised value.
1504 sub AddAuthorisedValue {
1505 my ($category, $authorised_value, $lib, $lib_opac, $imageurl) = @_;
1507 my $dbh = C4::Context->dbh;
1509 INSERT INTO authorised_values (category, authorised_value, lib, lib_opac, imageurl)
1512 my $sth = $dbh->prepare($query);
1513 $sth->execute($category, $authorised_value, $lib, $lib_opac, $imageurl);
1516 =head2 display_marc_indicators
1518 my $display_form = C4::Koha::display_marc_indicators($field);
1520 C<$field> is a MARC::Field object
1522 Generate a display form of the indicators of a variable
1523 MARC field, replacing any blanks with '#'.
1527 sub display_marc_indicators {
1529 my $indicators = '';
1530 if ($field && $field->tag() >= 10) {
1531 $indicators = $field->indicator(1) . $field->indicator(2);
1532 $indicators =~ s/ /#/g;
1537 sub GetNormalizedUPC {
1538 my ($marcrecord,$marcflavour) = @_;
1540 return unless $marcrecord;
1541 if ($marcflavour eq 'UNIMARC') {
1542 my @fields = $marcrecord->field('072');
1543 foreach my $field (@fields) {
1544 my $upc = _normalize_match_point($field->subfield('a'));
1551 else { # assume marc21 if not unimarc
1552 my @fields = $marcrecord->field('024');
1553 foreach my $field (@fields) {
1554 my $indicator = $field->indicator(1);
1555 my $upc = _normalize_match_point($field->subfield('a'));
1556 if ($upc && $indicator == 1 ) {
1563 # Normalizes and returns the first valid ISBN found in the record
1564 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
1565 sub GetNormalizedISBN {
1566 my ($isbn,$marcrecord,$marcflavour) = @_;
1568 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1569 # anything after " | " should be removed, along with the delimiter
1570 ($isbn) = split(/\|/, $isbn );
1571 return _isbn_cleanup($isbn);
1574 return unless $marcrecord;
1576 if ($marcflavour eq 'UNIMARC') {
1577 my @fields = $marcrecord->field('010');
1578 foreach my $field (@fields) {
1579 my $isbn = $field->subfield('a');
1581 return _isbn_cleanup($isbn);
1585 else { # assume marc21 if not unimarc
1586 my @fields = $marcrecord->field('020');
1587 foreach my $field (@fields) {
1588 $isbn = $field->subfield('a');
1590 return _isbn_cleanup($isbn);
1596 sub GetNormalizedEAN {
1597 my ($marcrecord,$marcflavour) = @_;
1599 return unless $marcrecord;
1601 if ($marcflavour eq 'UNIMARC') {
1602 my @fields = $marcrecord->field('073');
1603 foreach my $field (@fields) {
1604 my $ean = _normalize_match_point($field->subfield('a'));
1610 else { # assume marc21 if not unimarc
1611 my @fields = $marcrecord->field('024');
1612 foreach my $field (@fields) {
1613 my $indicator = $field->indicator(1);
1614 my $ean = _normalize_match_point($field->subfield('a'));
1615 if ( $ean && $indicator == 3 ) {
1622 sub GetNormalizedOCLCNumber {
1623 my ($marcrecord,$marcflavour) = @_;
1624 return unless $marcrecord;
1626 if ($marcflavour ne 'UNIMARC' ) {
1627 my @fields = $marcrecord->field('035');
1628 foreach my $field (@fields) {
1629 my $oclc = $field->subfield('a');
1630 if ($oclc =~ /OCoLC/) {
1631 $oclc =~ s/\(OCoLC\)//;
1641 sub GetAuthvalueDropbox {
1642 my ( $authcat, $default ) = @_;
1643 my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1644 my $dbh = C4::Context->dbh;
1648 FROM authorised_values
1651 LEFT JOIN authorised_values_branches ON ( id = av_id )
1656 $query .= " AND ( branchcode = ? OR branchcode IS NULL )" if $branch_limit;
1657 $query .= " GROUP BY lib ORDER BY category, lib, lib_opac";
1658 my $sth = $dbh->prepare($query);
1659 $sth->execute( $authcat, $branch_limit ? $branch_limit : () );
1662 my $option_list = [];
1663 my @authorised_values = ( q{} );
1664 while (my $av = $sth->fetchrow_hashref) {
1665 push @{$option_list}, {
1666 value => $av->{authorised_value},
1667 label => $av->{lib},
1668 default => ($default eq $av->{authorised_value}),
1672 if ( @{$option_list} ) {
1673 return $option_list;
1679 =head2 GetDailyQuote($opts)
1681 Takes a hashref of options
1683 Currently supported options are:
1685 'id' An exact quote id
1686 'random' Select a random quote
1687 noop When no option is passed in, this sub will return the quote timestamped for the current day
1689 The function returns an anonymous hash following this format:
1692 'source' => 'source-of-quote',
1693 'timestamp' => 'timestamp-value',
1694 'text' => 'text-of-quote',
1700 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1701 # at least for default option
1705 my $dbh = C4::Context->dbh;
1710 $query = 'SELECT * FROM quotes WHERE id = ?';
1711 $sth = $dbh->prepare($query);
1712 $sth->execute($opts{'id'});
1713 $quote = $sth->fetchrow_hashref();
1715 elsif ($opts{'random'}) {
1716 # Fall through... we also return a random quote as a catch-all if all else fails
1719 $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1720 $sth = $dbh->prepare($query);
1722 $quote = $sth->fetchrow_hashref();
1724 unless ($quote) { # if there are not matches, choose a random quote
1725 # get a list of all available quote ids
1726 $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1728 my $range = ($sth->fetchrow_array)[0];
1729 # chose a random id within that range if there is more than one quote
1730 my $offset = int(rand($range));
1732 $query = 'SELECT * FROM quotes ORDER BY id LIMIT 1 OFFSET ?';
1733 $sth = C4::Context->dbh->prepare($query);
1734 # see http://www.perlmonks.org/?node_id=837422 for why
1735 # we're being verbose and using bind_param
1736 $sth->bind_param(1, $offset, SQL_INTEGER);
1738 $quote = $sth->fetchrow_hashref();
1739 # update the timestamp for that quote
1740 $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1741 $sth = C4::Context->dbh->prepare($query);
1743 DateTime::Format::MySQL->format_datetime( dt_from_string() ),
1750 sub _normalize_match_point {
1751 my $match_point = shift;
1752 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1753 $normalized_match_point =~ s/-//g;
1755 return $normalized_match_point;
1760 return NormalizeISBN(
1763 format => 'ISBN-10',
1769 =head2 NormalizedISBN
1771 my $isbns = NormalizedISBN({
1773 strip_hyphens => [0,1],
1774 format => ['ISBN-10', 'ISBN-13']
1777 Returns an isbn validated by Business::ISBN.
1778 Optionally strips hyphens and/or forces the isbn
1779 to be of the specified format.
1781 If the string cannot be validated as an isbn,
1789 my $string = $params->{isbn};
1790 my $strip_hyphens = $params->{strip_hyphens};
1791 my $format = $params->{format};
1793 return unless $string;
1795 my $isbn = Business::ISBN->new($string);
1797 if ( $isbn && $isbn->is_valid() ) {
1799 if ( $format eq 'ISBN-10' ) {
1800 $isbn = $isbn->as_isbn10();
1802 elsif ( $format eq 'ISBN-13' ) {
1803 $isbn = $isbn->as_isbn13();
1805 return unless $isbn;
1807 if ($strip_hyphens) {
1808 $string = $isbn->as_string( [] );
1810 $string = $isbn->as_string();
1817 =head2 GetVariationsOfISBN
1819 my @isbns = GetVariationsOfISBN( $isbn );
1821 Returns a list of variations of the given isbn in
1822 both ISBN-10 and ISBN-13 formats, with and without
1825 In a scalar context, the isbns are returned as a
1826 string delimited by ' | '.
1830 sub GetVariationsOfISBN {
1833 return unless $isbn;
1837 push( @isbns, NormalizeISBN({ isbn => $isbn }) );
1838 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10' }) );
1839 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13' }) );
1840 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10', strip_hyphens => 1 }) );
1841 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13', strip_hyphens => 1 }) );
1843 # Strip out any "empty" strings from the array
1844 @isbns = grep { defined($_) && $_ =~ /\S/ } @isbns;
1846 return wantarray ? @isbns : join( " | ", @isbns );
1849 =head2 GetVariationsOfISBNs
1851 my @isbns = GetVariationsOfISBNs( @isbns );
1853 Returns a list of variations of the given isbns in
1854 both ISBN-10 and ISBN-13 formats, with and without
1857 In a scalar context, the isbns are returned as a
1858 string delimited by ' | '.
1862 sub GetVariationsOfISBNs {
1865 @isbns = map { GetVariationsOfISBN( $_ ) } @isbns;
1867 return wantarray ? @isbns : join( " | ", @isbns );
1870 =head2 IsKohaFieldLinked
1872 my $is_linked = IsKohaFieldLinked({
1873 kohafield => $kohafield,
1874 frameworkcode => $frameworkcode,
1877 Return 1 if the field is linked
1881 sub IsKohaFieldLinked {
1882 my ( $params ) = @_;
1883 my $kohafield = $params->{kohafield};
1884 my $frameworkcode = $params->{frameworkcode} || '';
1885 my $dbh = C4::Context->dbh;
1886 my $is_linked = $dbh->selectcol_arrayref( q|
1888 FROM marc_subfield_structure
1889 WHERE frameworkcode = ?
1891 |,{}, $frameworkcode, $kohafield );
1892 return $is_linked->[0];