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; # Can be removed?
29 use Koha::DateUtils qw(dt_from_string);
31 use DateTime::Format::MySQL;
33 use autouse 'Data::cselectall_arrayref' => qw(Dumper);
34 use DBI qw(:sql_types);
35 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $DEBUG);
38 $VERSION = 3.07.00.049;
42 &subfield_is_koha_internal_p
43 &GetPrinters &GetPrinter
44 &GetItemTypes &getitemtypeinfo
45 &GetItemTypesCategorized &GetItemTypesByCategory
46 &GetSupportName &GetSupportList
47 &getframeworks &getframeworkinfo
53 &get_notforloan_label_of
56 &getitemtypeimagelocation
58 &GetAuthorisedValueCategories
59 &IsAuthorisedValueCategory
60 &GetKohaAuthorisedValues
61 &GetKohaAuthorisedValuesFromField
62 &GetKohaAuthorisedValuesMapping
63 &GetKohaAuthorisedValueLib
64 &GetAuthorisedValueByCode
69 &GetNormalizedOCLCNumber
79 @EXPORT_OK = qw( GetDailyQuote );
84 C4::Koha - Perl Module containing convenience functions for Koha scripts
92 Koha.pm provides many functions for Koha scripts.
98 # FIXME.. this should be moved to a MARC-specific module
99 sub subfield_is_koha_internal_p {
102 # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
103 # But real MARC subfields are always single-character
104 # so it really is safer just to check the length
106 return length $subfield != 1;
109 =head2 GetSupportName
111 $itemtypename = &GetSupportName($codestring);
113 Returns a string with the name of the itemtype.
119 return if (! $codestring);
121 my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
122 if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
129 my $sth = C4::Context->dbh->prepare($query);
130 $sth->execute($codestring);
131 ($resultstring)=$sth->fetchrow;
132 return $resultstring;
135 C4::Context->dbh->prepare(
136 "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
138 $sth->execute( $advanced_search_types, $codestring );
139 my $data = $sth->fetchrow_hashref;
140 return $$data{'lib'};
144 =head2 GetSupportList
146 $itemtypes = &GetSupportList();
148 Returns an array ref containing informations about Support (since itemtype is rather a circulation code when item-level-itypes is used).
150 build a HTML select with the following code :
152 =head3 in PERL SCRIPT
154 my $itemtypes = GetSupportList();
155 $template->param(itemtypeloop => $itemtypes);
159 <select name="itemtype" id="itemtype">
160 <option value=""></option>
161 [% FOREACH itemtypeloo IN itemtypeloop %]
162 [% IF ( itemtypeloo.selected ) %]
163 <option value="[% itemtypeloo.itemtype %]" selected="selected">[% itemtypeloo.description %]</option>
165 <option value="[% itemtypeloo.itemtype %]">[% itemtypeloo.description %]</option>
173 my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
174 if (!$advanced_search_types or $advanced_search_types =~ /itemtypes/) {
175 return GetItemTypes( style => 'array' );
177 my $advsearchtypes = GetAuthorisedValues($advanced_search_types);
178 my @results= map {{itemtype=>$$_{authorised_value},description=>$$_{lib},imageurl=>$$_{imageurl}}} @$advsearchtypes;
184 $itemtypes = &GetItemTypes( style => $style );
186 Returns information about existing itemtypes.
189 style: either 'array' or 'hash', defaults to 'hash'.
190 'array' returns an arrayref,
191 'hash' return a hashref with the itemtype value as the key
193 build a HTML select with the following code :
195 =head3 in PERL SCRIPT
197 my $itemtypes = GetItemTypes;
199 foreach my $thisitemtype (sort keys %$itemtypes) {
200 my $selected = 1 if $thisitemtype eq $itemtype;
201 my %row =(value => $thisitemtype,
202 selected => $selected,
203 description => $itemtypes->{$thisitemtype}->{'description'},
205 push @itemtypesloop, \%row;
207 $template->param(itemtypeloop => \@itemtypesloop);
211 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
212 <select name="itemtype">
213 <option value="">Default</option>
214 <!-- TMPL_LOOP name="itemtypeloop" -->
215 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
218 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
219 <input type="submit" value="OK" class="button">
226 my $style = defined( $params{'style'} ) ? $params{'style'} : 'hash';
228 require C4::Languages;
229 my $language = C4::Languages::getlanguage();
230 # returns a reference to a hash of references to itemtypes...
231 my $dbh = C4::Context->dbh;
235 itemtypes.description,
236 itemtypes.rentalcharge,
237 itemtypes.notforloan,
240 itemtypes.checkinmsg,
241 itemtypes.checkinmsgtype,
242 itemtypes.sip_media_type,
243 itemtypes.hideinopac,
244 itemtypes.searchcategory,
245 COALESCE( localization.translation, itemtypes.description ) AS translated_description
247 LEFT JOIN localization ON itemtypes.itemtype = localization.code
248 AND localization.entity = 'itemtypes'
249 AND localization.lang = ?
252 my $sth = $dbh->prepare($query);
253 $sth->execute( $language );
255 if ( $style eq 'hash' ) {
257 while ( my $IT = $sth->fetchrow_hashref ) {
258 $itemtypes{ $IT->{'itemtype'} } = $IT;
260 return ( \%itemtypes );
262 return [ sort { lc $a->{translated_description} cmp lc $b->{translated_description} } @{ $sth->fetchall_arrayref( {} ) } ];
266 =head2 GetItemTypesCategorized
268 $categories = GetItemTypesCategorized();
270 Returns a hashref containing search categories.
271 A search category will be put in the hash if at least one of its itemtypes is visible in OPAC.
272 The categories must be part of Authorized Values (ITEMTYPECAT)
276 sub GetItemTypesCategorized {
277 my $dbh = C4::Context->dbh;
278 # Order is important, so that partially hidden (some items are not visible in OPAC) search
279 # categories will be visible. hideinopac=0 must be last.
281 SELECT itemtype, description, imageurl, hideinopac, 0 as 'iscat' FROM itemtypes WHERE ISNULL(searchcategory) or length(searchcategory) = 0
283 SELECT DISTINCT searchcategory AS `itemtype`,
284 authorised_values.lib_opac AS description,
285 authorised_values.imageurl AS imageurl,
286 hideinopac, 1 as 'iscat'
288 LEFT JOIN authorised_values ON searchcategory = authorised_value
289 WHERE searchcategory > '' and hideinopac=1
291 SELECT DISTINCT searchcategory AS `itemtype`,
292 authorised_values.lib_opac AS description,
293 authorised_values.imageurl AS imageurl,
294 hideinopac, 1 as 'iscat'
296 LEFT JOIN authorised_values ON searchcategory = authorised_value
297 WHERE searchcategory > '' and hideinopac=0
299 return ($dbh->selectall_hashref($query,'itemtype'));
302 =head2 GetItemTypesByCategory
304 @results = GetItemTypesByCategory( $searchcategory );
306 Returns the itemtype code of all itemtypes included in a searchcategory.
310 sub GetItemTypesByCategory {
314 my $dbh = C4::Context->dbh;
315 my $query = qq|SELECT itemtype FROM itemtypes WHERE searchcategory=?|;
316 my $tmp=$dbh->selectcol_arrayref($query,undef,$category);
322 $frameworks = &getframework();
324 Returns information about existing frameworks
326 build a HTML select with the following code :
328 =head3 in PERL SCRIPT
330 my $frameworks = getframeworks();
332 foreach my $thisframework (keys %$frameworks) {
333 my $selected = 1 if $thisframework eq $frameworkcode;
335 value => $thisframework,
336 selected => $selected,
337 description => $frameworks->{$thisframework}->{'frameworktext'},
339 push @frameworksloop, \%row;
341 $template->param(frameworkloop => \@frameworksloop);
345 <form action="[% script_name %] method=post>
346 <select name="frameworkcode">
347 <option value="">Default</option>
348 [% FOREACH framework IN frameworkloop %]
349 [% IF ( framework.selected ) %]
350 <option value="[% framework.value %]" selected="selected">[% framework.description %]</option>
352 <option value="[% framework.value %]">[% framework.description %]</option>
356 <input type=text name=searchfield value="[% searchfield %]">
357 <input type="submit" value="OK" class="button">
364 # returns a reference to a hash of references to branches...
366 my $dbh = C4::Context->dbh;
367 my $sth = $dbh->prepare("select * from biblio_framework");
369 while ( my $IT = $sth->fetchrow_hashref ) {
370 $itemtypes{ $IT->{'frameworkcode'} } = $IT;
372 return ( \%itemtypes );
375 =head2 GetFrameworksLoop
377 $frameworks = GetFrameworksLoop( $frameworkcode );
379 Returns the loop suggested on getframework(), but ordered by framework description.
381 build a HTML select with the following code :
383 =head3 in PERL SCRIPT
385 $template->param( frameworkloop => GetFrameworksLoop( $frameworkcode ) );
389 Same as getframework()
391 <form action="[% script_name %] method=post>
392 <select name="frameworkcode">
393 <option value="">Default</option>
394 [% FOREACH framework IN frameworkloop %]
395 [% IF ( framework.selected ) %]
396 <option value="[% framework.value %]" selected="selected">[% framework.description %]</option>
398 <option value="[% framework.value %]">[% framework.description %]</option>
402 <input type=text name=searchfield value="[% searchfield %]">
403 <input type="submit" value="OK" class="button">
408 sub GetFrameworksLoop {
409 my $frameworkcode = shift;
410 my $frameworks = getframeworks();
412 foreach my $thisframework (sort { uc($frameworks->{$a}->{'frameworktext'}) cmp uc($frameworks->{$b}->{'frameworktext'}) } keys %$frameworks) {
413 my $selected = ( $thisframework eq $frameworkcode ) ? 1 : undef;
415 value => $thisframework,
416 selected => $selected,
417 description => $frameworks->{$thisframework}->{'frameworktext'},
419 push @frameworkloop, \%row;
421 return \@frameworkloop;
424 =head2 getframeworkinfo
426 $frameworkinfo = &getframeworkinfo($frameworkcode);
428 Returns information about an frameworkcode.
432 sub getframeworkinfo {
433 my ($frameworkcode) = @_;
434 my $dbh = C4::Context->dbh;
436 $dbh->prepare("select * from biblio_framework where frameworkcode=?");
437 $sth->execute($frameworkcode);
438 my $res = $sth->fetchrow_hashref;
442 =head2 getitemtypeinfo
444 $itemtype = &getitemtypeinfo($itemtype, [$interface]);
446 Returns information about an itemtype. The optional $interface argument
447 sets which interface ('opac' or 'intranet') to return the imageurl for.
448 Defaults to intranet.
452 sub getitemtypeinfo {
453 my ($itemtype, $interface) = @_;
454 my $dbh = C4::Context->dbh;
455 require C4::Languages;
456 my $language = C4::Languages::getlanguage();
457 my $it = $dbh->selectrow_hashref(q|
460 itemtypes.description,
461 itemtypes.rentalcharge,
462 itemtypes.notforloan,
465 itemtypes.checkinmsg,
466 itemtypes.checkinmsgtype,
467 itemtypes.sip_media_type,
468 COALESCE( localization.translation, itemtypes.description ) AS translated_description
470 LEFT JOIN localization ON itemtypes.itemtype = localization.code
471 AND localization.entity = 'itemtypes'
472 AND localization.lang = ?
473 WHERE itemtypes.itemtype = ?
474 |, undef, $language, $itemtype );
476 $it->{imageurl} = getitemtypeimagelocation( ( ( defined $interface && $interface eq 'opac' ) ? 'opac' : 'intranet' ), $it->{imageurl} );
481 =head2 getitemtypeimagedir
483 my $directory = getitemtypeimagedir( 'opac' );
485 pass in 'opac' or 'intranet'. Defaults to 'opac'.
487 returns the full path to the appropriate directory containing images.
491 sub getitemtypeimagedir {
492 my $src = shift || 'opac';
493 if ($src eq 'intranet') {
494 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
496 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
500 sub getitemtypeimagesrc {
501 my $src = shift || 'opac';
502 if ($src eq 'intranet') {
503 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
505 return '/opac-tmpl' . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
509 sub getitemtypeimagelocation {
510 my ( $src, $image ) = @_;
512 return '' if ( !$image );
515 my $scheme = ( URI::Split::uri_split( $image ) )[0];
517 return $image if ( $scheme );
519 return getitemtypeimagesrc( $src ) . '/' . $image;
522 =head3 _getImagesFromDirectory
524 Find all of the image files in a directory in the filesystem
526 parameters: a directory name
528 returns: a list of images in that directory.
530 Notes: this does not traverse into subdirectories. See
531 _getSubdirectoryNames for help with that.
532 Images are assumed to be files with .gif or .png file extensions.
533 The image names returned do not have the directory name on them.
537 sub _getImagesFromDirectory {
538 my $directoryname = shift;
539 return unless defined $directoryname;
540 return unless -d $directoryname;
542 if ( opendir ( my $dh, $directoryname ) ) {
543 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
545 @images = sort(@images);
548 warn "unable to opendir $directoryname: $!";
553 =head3 _getSubdirectoryNames
555 Find all of the directories in a directory in the filesystem
557 parameters: a directory name
559 returns: a list of subdirectories in that directory.
561 Notes: this does not traverse into subdirectories. Only the first
562 level of subdirectories are returned.
563 The directory names returned don't have the parent directory name on them.
567 sub _getSubdirectoryNames {
568 my $directoryname = shift;
569 return unless defined $directoryname;
570 return unless -d $directoryname;
572 if ( opendir ( my $dh, $directoryname ) ) {
573 my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
577 warn "unable to opendir $directoryname: $!";
584 returns: a listref of hashrefs. Each hash represents another collection of images.
586 { imagesetname => 'npl', # the name of the image set (npl is the original one)
587 images => listref of image hashrefs
590 each image is represented by a hashref like this:
592 { KohaImage => 'npl/image.gif',
593 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
594 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
595 checked => 0 or 1: was this the image passed to this method?
596 Note: I'd like to remove this somehow.
603 my $checked = $params{'checked'} || '';
605 my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
606 url => getitemtypeimagesrc('intranet'),
608 opac => { filesystem => getitemtypeimagedir('opac'),
609 url => getitemtypeimagesrc('opac'),
613 my @imagesets = (); # list of hasrefs of image set data to pass to template
614 my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
615 foreach my $imagesubdir ( @subdirectories ) {
616 warn $imagesubdir if $DEBUG;
617 my @imagelist = (); # hashrefs of image info
618 my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
619 my $imagesetactive = 0;
620 foreach my $thisimage ( @imagenames ) {
622 { KohaImage => "$imagesubdir/$thisimage",
623 StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
624 OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
625 checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
628 $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
630 push @imagesets, { imagesetname => $imagesubdir,
631 imagesetactive => $imagesetactive,
632 images => \@imagelist };
640 $printers = &GetPrinters();
641 @queues = keys %$printers;
643 Returns information about existing printer queues.
645 C<$printers> is a reference-to-hash whose keys are the print queues
646 defined in the printers table of the Koha database. The values are
647 references-to-hash, whose keys are the fields in the printers table.
653 my $dbh = C4::Context->dbh;
654 my $sth = $dbh->prepare("select * from printers");
656 while ( my $printer = $sth->fetchrow_hashref ) {
657 $printers{ $printer->{'printqueue'} } = $printer;
659 return ( \%printers );
664 $printer = GetPrinter( $query, $printers );
669 my ( $query, $printers ) = @_; # get printer for this query from printers
670 my $printer = $query->param('printer');
671 my %cookie = $query->cookie('userenv');
672 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
673 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
679 Returns the number of pages to display in a pagination bar, given the number
680 of items and the number of items per page.
685 my ( $nb_items, $nb_items_per_page ) = @_;
687 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
692 (@themes) = &getallthemes('opac');
693 (@themes) = &getallthemes('intranet');
695 Returns an array of all available themes.
703 if ( $type eq 'intranet' ) {
704 $htdocs = C4::Context->config('intrahtdocs');
707 $htdocs = C4::Context->config('opachtdocs');
709 opendir D, "$htdocs";
710 my @dirlist = readdir D;
711 foreach my $directory (@dirlist) {
712 next if $directory eq 'lib';
713 -d "$htdocs/$directory/en" and push @themes, $directory;
720 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
725 tags => [ qw/ 600ab 601ab 602a 604at 605a 606ax 610a / ],
731 tags => [ qw/ 607a / ],
737 tags => [ qw/ 500a 501a 503a / ],
743 tags => [ qw/ 700ab 701ab 702ab / ],
744 sep => C4::Context->preference("UNIMARCAuthorsFacetsSeparator"),
749 tags => [ qw/ 225a / ],
755 tags => [ qw/ 995e / ],
759 unless ( Koha::Libraries->search->count == 1 )
761 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
762 if ( $DisplayLibraryFacets eq 'both'
763 || $DisplayLibraryFacets eq 'holding' )
768 idx => 'holdingbranch',
769 label => 'HoldingLibrary',
770 tags => [qw / 995c /],
775 if ( $DisplayLibraryFacets eq 'both'
776 || $DisplayLibraryFacets eq 'home' )
782 label => 'HomeLibrary',
783 tags => [qw / 995b /],
794 tags => [ qw/ 650a / ],
799 # label => 'People and Organizations',
800 # tags => [ qw/ 600a 610a 611a / ],
806 tags => [ qw/ 651a / ],
812 tags => [ qw/ 630a / ],
818 tags => [ qw/ 100a 110a 700a / ],
824 tags => [ qw/ 440a 490a / ],
829 label => 'ItemTypes',
830 tags => [ qw/ 952y 942c / ],
836 tags => [ qw / 952c / ],
840 unless ( Koha::Libraries->search->count == 1 )
842 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
843 if ( $DisplayLibraryFacets eq 'both'
844 || $DisplayLibraryFacets eq 'holding' )
849 idx => 'holdingbranch',
850 label => 'HoldingLibrary',
851 tags => [qw / 952b /],
856 if ( $DisplayLibraryFacets eq 'both'
857 || $DisplayLibraryFacets eq 'home' )
863 label => 'HomeLibrary',
864 tags => [qw / 952a /],
875 Return a href where a key is associated to a href. You give a query,
876 the name of the key among the fields returned by the query. If you
877 also give as third argument the name of the value, the function
878 returns a href of scalar. The optional 4th argument is an arrayref of
879 items passed to the C<execute()> call. It is designed to bind
880 parameters to any placeholders in your SQL.
889 # generic href of any information on the item, href of href.
890 my $iteminfos_of = get_infos_of($query, 'itemnumber');
891 print $iteminfos_of->{$itemnumber}{barcode};
893 # specific information, href of scalar
894 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
895 print $barcode_of_item->{$itemnumber};
900 my ( $query, $key_name, $value_name, $bind_params ) = @_;
902 my $dbh = C4::Context->dbh;
904 my $sth = $dbh->prepare($query);
905 $sth->execute( @$bind_params );
908 while ( my $row = $sth->fetchrow_hashref ) {
909 if ( defined $value_name ) {
910 $infos_of{ $row->{$key_name} } = $row->{$value_name};
913 $infos_of{ $row->{$key_name} } = $row;
921 =head2 get_notforloan_label_of
923 my $notforloan_label_of = get_notforloan_label_of();
925 Each authorised value of notforloan (information available in items and
926 itemtypes) is link to a single label.
928 Returns a href where keys are authorised values and values are corresponding
931 foreach my $authorised_value (keys %{$notforloan_label_of}) {
933 "authorised_value: %s => %s\n",
935 $notforloan_label_of->{$authorised_value}
941 # FIXME - why not use GetAuthorisedValues ??
943 sub get_notforloan_label_of {
944 my $dbh = C4::Context->dbh;
947 SELECT authorised_value
948 FROM marc_subfield_structure
949 WHERE kohafield = \'items.notforloan\'
952 my $sth = $dbh->prepare($query);
954 my ($statuscode) = $sth->fetchrow_array();
959 FROM authorised_values
962 $sth = $dbh->prepare($query);
963 $sth->execute($statuscode);
964 my %notforloan_label_of;
965 while ( my $row = $sth->fetchrow_hashref ) {
966 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
970 return \%notforloan_label_of;
973 =head2 GetAuthValCode
975 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
980 my ($kohafield,$fwcode) = @_;
981 my $dbh = C4::Context->dbh;
982 $fwcode='' unless $fwcode;
983 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
984 $sth->execute($kohafield,$fwcode);
985 my ($authvalcode) = $sth->fetchrow_array;
989 =head2 GetAuthValCodeFromField
991 $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
993 C<$subfield> can be undefined
997 sub GetAuthValCodeFromField {
998 my ($field,$subfield,$fwcode) = @_;
999 my $dbh = C4::Context->dbh;
1000 $fwcode='' unless $fwcode;
1002 if (defined $subfield) {
1003 $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
1004 $sth->execute($field,$subfield,$fwcode);
1006 $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
1007 $sth->execute($field,$fwcode);
1009 my ($authvalcode) = $sth->fetchrow_array;
1010 return $authvalcode;
1013 =head2 GetAuthorisedValues
1015 $authvalues = GetAuthorisedValues([$category], [$selected]);
1017 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
1019 C<$category> returns authorised values for just one category (optional).
1021 C<$selected> adds a "selected => 1" entry to the hash if the
1022 authorised_value matches it. B<NOTE:> this feature should be considered
1023 deprecated as it may be removed in the future.
1025 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1029 sub GetAuthorisedValues {
1030 my ( $category, $selected, $opac ) = @_;
1032 # TODO: the "selected" feature should be replaced by a utility function
1033 # somewhere else, it doesn't belong in here. For starters it makes
1034 # caching much more complicated. Or just let the UI logic handle it, it's
1037 # Is this cached already?
1038 $opac = $opac ? 1 : 0; # normalise to be safe
1040 C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1041 my $selected_key = defined($selected) ? $selected : '';
1043 "AuthorisedValues-$category-$selected_key-$opac-$branch_limit";
1044 my $cache = Koha::Cache->get_instance();
1045 my $result = $cache->get_from_cache($cache_key);
1046 return $result if $result;
1049 my $dbh = C4::Context->dbh;
1052 FROM authorised_values
1055 LEFT JOIN authorised_values_branches ON ( id = av_id )
1060 push @where_strings, "category = ?";
1061 push @where_args, $category;
1064 push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
1065 push @where_args, $branch_limit;
1067 if(@where_strings > 0) {
1068 $query .= " WHERE " . join(" AND ", @where_strings);
1070 $query .= " GROUP BY lib";
1071 $query .= ' ORDER BY category, ' . (
1072 $opac ? 'COALESCE(lib_opac, lib)'
1076 my $sth = $dbh->prepare($query);
1078 $sth->execute( @where_args );
1079 while (my $data=$sth->fetchrow_hashref) {
1080 if ( defined $selected and $selected eq $data->{authorised_value} ) {
1081 $data->{selected} = 1;
1084 $data->{selected} = 0;
1087 if ($opac && $data->{lib_opac}) {
1088 $data->{lib} = $data->{lib_opac};
1090 push @results, $data;
1094 # We can't cache for long because of that "selected" thing which
1095 # makes it impossible to clear the cache without iterating through every
1096 # value, which sucks. This'll cover this request, and not a whole lot more.
1097 $cache->set_in_cache( $cache_key, \@results, { deepcopy => 1, expiry => 5 } );
1101 =head2 GetAuthorisedValueCategories
1103 $auth_categories = GetAuthorisedValueCategories();
1105 Return an arrayref of all of the available authorised
1110 sub GetAuthorisedValueCategories {
1111 my $dbh = C4::Context->dbh;
1112 my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1115 while (defined (my $category = $sth->fetchrow_array) ) {
1116 push @results, $category;
1121 =head2 IsAuthorisedValueCategory
1123 $is_auth_val_category = IsAuthorisedValueCategory($category);
1125 Returns whether a given category name is a valid one
1129 sub IsAuthorisedValueCategory {
1130 my $category = shift;
1133 FROM authorised_values
1137 my $sth = C4::Context->dbh->prepare($query);
1138 $sth->execute($category);
1139 $sth->fetchrow ? return 1
1143 =head2 GetAuthorisedValueByCode
1145 $authorised_value = GetAuthorisedValueByCode( $category, $authvalcode, $opac );
1147 Return the lib attribute from authorised_values from the row identified
1148 by the passed category and code
1152 sub GetAuthorisedValueByCode {
1153 my ( $category, $authvalcode, $opac ) = @_;
1155 my $field = $opac ? 'lib_opac' : 'lib';
1156 my $dbh = C4::Context->dbh;
1157 my $sth = $dbh->prepare("SELECT $field FROM authorised_values WHERE category=? AND authorised_value =?");
1158 $sth->execute( $category, $authvalcode );
1159 while ( my $data = $sth->fetchrow_hashref ) {
1160 return $data->{ $field };
1164 =head2 GetKohaAuthorisedValues
1166 Takes $kohafield, $fwcode as parameters.
1168 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1170 Returns hashref of Code => description
1172 Returns undef if no authorised value category is defined for the kohafield.
1176 sub GetKohaAuthorisedValues {
1177 my ($kohafield,$fwcode,$opac) = @_;
1178 $fwcode='' unless $fwcode;
1180 my $dbh = C4::Context->dbh;
1181 my $avcode = GetAuthValCode($kohafield,$fwcode);
1183 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1184 $sth->execute($avcode);
1185 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1186 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1194 =head2 GetKohaAuthorisedValuesFromField
1196 Takes $field, $subfield, $fwcode as parameters.
1198 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1199 $subfield can be undefined
1201 Returns hashref of Code => description
1203 Returns undef if no authorised value category is defined for the given field and subfield
1207 sub GetKohaAuthorisedValuesFromField {
1208 my ($field, $subfield, $fwcode,$opac) = @_;
1209 $fwcode='' unless $fwcode;
1211 my $dbh = C4::Context->dbh;
1212 my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1214 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1215 $sth->execute($avcode);
1216 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1217 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1225 =head2 GetKohaAuthorisedValuesMapping
1227 Takes a hash as a parameter. The interface key indicates the
1228 description to use in the mapping.
1231 "{kohafield},{frameworkcode},{authorised_value}" => "{description}"
1232 for all the kohafields, frameworkcodes, and authorised values.
1234 Returns undef if nothing is found.
1238 sub GetKohaAuthorisedValuesMapping {
1239 my ($parameter) = @_;
1240 my $interface = $parameter->{'interface'} // '';
1242 my $query_mapping = q{
1243 SELECT TA.kohafield,TA.authorised_value AS category,
1244 TA.frameworkcode,TB.authorised_value,
1245 IF(TB.lib_opac>'',TB.lib_opac,TB.lib) AS OPAC,
1246 TB.lib AS Intranet,TB.lib_opac
1247 FROM marc_subfield_structure AS TA JOIN
1248 authorised_values as TB ON
1249 TA.authorised_value=TB.category
1250 WHERE TA.kohafield>'' AND TA.authorised_value>'';
1252 my $dbh = C4::Context->dbh;
1253 my $sth = $dbh->prepare($query_mapping);
1256 if ($interface eq 'opac') {
1257 while (my $row = $sth->fetchrow_hashref) {
1258 $avmapping->{$row->{kohafield}.",".$row->{frameworkcode}.",".$row->{authorised_value}} = $row->{OPAC};
1262 while (my $row = $sth->fetchrow_hashref) {
1263 $avmapping->{$row->{kohafield}.",".$row->{frameworkcode}.",".$row->{authorised_value}} = $row->{Intranet};
1271 my $escaped_string = C4::Koha::xml_escape($string);
1273 Convert &, <, >, ', and " in a string to XML entities
1279 return '' unless defined $str;
1280 $str =~ s/&/&/g;
1283 $str =~ s/'/'/g;
1284 $str =~ s/"/"/g;
1288 =head2 GetKohaAuthorisedValueLib
1290 Takes $category, $authorised_value as parameters.
1292 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1294 Returns authorised value description
1298 sub GetKohaAuthorisedValueLib {
1299 my ($category,$authorised_value,$opac) = @_;
1301 my $dbh = C4::Context->dbh;
1302 my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1303 $sth->execute($category,$authorised_value);
1304 my $data = $sth->fetchrow_hashref;
1305 $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1309 =head2 display_marc_indicators
1311 my $display_form = C4::Koha::display_marc_indicators($field);
1313 C<$field> is a MARC::Field object
1315 Generate a display form of the indicators of a variable
1316 MARC field, replacing any blanks with '#'.
1320 sub display_marc_indicators {
1322 my $indicators = '';
1323 if ($field && $field->tag() >= 10) {
1324 $indicators = $field->indicator(1) . $field->indicator(2);
1325 $indicators =~ s/ /#/g;
1330 sub GetNormalizedUPC {
1331 my ($marcrecord,$marcflavour) = @_;
1333 return unless $marcrecord;
1334 if ($marcflavour eq 'UNIMARC') {
1335 my @fields = $marcrecord->field('072');
1336 foreach my $field (@fields) {
1337 my $upc = _normalize_match_point($field->subfield('a'));
1344 else { # assume marc21 if not unimarc
1345 my @fields = $marcrecord->field('024');
1346 foreach my $field (@fields) {
1347 my $indicator = $field->indicator(1);
1348 my $upc = _normalize_match_point($field->subfield('a'));
1349 if ($upc && $indicator == 1 ) {
1356 # Normalizes and returns the first valid ISBN found in the record
1357 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
1358 sub GetNormalizedISBN {
1359 my ($isbn,$marcrecord,$marcflavour) = @_;
1361 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1362 # anything after " | " should be removed, along with the delimiter
1363 ($isbn) = split(/\|/, $isbn );
1364 return _isbn_cleanup($isbn);
1367 return unless $marcrecord;
1369 if ($marcflavour eq 'UNIMARC') {
1370 my @fields = $marcrecord->field('010');
1371 foreach my $field (@fields) {
1372 my $isbn = $field->subfield('a');
1374 return _isbn_cleanup($isbn);
1378 else { # assume marc21 if not unimarc
1379 my @fields = $marcrecord->field('020');
1380 foreach my $field (@fields) {
1381 $isbn = $field->subfield('a');
1383 return _isbn_cleanup($isbn);
1389 sub GetNormalizedEAN {
1390 my ($marcrecord,$marcflavour) = @_;
1392 return unless $marcrecord;
1394 if ($marcflavour eq 'UNIMARC') {
1395 my @fields = $marcrecord->field('073');
1396 foreach my $field (@fields) {
1397 my $ean = _normalize_match_point($field->subfield('a'));
1403 else { # assume marc21 if not unimarc
1404 my @fields = $marcrecord->field('024');
1405 foreach my $field (@fields) {
1406 my $indicator = $field->indicator(1);
1407 my $ean = _normalize_match_point($field->subfield('a'));
1408 if ( $ean && $indicator == 3 ) {
1415 sub GetNormalizedOCLCNumber {
1416 my ($marcrecord,$marcflavour) = @_;
1417 return unless $marcrecord;
1419 if ($marcflavour ne 'UNIMARC' ) {
1420 my @fields = $marcrecord->field('035');
1421 foreach my $field (@fields) {
1422 my $oclc = $field->subfield('a');
1423 if ($oclc =~ /OCoLC/) {
1424 $oclc =~ s/\(OCoLC\)//;
1434 sub GetAuthvalueDropbox {
1435 my ( $authcat, $default ) = @_;
1436 my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1437 my $dbh = C4::Context->dbh;
1441 FROM authorised_values
1444 LEFT JOIN authorised_values_branches ON ( id = av_id )
1449 $query .= " AND ( branchcode = ? OR branchcode IS NULL )" if $branch_limit;
1450 $query .= " GROUP BY lib ORDER BY category, lib, lib_opac";
1451 my $sth = $dbh->prepare($query);
1452 $sth->execute( $authcat, $branch_limit ? $branch_limit : () );
1455 my $option_list = [];
1456 my @authorised_values = ( q{} );
1457 while (my $av = $sth->fetchrow_hashref) {
1458 push @{$option_list}, {
1459 value => $av->{authorised_value},
1460 label => $av->{lib},
1461 default => ($default eq $av->{authorised_value}),
1465 if ( @{$option_list} ) {
1466 return $option_list;
1472 =head2 GetDailyQuote($opts)
1474 Takes a hashref of options
1476 Currently supported options are:
1478 'id' An exact quote id
1479 'random' Select a random quote
1480 noop When no option is passed in, this sub will return the quote timestamped for the current day
1482 The function returns an anonymous hash following this format:
1485 'source' => 'source-of-quote',
1486 'timestamp' => 'timestamp-value',
1487 'text' => 'text-of-quote',
1493 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1494 # at least for default option
1498 my $dbh = C4::Context->dbh;
1503 $query = 'SELECT * FROM quotes WHERE id = ?';
1504 $sth = $dbh->prepare($query);
1505 $sth->execute($opts{'id'});
1506 $quote = $sth->fetchrow_hashref();
1508 elsif ($opts{'random'}) {
1509 # Fall through... we also return a random quote as a catch-all if all else fails
1512 $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1513 $sth = $dbh->prepare($query);
1515 $quote = $sth->fetchrow_hashref();
1517 unless ($quote) { # if there are not matches, choose a random quote
1518 # get a list of all available quote ids
1519 $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1521 my $range = ($sth->fetchrow_array)[0];
1522 # chose a random id within that range if there is more than one quote
1523 my $offset = int(rand($range));
1525 $query = 'SELECT * FROM quotes ORDER BY id LIMIT 1 OFFSET ?';
1526 $sth = C4::Context->dbh->prepare($query);
1527 # see http://www.perlmonks.org/?node_id=837422 for why
1528 # we're being verbose and using bind_param
1529 $sth->bind_param(1, $offset, SQL_INTEGER);
1531 $quote = $sth->fetchrow_hashref();
1532 # update the timestamp for that quote
1533 $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1534 $sth = C4::Context->dbh->prepare($query);
1536 DateTime::Format::MySQL->format_datetime( dt_from_string() ),
1543 sub _normalize_match_point {
1544 my $match_point = shift;
1545 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1546 $normalized_match_point =~ s/-//g;
1548 return $normalized_match_point;
1553 return NormalizeISBN(
1556 format => 'ISBN-10',
1562 =head2 NormalizedISBN
1564 my $isbns = NormalizedISBN({
1566 strip_hyphens => [0,1],
1567 format => ['ISBN-10', 'ISBN-13']
1570 Returns an isbn validated by Business::ISBN.
1571 Optionally strips hyphens and/or forces the isbn
1572 to be of the specified format.
1574 If the string cannot be validated as an isbn,
1582 my $string = $params->{isbn};
1583 my $strip_hyphens = $params->{strip_hyphens};
1584 my $format = $params->{format};
1586 return unless $string;
1588 my $isbn = Business::ISBN->new($string);
1590 if ( $isbn && $isbn->is_valid() ) {
1592 if ( $format eq 'ISBN-10' ) {
1593 $isbn = $isbn->as_isbn10();
1595 elsif ( $format eq 'ISBN-13' ) {
1596 $isbn = $isbn->as_isbn13();
1598 return unless $isbn;
1600 if ($strip_hyphens) {
1601 $string = $isbn->as_string( [] );
1603 $string = $isbn->as_string();
1610 =head2 GetVariationsOfISBN
1612 my @isbns = GetVariationsOfISBN( $isbn );
1614 Returns a list of variations of the given isbn in
1615 both ISBN-10 and ISBN-13 formats, with and without
1618 In a scalar context, the isbns are returned as a
1619 string delimited by ' | '.
1623 sub GetVariationsOfISBN {
1626 return unless $isbn;
1630 push( @isbns, NormalizeISBN({ isbn => $isbn }) );
1631 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10' }) );
1632 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13' }) );
1633 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10', strip_hyphens => 1 }) );
1634 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13', strip_hyphens => 1 }) );
1636 # Strip out any "empty" strings from the array
1637 @isbns = grep { defined($_) && $_ =~ /\S/ } @isbns;
1639 return wantarray ? @isbns : join( " | ", @isbns );
1642 =head2 GetVariationsOfISBNs
1644 my @isbns = GetVariationsOfISBNs( @isbns );
1646 Returns a list of variations of the given isbns in
1647 both ISBN-10 and ISBN-13 formats, with and without
1650 In a scalar context, the isbns are returned as a
1651 string delimited by ' | '.
1655 sub GetVariationsOfISBNs {
1658 @isbns = map { GetVariationsOfISBN( $_ ) } @isbns;
1660 return wantarray ? @isbns : join( " | ", @isbns );
1663 =head2 IsKohaFieldLinked
1665 my $is_linked = IsKohaFieldLinked({
1666 kohafield => $kohafield,
1667 frameworkcode => $frameworkcode,
1670 Return 1 if the field is linked
1674 sub IsKohaFieldLinked {
1675 my ( $params ) = @_;
1676 my $kohafield = $params->{kohafield};
1677 my $frameworkcode = $params->{frameworkcode} || '';
1678 my $dbh = C4::Context->dbh;
1679 my $is_linked = $dbh->selectcol_arrayref( q|
1681 FROM marc_subfield_structure
1682 WHERE frameworkcode = ?
1684 |,{}, $frameworkcode, $kohafield );
1685 return $is_linked->[0];