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
28 use Koha::DateUtils qw(dt_from_string);
29 use Koha::AuthorisedValues;
31 use Koha::MarcSubfieldStructures;
32 use DateTime::Format::MySQL;
34 use autouse 'Data::cselectall_arrayref' => qw(Dumper);
35 use DBI qw(:sql_types);
36 use vars qw(@ISA @EXPORT @EXPORT_OK $DEBUG);
42 &GetPrinters &GetPrinter
43 &GetItemTypes &getitemtypeinfo
44 &GetItemTypesCategorized &GetItemTypesByCategory
45 &getframeworks &getframeworkinfo
51 &get_notforloan_label_of
54 &getitemtypeimagelocation
56 &GetAuthorisedValueCategories
57 &GetKohaAuthorisedValues
61 &GetNormalizedOCLCNumber
71 @EXPORT_OK = qw( GetDailyQuote );
76 C4::Koha - Perl Module containing convenience functions for Koha scripts
84 Koha.pm provides many functions for Koha scripts.
92 $itemtypes = &GetItemTypes( style => $style );
94 Returns information about existing itemtypes.
97 style: either 'array' or 'hash', defaults to 'hash'.
98 'array' returns an arrayref,
99 'hash' return a hashref with the itemtype value as the key
101 build a HTML select with the following code :
103 =head3 in PERL SCRIPT
105 my $itemtypes = GetItemTypes;
107 foreach my $thisitemtype (sort keys %$itemtypes) {
108 my $selected = 1 if $thisitemtype eq $itemtype;
109 my %row =(value => $thisitemtype,
110 selected => $selected,
111 description => $itemtypes->{$thisitemtype}->{'description'},
113 push @itemtypesloop, \%row;
115 $template->param(itemtypeloop => \@itemtypesloop);
119 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
120 <select name="itemtype">
121 <option value="">Default</option>
122 <!-- TMPL_LOOP name="itemtypeloop" -->
123 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
126 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
127 <input type="submit" value="OK" class="button">
134 my $style = defined( $params{'style'} ) ? $params{'style'} : 'hash';
136 require C4::Languages;
137 my $language = C4::Languages::getlanguage();
138 # returns a reference to a hash of references to itemtypes...
139 my $dbh = C4::Context->dbh;
143 itemtypes.description,
144 itemtypes.rentalcharge,
145 itemtypes.notforloan,
148 itemtypes.checkinmsg,
149 itemtypes.checkinmsgtype,
150 itemtypes.sip_media_type,
151 itemtypes.hideinopac,
152 itemtypes.searchcategory,
153 COALESCE( localization.translation, itemtypes.description ) AS translated_description
155 LEFT JOIN localization ON itemtypes.itemtype = localization.code
156 AND localization.entity = 'itemtypes'
157 AND localization.lang = ?
160 my $sth = $dbh->prepare($query);
161 $sth->execute( $language );
163 if ( $style eq 'hash' ) {
165 while ( my $IT = $sth->fetchrow_hashref ) {
166 $itemtypes{ $IT->{'itemtype'} } = $IT;
168 return ( \%itemtypes );
170 return [ sort { lc $a->{translated_description} cmp lc $b->{translated_description} } @{ $sth->fetchall_arrayref( {} ) } ];
174 =head2 GetItemTypesCategorized
176 $categories = GetItemTypesCategorized();
178 Returns a hashref containing search categories.
179 A search category will be put in the hash if at least one of its itemtypes is visible in OPAC.
180 The categories must be part of Authorized Values (ITEMTYPECAT)
184 sub GetItemTypesCategorized {
185 my $dbh = C4::Context->dbh;
186 # Order is important, so that partially hidden (some items are not visible in OPAC) search
187 # categories will be visible. hideinopac=0 must be last.
189 SELECT itemtype, description, imageurl, hideinopac, 0 as 'iscat' FROM itemtypes WHERE ISNULL(searchcategory) or length(searchcategory) = 0
191 SELECT DISTINCT searchcategory AS `itemtype`,
192 authorised_values.lib_opac AS description,
193 authorised_values.imageurl AS imageurl,
194 hideinopac, 1 as 'iscat'
196 LEFT JOIN authorised_values ON searchcategory = authorised_value
197 WHERE searchcategory > '' and hideinopac=1
199 SELECT DISTINCT searchcategory AS `itemtype`,
200 authorised_values.lib_opac AS description,
201 authorised_values.imageurl AS imageurl,
202 hideinopac, 1 as 'iscat'
204 LEFT JOIN authorised_values ON searchcategory = authorised_value
205 WHERE searchcategory > '' and hideinopac=0
207 return ($dbh->selectall_hashref($query,'itemtype'));
210 =head2 GetItemTypesByCategory
212 @results = GetItemTypesByCategory( $searchcategory );
214 Returns the itemtype code of all itemtypes included in a searchcategory.
218 sub GetItemTypesByCategory {
222 my $dbh = C4::Context->dbh;
223 my $query = qq|SELECT itemtype FROM itemtypes WHERE searchcategory=?|;
224 my $tmp=$dbh->selectcol_arrayref($query,undef,$category);
230 $frameworks = &getframework();
232 Returns information about existing frameworks
234 build a HTML select with the following code :
236 =head3 in PERL SCRIPT
238 my $frameworks = getframeworks();
240 foreach my $thisframework (keys %$frameworks) {
241 my $selected = 1 if $thisframework eq $frameworkcode;
243 value => $thisframework,
244 selected => $selected,
245 description => $frameworks->{$thisframework}->{'frameworktext'},
247 push @frameworksloop, \%row;
249 $template->param(frameworkloop => \@frameworksloop);
253 <form action="[% script_name %] method=post>
254 <select name="frameworkcode">
255 <option value="">Default</option>
256 [% FOREACH framework IN frameworkloop %]
257 [% IF ( framework.selected ) %]
258 <option value="[% framework.value %]" selected="selected">[% framework.description %]</option>
260 <option value="[% framework.value %]">[% framework.description %]</option>
264 <input type=text name=searchfield value="[% searchfield %]">
265 <input type="submit" value="OK" class="button">
272 # returns a reference to a hash of references to branches...
274 my $dbh = C4::Context->dbh;
275 my $sth = $dbh->prepare("select * from biblio_framework");
277 while ( my $IT = $sth->fetchrow_hashref ) {
278 $itemtypes{ $IT->{'frameworkcode'} } = $IT;
280 return ( \%itemtypes );
283 =head2 GetFrameworksLoop
285 $frameworks = GetFrameworksLoop( $frameworkcode );
287 Returns the loop suggested on getframework(), but ordered by framework description.
289 build a HTML select with the following code :
291 =head3 in PERL SCRIPT
293 $template->param( frameworkloop => GetFrameworksLoop( $frameworkcode ) );
297 Same as getframework()
299 <form action="[% script_name %] method=post>
300 <select name="frameworkcode">
301 <option value="">Default</option>
302 [% FOREACH framework IN frameworkloop %]
303 [% IF ( framework.selected ) %]
304 <option value="[% framework.value %]" selected="selected">[% framework.description %]</option>
306 <option value="[% framework.value %]">[% framework.description %]</option>
310 <input type=text name=searchfield value="[% searchfield %]">
311 <input type="submit" value="OK" class="button">
316 sub GetFrameworksLoop {
317 my $frameworkcode = shift;
318 my $frameworks = getframeworks();
320 foreach my $thisframework (sort { uc($frameworks->{$a}->{'frameworktext'}) cmp uc($frameworks->{$b}->{'frameworktext'}) } keys %$frameworks) {
321 my $selected = ( $thisframework eq $frameworkcode ) ? 1 : undef;
323 value => $thisframework,
324 selected => $selected,
325 description => $frameworks->{$thisframework}->{'frameworktext'},
327 push @frameworkloop, \%row;
329 return \@frameworkloop;
332 =head2 getframeworkinfo
334 $frameworkinfo = &getframeworkinfo($frameworkcode);
336 Returns information about an frameworkcode.
340 sub getframeworkinfo {
341 my ($frameworkcode) = @_;
342 my $dbh = C4::Context->dbh;
344 $dbh->prepare("select * from biblio_framework where frameworkcode=?");
345 $sth->execute($frameworkcode);
346 my $res = $sth->fetchrow_hashref;
350 =head2 getitemtypeinfo
352 $itemtype = &getitemtypeinfo($itemtype, [$interface]);
354 Returns information about an itemtype. The optional $interface argument
355 sets which interface ('opac' or 'intranet') to return the imageurl for.
356 Defaults to intranet.
360 sub getitemtypeinfo {
361 my ($itemtype, $interface) = @_;
362 my $dbh = C4::Context->dbh;
363 require C4::Languages;
364 my $language = C4::Languages::getlanguage();
365 my $it = $dbh->selectrow_hashref(q|
368 itemtypes.description,
369 itemtypes.rentalcharge,
370 itemtypes.notforloan,
373 itemtypes.checkinmsg,
374 itemtypes.checkinmsgtype,
375 itemtypes.sip_media_type,
376 COALESCE( localization.translation, itemtypes.description ) AS translated_description
378 LEFT JOIN localization ON itemtypes.itemtype = localization.code
379 AND localization.entity = 'itemtypes'
380 AND localization.lang = ?
381 WHERE itemtypes.itemtype = ?
382 |, undef, $language, $itemtype );
384 $it->{imageurl} = getitemtypeimagelocation( ( ( defined $interface && $interface eq 'opac' ) ? 'opac' : 'intranet' ), $it->{imageurl} );
389 =head2 getitemtypeimagedir
391 my $directory = getitemtypeimagedir( 'opac' );
393 pass in 'opac' or 'intranet'. Defaults to 'opac'.
395 returns the full path to the appropriate directory containing images.
399 sub getitemtypeimagedir {
400 my $src = shift || 'opac';
401 if ($src eq 'intranet') {
402 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
404 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
408 sub getitemtypeimagesrc {
409 my $src = shift || 'opac';
410 if ($src eq 'intranet') {
411 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
413 return '/opac-tmpl' . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
417 sub getitemtypeimagelocation {
418 my ( $src, $image ) = @_;
420 return '' if ( !$image );
423 my $scheme = ( URI::Split::uri_split( $image ) )[0];
425 return $image if ( $scheme );
427 return getitemtypeimagesrc( $src ) . '/' . $image;
430 =head3 _getImagesFromDirectory
432 Find all of the image files in a directory in the filesystem
434 parameters: a directory name
436 returns: a list of images in that directory.
438 Notes: this does not traverse into subdirectories. See
439 _getSubdirectoryNames for help with that.
440 Images are assumed to be files with .gif or .png file extensions.
441 The image names returned do not have the directory name on them.
445 sub _getImagesFromDirectory {
446 my $directoryname = shift;
447 return unless defined $directoryname;
448 return unless -d $directoryname;
450 if ( opendir ( my $dh, $directoryname ) ) {
451 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
453 @images = sort(@images);
456 warn "unable to opendir $directoryname: $!";
461 =head3 _getSubdirectoryNames
463 Find all of the directories in a directory in the filesystem
465 parameters: a directory name
467 returns: a list of subdirectories in that directory.
469 Notes: this does not traverse into subdirectories. Only the first
470 level of subdirectories are returned.
471 The directory names returned don't have the parent directory name on them.
475 sub _getSubdirectoryNames {
476 my $directoryname = shift;
477 return unless defined $directoryname;
478 return unless -d $directoryname;
480 if ( opendir ( my $dh, $directoryname ) ) {
481 my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
485 warn "unable to opendir $directoryname: $!";
492 returns: a listref of hashrefs. Each hash represents another collection of images.
494 { imagesetname => 'npl', # the name of the image set (npl is the original one)
495 images => listref of image hashrefs
498 each image is represented by a hashref like this:
500 { KohaImage => 'npl/image.gif',
501 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
502 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
503 checked => 0 or 1: was this the image passed to this method?
504 Note: I'd like to remove this somehow.
511 my $checked = $params{'checked'} || '';
513 my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
514 url => getitemtypeimagesrc('intranet'),
516 opac => { filesystem => getitemtypeimagedir('opac'),
517 url => getitemtypeimagesrc('opac'),
521 my @imagesets = (); # list of hasrefs of image set data to pass to template
522 my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
523 foreach my $imagesubdir ( @subdirectories ) {
524 warn $imagesubdir if $DEBUG;
525 my @imagelist = (); # hashrefs of image info
526 my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
527 my $imagesetactive = 0;
528 foreach my $thisimage ( @imagenames ) {
530 { KohaImage => "$imagesubdir/$thisimage",
531 StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
532 OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
533 checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
536 $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
538 push @imagesets, { imagesetname => $imagesubdir,
539 imagesetactive => $imagesetactive,
540 images => \@imagelist };
548 $printers = &GetPrinters();
549 @queues = keys %$printers;
551 Returns information about existing printer queues.
553 C<$printers> is a reference-to-hash whose keys are the print queues
554 defined in the printers table of the Koha database. The values are
555 references-to-hash, whose keys are the fields in the printers table.
561 my $dbh = C4::Context->dbh;
562 my $sth = $dbh->prepare("select * from printers");
564 while ( my $printer = $sth->fetchrow_hashref ) {
565 $printers{ $printer->{'printqueue'} } = $printer;
567 return ( \%printers );
572 $printer = GetPrinter( $query, $printers );
577 my ( $query, $printers ) = @_; # get printer for this query from printers
578 my $printer = $query->param('printer');
579 my %cookie = $query->cookie('userenv');
580 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
581 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
587 Returns the number of pages to display in a pagination bar, given the number
588 of items and the number of items per page.
593 my ( $nb_items, $nb_items_per_page ) = @_;
595 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
600 (@themes) = &getallthemes('opac');
601 (@themes) = &getallthemes('intranet');
603 Returns an array of all available themes.
611 if ( $type eq 'intranet' ) {
612 $htdocs = C4::Context->config('intrahtdocs');
615 $htdocs = C4::Context->config('opachtdocs');
617 opendir D, "$htdocs";
618 my @dirlist = readdir D;
619 foreach my $directory (@dirlist) {
620 next if $directory eq 'lib';
621 -d "$htdocs/$directory/en" and push @themes, $directory;
628 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
633 tags => [ qw/ 600ab 601ab 602a 604at 605a 606ax 610a / ],
639 tags => [ qw/ 607a / ],
645 tags => [ qw/ 500a 501a 503a / ],
651 tags => [ qw/ 700ab 701ab 702ab / ],
652 sep => C4::Context->preference("UNIMARCAuthorsFacetsSeparator"),
657 tags => [ qw/ 225a / ],
663 tags => [ qw/ 995e / ],
667 unless ( Koha::Libraries->search->count == 1 )
669 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
670 if ( $DisplayLibraryFacets eq 'both'
671 || $DisplayLibraryFacets eq 'holding' )
676 idx => 'holdingbranch',
677 label => 'HoldingLibrary',
678 tags => [qw / 995c /],
683 if ( $DisplayLibraryFacets eq 'both'
684 || $DisplayLibraryFacets eq 'home' )
690 label => 'HomeLibrary',
691 tags => [qw / 995b /],
702 tags => [ qw/ 650a / ],
707 # label => 'People and Organizations',
708 # tags => [ qw/ 600a 610a 611a / ],
714 tags => [ qw/ 651a / ],
720 tags => [ qw/ 630a / ],
726 tags => [ qw/ 100a 110a 700a / ],
732 tags => [ qw/ 440a 490a / ],
737 label => 'ItemTypes',
738 tags => [ qw/ 952y 942c / ],
744 tags => [ qw / 952c / ],
748 unless ( Koha::Libraries->search->count == 1 )
750 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
751 if ( $DisplayLibraryFacets eq 'both'
752 || $DisplayLibraryFacets eq 'holding' )
757 idx => 'holdingbranch',
758 label => 'HoldingLibrary',
759 tags => [qw / 952b /],
764 if ( $DisplayLibraryFacets eq 'both'
765 || $DisplayLibraryFacets eq 'home' )
771 label => 'HomeLibrary',
772 tags => [qw / 952a /],
783 Return a href where a key is associated to a href. You give a query,
784 the name of the key among the fields returned by the query. If you
785 also give as third argument the name of the value, the function
786 returns a href of scalar. The optional 4th argument is an arrayref of
787 items passed to the C<execute()> call. It is designed to bind
788 parameters to any placeholders in your SQL.
797 # generic href of any information on the item, href of href.
798 my $iteminfos_of = get_infos_of($query, 'itemnumber');
799 print $iteminfos_of->{$itemnumber}{barcode};
801 # specific information, href of scalar
802 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
803 print $barcode_of_item->{$itemnumber};
808 my ( $query, $key_name, $value_name, $bind_params ) = @_;
810 my $dbh = C4::Context->dbh;
812 my $sth = $dbh->prepare($query);
813 $sth->execute( @$bind_params );
816 while ( my $row = $sth->fetchrow_hashref ) {
817 if ( defined $value_name ) {
818 $infos_of{ $row->{$key_name} } = $row->{$value_name};
821 $infos_of{ $row->{$key_name} } = $row;
829 =head2 get_notforloan_label_of
831 my $notforloan_label_of = get_notforloan_label_of();
833 Each authorised value of notforloan (information available in items and
834 itemtypes) is link to a single label.
836 Returns a href where keys are authorised values and values are corresponding
839 foreach my $authorised_value (keys %{$notforloan_label_of}) {
841 "authorised_value: %s => %s\n",
843 $notforloan_label_of->{$authorised_value}
849 # FIXME - why not use GetAuthorisedValues ??
851 sub get_notforloan_label_of {
852 my $dbh = C4::Context->dbh;
855 SELECT authorised_value
856 FROM marc_subfield_structure
857 WHERE kohafield = \'items.notforloan\'
860 my $sth = $dbh->prepare($query);
862 my ($statuscode) = $sth->fetchrow_array();
867 FROM authorised_values
870 $sth = $dbh->prepare($query);
871 $sth->execute($statuscode);
872 my %notforloan_label_of;
873 while ( my $row = $sth->fetchrow_hashref ) {
874 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
878 return \%notforloan_label_of;
881 =head2 GetAuthorisedValues
883 $authvalues = GetAuthorisedValues([$category]);
885 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
887 C<$category> returns authorised values for just one category (optional).
889 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
893 sub GetAuthorisedValues {
894 my ( $category, $opac ) = @_;
896 # Is this cached already?
897 $opac = $opac ? 1 : 0; # normalise to be safe
899 C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
901 "AuthorisedValues-$category-$opac-$branch_limit";
902 my $cache = Koha::Caches->get_instance();
903 my $result = $cache->get_from_cache($cache_key);
904 return $result if $result;
907 my $dbh = C4::Context->dbh;
910 FROM authorised_values av
913 LEFT JOIN authorised_values_branches ON ( id = av_id )
918 push @where_strings, "category = ?";
919 push @where_args, $category;
922 push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
923 push @where_args, $branch_limit;
925 if(@where_strings > 0) {
926 $query .= " WHERE " . join(" AND ", @where_strings);
928 $query .= ' ORDER BY category, ' . (
929 $opac ? 'COALESCE(lib_opac, lib)'
933 my $sth = $dbh->prepare($query);
935 $sth->execute( @where_args );
936 while (my $data=$sth->fetchrow_hashref) {
937 if ($opac && $data->{lib_opac}) {
938 $data->{lib} = $data->{lib_opac};
940 push @results, $data;
944 $cache->set_in_cache( $cache_key, \@results, { expiry => 5 } );
948 =head2 GetAuthorisedValueCategories
950 $auth_categories = GetAuthorisedValueCategories();
952 Return an arrayref of all of the available authorised
957 sub GetAuthorisedValueCategories {
958 my $dbh = C4::Context->dbh;
959 my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
962 while (defined (my $category = $sth->fetchrow_array) ) {
963 push @results, $category;
968 =head2 GetKohaAuthorisedValues
970 Takes $kohafield, $fwcode as parameters.
972 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
974 Returns hashref of Code => description
976 Returns undef if no authorised value category is defined for the kohafield.
980 sub GetKohaAuthorisedValues {
981 my ( $kohafield, $fwcode, $opac ) = @_;
982 $fwcode = '' unless $fwcode;
984 my $dbh = C4::Context->dbh;
986 my $avs = Koha::AuthorisedValues->search_by_koha_field( { frameworkcode => $fwcode, kohafield => $kohafield } );
987 return {} unless $avs->count;
989 while ( my $av = $avs->next ) {
990 $values->{ $av->authorised_value } = $opac ? $av->opac_description : $av->lib;
997 my $escaped_string = C4::Koha::xml_escape($string);
999 Convert &, <, >, ', and " in a string to XML entities
1005 return '' unless defined $str;
1006 $str =~ s/&/&/g;
1009 $str =~ s/'/'/g;
1010 $str =~ s/"/"/g;
1014 =head2 display_marc_indicators
1016 my $display_form = C4::Koha::display_marc_indicators($field);
1018 C<$field> is a MARC::Field object
1020 Generate a display form of the indicators of a variable
1021 MARC field, replacing any blanks with '#'.
1025 sub display_marc_indicators {
1027 my $indicators = '';
1028 if ($field && $field->tag() >= 10) {
1029 $indicators = $field->indicator(1) . $field->indicator(2);
1030 $indicators =~ s/ /#/g;
1035 sub GetNormalizedUPC {
1036 my ($marcrecord,$marcflavour) = @_;
1038 return unless $marcrecord;
1039 if ($marcflavour eq 'UNIMARC') {
1040 my @fields = $marcrecord->field('072');
1041 foreach my $field (@fields) {
1042 my $upc = _normalize_match_point($field->subfield('a'));
1049 else { # assume marc21 if not unimarc
1050 my @fields = $marcrecord->field('024');
1051 foreach my $field (@fields) {
1052 my $indicator = $field->indicator(1);
1053 my $upc = _normalize_match_point($field->subfield('a'));
1054 if ($upc && $indicator == 1 ) {
1061 # Normalizes and returns the first valid ISBN found in the record
1062 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
1063 sub GetNormalizedISBN {
1064 my ($isbn,$marcrecord,$marcflavour) = @_;
1066 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1067 # anything after " | " should be removed, along with the delimiter
1068 ($isbn) = split(/\|/, $isbn );
1069 return _isbn_cleanup($isbn);
1072 return unless $marcrecord;
1074 if ($marcflavour eq 'UNIMARC') {
1075 my @fields = $marcrecord->field('010');
1076 foreach my $field (@fields) {
1077 my $isbn = $field->subfield('a');
1079 return _isbn_cleanup($isbn);
1083 else { # assume marc21 if not unimarc
1084 my @fields = $marcrecord->field('020');
1085 foreach my $field (@fields) {
1086 $isbn = $field->subfield('a');
1088 return _isbn_cleanup($isbn);
1094 sub GetNormalizedEAN {
1095 my ($marcrecord,$marcflavour) = @_;
1097 return unless $marcrecord;
1099 if ($marcflavour eq 'UNIMARC') {
1100 my @fields = $marcrecord->field('073');
1101 foreach my $field (@fields) {
1102 my $ean = _normalize_match_point($field->subfield('a'));
1108 else { # assume marc21 if not unimarc
1109 my @fields = $marcrecord->field('024');
1110 foreach my $field (@fields) {
1111 my $indicator = $field->indicator(1);
1112 my $ean = _normalize_match_point($field->subfield('a'));
1113 if ( $ean && $indicator == 3 ) {
1120 sub GetNormalizedOCLCNumber {
1121 my ($marcrecord,$marcflavour) = @_;
1122 return unless $marcrecord;
1124 if ($marcflavour ne 'UNIMARC' ) {
1125 my @fields = $marcrecord->field('035');
1126 foreach my $field (@fields) {
1127 my $oclc = $field->subfield('a');
1128 if ($oclc =~ /OCoLC/) {
1129 $oclc =~ s/\(OCoLC\)//;
1139 sub GetAuthvalueDropbox {
1140 my ( $authcat, $default ) = @_;
1141 my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1142 my $dbh = C4::Context->dbh;
1146 FROM authorised_values
1149 LEFT JOIN authorised_values_branches ON ( id = av_id )
1154 $query .= " AND ( branchcode = ? OR branchcode IS NULL )" if $branch_limit;
1155 $query .= " GROUP BY lib ORDER BY category, lib, lib_opac";
1156 my $sth = $dbh->prepare($query);
1157 $sth->execute( $authcat, $branch_limit ? $branch_limit : () );
1160 my $option_list = [];
1161 my @authorised_values = ( q{} );
1162 while (my $av = $sth->fetchrow_hashref) {
1163 push @{$option_list}, {
1164 value => $av->{authorised_value},
1165 label => $av->{lib},
1166 default => ($default eq $av->{authorised_value}),
1170 if ( @{$option_list} ) {
1171 return $option_list;
1177 =head2 GetDailyQuote($opts)
1179 Takes a hashref of options
1181 Currently supported options are:
1183 'id' An exact quote id
1184 'random' Select a random quote
1185 noop When no option is passed in, this sub will return the quote timestamped for the current day
1187 The function returns an anonymous hash following this format:
1190 'source' => 'source-of-quote',
1191 'timestamp' => 'timestamp-value',
1192 'text' => 'text-of-quote',
1198 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1199 # at least for default option
1203 my $dbh = C4::Context->dbh;
1208 $query = 'SELECT * FROM quotes WHERE id = ?';
1209 $sth = $dbh->prepare($query);
1210 $sth->execute($opts{'id'});
1211 $quote = $sth->fetchrow_hashref();
1213 elsif ($opts{'random'}) {
1214 # Fall through... we also return a random quote as a catch-all if all else fails
1217 $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1218 $sth = $dbh->prepare($query);
1220 $quote = $sth->fetchrow_hashref();
1222 unless ($quote) { # if there are not matches, choose a random quote
1223 # get a list of all available quote ids
1224 $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1226 my $range = ($sth->fetchrow_array)[0];
1227 # chose a random id within that range if there is more than one quote
1228 my $offset = int(rand($range));
1230 $query = 'SELECT * FROM quotes ORDER BY id LIMIT 1 OFFSET ?';
1231 $sth = C4::Context->dbh->prepare($query);
1232 # see http://www.perlmonks.org/?node_id=837422 for why
1233 # we're being verbose and using bind_param
1234 $sth->bind_param(1, $offset, SQL_INTEGER);
1236 $quote = $sth->fetchrow_hashref();
1237 # update the timestamp for that quote
1238 $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1239 $sth = C4::Context->dbh->prepare($query);
1241 DateTime::Format::MySQL->format_datetime( dt_from_string() ),
1248 sub _normalize_match_point {
1249 my $match_point = shift;
1250 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1251 $normalized_match_point =~ s/-//g;
1253 return $normalized_match_point;
1258 return NormalizeISBN(
1261 format => 'ISBN-10',
1267 =head2 NormalizedISBN
1269 my $isbns = NormalizedISBN({
1271 strip_hyphens => [0,1],
1272 format => ['ISBN-10', 'ISBN-13']
1275 Returns an isbn validated by Business::ISBN.
1276 Optionally strips hyphens and/or forces the isbn
1277 to be of the specified format.
1279 If the string cannot be validated as an isbn,
1287 my $string = $params->{isbn};
1288 my $strip_hyphens = $params->{strip_hyphens};
1289 my $format = $params->{format};
1291 return unless $string;
1293 my $isbn = Business::ISBN->new($string);
1295 if ( $isbn && $isbn->is_valid() ) {
1297 if ( $format eq 'ISBN-10' ) {
1298 $isbn = $isbn->as_isbn10();
1300 elsif ( $format eq 'ISBN-13' ) {
1301 $isbn = $isbn->as_isbn13();
1303 return unless $isbn;
1305 if ($strip_hyphens) {
1306 $string = $isbn->as_string( [] );
1308 $string = $isbn->as_string();
1315 =head2 GetVariationsOfISBN
1317 my @isbns = GetVariationsOfISBN( $isbn );
1319 Returns a list of variations of the given isbn in
1320 both ISBN-10 and ISBN-13 formats, with and without
1323 In a scalar context, the isbns are returned as a
1324 string delimited by ' | '.
1328 sub GetVariationsOfISBN {
1331 return unless $isbn;
1335 push( @isbns, NormalizeISBN({ isbn => $isbn }) );
1336 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10' }) );
1337 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13' }) );
1338 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10', strip_hyphens => 1 }) );
1339 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13', strip_hyphens => 1 }) );
1341 # Strip out any "empty" strings from the array
1342 @isbns = grep { defined($_) && $_ =~ /\S/ } @isbns;
1344 return wantarray ? @isbns : join( " | ", @isbns );
1347 =head2 GetVariationsOfISBNs
1349 my @isbns = GetVariationsOfISBNs( @isbns );
1351 Returns a list of variations of the given isbns in
1352 both ISBN-10 and ISBN-13 formats, with and without
1355 In a scalar context, the isbns are returned as a
1356 string delimited by ' | '.
1360 sub GetVariationsOfISBNs {
1363 @isbns = map { GetVariationsOfISBN( $_ ) } @isbns;
1365 return wantarray ? @isbns : join( " | ", @isbns );
1368 =head2 IsKohaFieldLinked
1370 my $is_linked = IsKohaFieldLinked({
1371 kohafield => $kohafield,
1372 frameworkcode => $frameworkcode,
1375 Return 1 if the field is linked
1379 sub IsKohaFieldLinked {
1380 my ( $params ) = @_;
1381 my $kohafield = $params->{kohafield};
1382 my $frameworkcode = $params->{frameworkcode} || '';
1383 my $dbh = C4::Context->dbh;
1384 my $is_linked = $dbh->selectcol_arrayref( q|
1386 FROM marc_subfield_structure
1387 WHERE frameworkcode = ?
1389 |,{}, $frameworkcode, $kohafield );
1390 return $is_linked->[0];