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;
35 use autouse 'Data::cselectall_arrayref' => qw(Dumper);
36 use DBI qw(:sql_types);
37 use vars qw(@ISA @EXPORT @EXPORT_OK $DEBUG);
43 &GetPrinters &GetPrinter
44 &GetItemTypes &getitemtypeinfo
45 &GetItemTypesCategorized &GetItemTypesByCategory
50 &get_notforloan_label_of
53 &getitemtypeimagelocation
55 &GetAuthorisedValueCategories
59 &GetNormalizedOCLCNumber
72 @EXPORT_OK = qw( GetDailyQuote );
77 C4::Koha - Perl Module containing convenience functions for Koha scripts
85 Koha.pm provides many functions for Koha scripts.
93 $itemtypes = &GetItemTypes( style => $style );
95 Returns information about existing itemtypes.
98 style: either 'array' or 'hash', defaults to 'hash'.
99 'array' returns an arrayref,
100 'hash' return a hashref with the itemtype value as the key
102 build a HTML select with the following code :
104 =head3 in PERL SCRIPT
106 my $itemtypes = GetItemTypes;
108 foreach my $thisitemtype (sort keys %$itemtypes) {
109 my $selected = 1 if $thisitemtype eq $itemtype;
110 my %row =(value => $thisitemtype,
111 selected => $selected,
112 description => $itemtypes->{$thisitemtype}->{'description'},
114 push @itemtypesloop, \%row;
116 $template->param(itemtypeloop => \@itemtypesloop);
120 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
121 <select name="itemtype">
122 <option value="">Default</option>
123 <!-- TMPL_LOOP name="itemtypeloop" -->
124 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
127 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
128 <input type="submit" value="OK" class="button">
135 my $style = defined( $params{'style'} ) ? $params{'style'} : 'hash';
137 require C4::Languages;
138 my $language = C4::Languages::getlanguage();
139 # returns a reference to a hash of references to itemtypes...
140 my $dbh = C4::Context->dbh;
144 itemtypes.description,
145 itemtypes.rentalcharge,
146 itemtypes.notforloan,
149 itemtypes.checkinmsg,
150 itemtypes.checkinmsgtype,
151 itemtypes.sip_media_type,
152 itemtypes.hideinopac,
153 itemtypes.searchcategory,
154 COALESCE( localization.translation, itemtypes.description ) AS translated_description
156 LEFT JOIN localization ON itemtypes.itemtype = localization.code
157 AND localization.entity = 'itemtypes'
158 AND localization.lang = ?
161 my $sth = $dbh->prepare($query);
162 $sth->execute( $language );
164 if ( $style eq 'hash' ) {
166 while ( my $IT = $sth->fetchrow_hashref ) {
167 $itemtypes{ $IT->{'itemtype'} } = $IT;
169 return ( \%itemtypes );
171 return [ sort { lc $a->{translated_description} cmp lc $b->{translated_description} } @{ $sth->fetchall_arrayref( {} ) } ];
175 =head2 GetItemTypesCategorized
177 $categories = GetItemTypesCategorized();
179 Returns a hashref containing search categories.
180 A search category will be put in the hash if at least one of its itemtypes is visible in OPAC.
181 The categories must be part of Authorized Values (ITEMTYPECAT)
185 sub GetItemTypesCategorized {
186 my $dbh = C4::Context->dbh;
187 # Order is important, so that partially hidden (some items are not visible in OPAC) search
188 # categories will be visible. hideinopac=0 must be last.
190 SELECT itemtype, description, imageurl, hideinopac, 0 as 'iscat' FROM itemtypes WHERE ISNULL(searchcategory) or length(searchcategory) = 0
192 SELECT DISTINCT searchcategory AS `itemtype`,
193 authorised_values.lib_opac AS description,
194 authorised_values.imageurl AS imageurl,
195 hideinopac, 1 as 'iscat'
197 LEFT JOIN authorised_values ON searchcategory = authorised_value
198 WHERE searchcategory > '' and hideinopac=1
200 SELECT DISTINCT searchcategory AS `itemtype`,
201 authorised_values.lib_opac AS description,
202 authorised_values.imageurl AS imageurl,
203 hideinopac, 1 as 'iscat'
205 LEFT JOIN authorised_values ON searchcategory = authorised_value
206 WHERE searchcategory > '' and hideinopac=0
208 return ($dbh->selectall_hashref($query,'itemtype'));
211 =head2 GetItemTypesByCategory
213 @results = GetItemTypesByCategory( $searchcategory );
215 Returns the itemtype code of all itemtypes included in a searchcategory.
219 sub GetItemTypesByCategory {
223 my $dbh = C4::Context->dbh;
224 my $query = qq|SELECT itemtype FROM itemtypes WHERE searchcategory=?|;
225 my $tmp=$dbh->selectcol_arrayref($query,undef,$category);
229 =head2 getitemtypeinfo
231 $itemtype = &getitemtypeinfo($itemtype, [$interface]);
233 Returns information about an itemtype. The optional $interface argument
234 sets which interface ('opac' or 'intranet') to return the imageurl for.
235 Defaults to intranet.
239 sub getitemtypeinfo {
240 my ($itemtype, $interface) = @_;
241 my $dbh = C4::Context->dbh;
242 require C4::Languages;
243 my $language = C4::Languages::getlanguage();
244 my $it = $dbh->selectrow_hashref(q|
247 itemtypes.description,
248 itemtypes.rentalcharge,
249 itemtypes.notforloan,
252 itemtypes.checkinmsg,
253 itemtypes.checkinmsgtype,
254 itemtypes.sip_media_type,
255 COALESCE( localization.translation, itemtypes.description ) AS translated_description
257 LEFT JOIN localization ON itemtypes.itemtype = localization.code
258 AND localization.entity = 'itemtypes'
259 AND localization.lang = ?
260 WHERE itemtypes.itemtype = ?
261 |, undef, $language, $itemtype );
263 $it->{imageurl} = getitemtypeimagelocation( ( ( defined $interface && $interface eq 'opac' ) ? 'opac' : 'intranet' ), $it->{imageurl} );
268 =head2 getitemtypeimagedir
270 my $directory = getitemtypeimagedir( 'opac' );
272 pass in 'opac' or 'intranet'. Defaults to 'opac'.
274 returns the full path to the appropriate directory containing images.
278 sub getitemtypeimagedir {
279 my $src = shift || 'opac';
280 if ($src eq 'intranet') {
281 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
283 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
287 sub getitemtypeimagesrc {
288 my $src = shift || 'opac';
289 if ($src eq 'intranet') {
290 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
292 return '/opac-tmpl' . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
296 sub getitemtypeimagelocation {
297 my ( $src, $image ) = @_;
299 return '' if ( !$image );
302 my $scheme = ( URI::Split::uri_split( $image ) )[0];
304 return $image if ( $scheme );
306 return getitemtypeimagesrc( $src ) . '/' . $image;
309 =head3 _getImagesFromDirectory
311 Find all of the image files in a directory in the filesystem
313 parameters: a directory name
315 returns: a list of images in that directory.
317 Notes: this does not traverse into subdirectories. See
318 _getSubdirectoryNames for help with that.
319 Images are assumed to be files with .gif or .png file extensions.
320 The image names returned do not have the directory name on them.
324 sub _getImagesFromDirectory {
325 my $directoryname = shift;
326 return unless defined $directoryname;
327 return unless -d $directoryname;
329 if ( opendir ( my $dh, $directoryname ) ) {
330 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
332 @images = sort(@images);
335 warn "unable to opendir $directoryname: $!";
340 =head3 _getSubdirectoryNames
342 Find all of the directories in a directory in the filesystem
344 parameters: a directory name
346 returns: a list of subdirectories in that directory.
348 Notes: this does not traverse into subdirectories. Only the first
349 level of subdirectories are returned.
350 The directory names returned don't have the parent directory name on them.
354 sub _getSubdirectoryNames {
355 my $directoryname = shift;
356 return unless defined $directoryname;
357 return unless -d $directoryname;
359 if ( opendir ( my $dh, $directoryname ) ) {
360 my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
364 warn "unable to opendir $directoryname: $!";
371 returns: a listref of hashrefs. Each hash represents another collection of images.
373 { imagesetname => 'npl', # the name of the image set (npl is the original one)
374 images => listref of image hashrefs
377 each image is represented by a hashref like this:
379 { KohaImage => 'npl/image.gif',
380 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
381 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
382 checked => 0 or 1: was this the image passed to this method?
383 Note: I'd like to remove this somehow.
390 my $checked = $params{'checked'} || '';
392 my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
393 url => getitemtypeimagesrc('intranet'),
395 opac => { filesystem => getitemtypeimagedir('opac'),
396 url => getitemtypeimagesrc('opac'),
400 my @imagesets = (); # list of hasrefs of image set data to pass to template
401 my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
402 foreach my $imagesubdir ( @subdirectories ) {
403 warn $imagesubdir if $DEBUG;
404 my @imagelist = (); # hashrefs of image info
405 my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
406 my $imagesetactive = 0;
407 foreach my $thisimage ( @imagenames ) {
409 { KohaImage => "$imagesubdir/$thisimage",
410 StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
411 OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
412 checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
415 $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
417 push @imagesets, { imagesetname => $imagesubdir,
418 imagesetactive => $imagesetactive,
419 images => \@imagelist };
427 $printers = &GetPrinters();
428 @queues = keys %$printers;
430 Returns information about existing printer queues.
432 C<$printers> is a reference-to-hash whose keys are the print queues
433 defined in the printers table of the Koha database. The values are
434 references-to-hash, whose keys are the fields in the printers table.
440 my $dbh = C4::Context->dbh;
441 my $sth = $dbh->prepare("select * from printers");
443 while ( my $printer = $sth->fetchrow_hashref ) {
444 $printers{ $printer->{'printqueue'} } = $printer;
446 return ( \%printers );
451 $printer = GetPrinter( $query, $printers );
456 my ( $query, $printers ) = @_; # get printer for this query from printers
457 my $printer = $query->param('printer');
458 my %cookie = $query->cookie('userenv');
459 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
460 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
466 Returns the number of pages to display in a pagination bar, given the number
467 of items and the number of items per page.
472 my ( $nb_items, $nb_items_per_page ) = @_;
474 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
479 (@themes) = &getallthemes('opac');
480 (@themes) = &getallthemes('intranet');
482 Returns an array of all available themes.
490 if ( $type eq 'intranet' ) {
491 $htdocs = C4::Context->config('intrahtdocs');
494 $htdocs = C4::Context->config('opachtdocs');
496 opendir D, "$htdocs";
497 my @dirlist = readdir D;
498 foreach my $directory (@dirlist) {
499 next if $directory eq 'lib';
500 -d "$htdocs/$directory/en" and push @themes, $directory;
507 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
512 tags => [ qw/ 600ab 601ab 602a 604at 605a 606ax 610a / ],
518 tags => [ qw/ 607a / ],
524 tags => [ qw/ 500a 501a 503a / ],
530 tags => [ qw/ 700ab 701ab 702ab / ],
531 sep => C4::Context->preference("UNIMARCAuthorsFacetsSeparator"),
536 tags => [ qw/ 225a / ],
542 tags => [ qw/ 995e / ],
546 unless ( Koha::Libraries->search->count == 1 )
548 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
549 if ( $DisplayLibraryFacets eq 'both'
550 || $DisplayLibraryFacets eq 'holding' )
555 idx => 'holdingbranch',
556 label => 'HoldingLibrary',
557 tags => [qw / 995c /],
562 if ( $DisplayLibraryFacets eq 'both'
563 || $DisplayLibraryFacets eq 'home' )
569 label => 'HomeLibrary',
570 tags => [qw / 995b /],
581 tags => [ qw/ 650a / ],
586 # label => 'People and Organizations',
587 # tags => [ qw/ 600a 610a 611a / ],
593 tags => [ qw/ 651a / ],
599 tags => [ qw/ 630a / ],
605 tags => [ qw/ 100a 110a 700a / ],
611 tags => [ qw/ 440a 490a / ],
616 label => 'ItemTypes',
617 tags => [ qw/ 952y 942c / ],
623 tags => [ qw / 952c / ],
627 unless ( Koha::Libraries->search->count == 1 )
629 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
630 if ( $DisplayLibraryFacets eq 'both'
631 || $DisplayLibraryFacets eq 'holding' )
636 idx => 'holdingbranch',
637 label => 'HoldingLibrary',
638 tags => [qw / 952b /],
643 if ( $DisplayLibraryFacets eq 'both'
644 || $DisplayLibraryFacets eq 'home' )
650 label => 'HomeLibrary',
651 tags => [qw / 952a /],
662 Return a href where a key is associated to a href. You give a query,
663 the name of the key among the fields returned by the query. If you
664 also give as third argument the name of the value, the function
665 returns a href of scalar. The optional 4th argument is an arrayref of
666 items passed to the C<execute()> call. It is designed to bind
667 parameters to any placeholders in your SQL.
676 # generic href of any information on the item, href of href.
677 my $iteminfos_of = get_infos_of($query, 'itemnumber');
678 print $iteminfos_of->{$itemnumber}{barcode};
680 # specific information, href of scalar
681 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
682 print $barcode_of_item->{$itemnumber};
687 my ( $query, $key_name, $value_name, $bind_params ) = @_;
689 my $dbh = C4::Context->dbh;
691 my $sth = $dbh->prepare($query);
692 $sth->execute( @$bind_params );
695 while ( my $row = $sth->fetchrow_hashref ) {
696 if ( defined $value_name ) {
697 $infos_of{ $row->{$key_name} } = $row->{$value_name};
700 $infos_of{ $row->{$key_name} } = $row;
708 =head2 get_notforloan_label_of
710 my $notforloan_label_of = get_notforloan_label_of();
712 Each authorised value of notforloan (information available in items and
713 itemtypes) is link to a single label.
715 Returns a href where keys are authorised values and values are corresponding
718 foreach my $authorised_value (keys %{$notforloan_label_of}) {
720 "authorised_value: %s => %s\n",
722 $notforloan_label_of->{$authorised_value}
728 # FIXME - why not use GetAuthorisedValues ??
730 sub get_notforloan_label_of {
731 my $dbh = C4::Context->dbh;
734 SELECT authorised_value
735 FROM marc_subfield_structure
736 WHERE kohafield = \'items.notforloan\'
739 my $sth = $dbh->prepare($query);
741 my ($statuscode) = $sth->fetchrow_array();
746 FROM authorised_values
749 $sth = $dbh->prepare($query);
750 $sth->execute($statuscode);
751 my %notforloan_label_of;
752 while ( my $row = $sth->fetchrow_hashref ) {
753 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
757 return \%notforloan_label_of;
760 =head2 GetAuthorisedValues
762 $authvalues = GetAuthorisedValues([$category]);
764 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
766 C<$category> returns authorised values for just one category (optional).
768 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
772 sub GetAuthorisedValues {
773 my ( $category, $opac ) = @_;
775 # Is this cached already?
776 $opac = $opac ? 1 : 0; # normalise to be safe
778 C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
780 "AuthorisedValues-$category-$opac-$branch_limit";
781 my $cache = Koha::Caches->get_instance();
782 my $result = $cache->get_from_cache($cache_key);
783 return $result if $result;
786 my $dbh = C4::Context->dbh;
789 FROM authorised_values av
792 LEFT JOIN authorised_values_branches ON ( id = av_id )
797 push @where_strings, "category = ?";
798 push @where_args, $category;
801 push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
802 push @where_args, $branch_limit;
804 if(@where_strings > 0) {
805 $query .= " WHERE " . join(" AND ", @where_strings);
807 $query .= ' ORDER BY category, ' . (
808 $opac ? 'COALESCE(lib_opac, lib)'
812 my $sth = $dbh->prepare($query);
814 $sth->execute( @where_args );
815 while (my $data=$sth->fetchrow_hashref) {
816 if ($opac && $data->{lib_opac}) {
817 $data->{lib} = $data->{lib_opac};
819 push @results, $data;
823 $cache->set_in_cache( $cache_key, \@results, { expiry => 5 } );
827 =head2 GetAuthorisedValueCategories
829 $auth_categories = GetAuthorisedValueCategories();
831 Return an arrayref of all of the available authorised
836 sub GetAuthorisedValueCategories {
837 my $dbh = C4::Context->dbh;
838 my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
841 while (defined (my $category = $sth->fetchrow_array) ) {
842 push @results, $category;
849 my $escaped_string = C4::Koha::xml_escape($string);
851 Convert &, <, >, ', and " in a string to XML entities
857 return '' unless defined $str;
861 $str =~ s/'/'/g;
862 $str =~ s/"/"/g;
866 =head2 display_marc_indicators
868 my $display_form = C4::Koha::display_marc_indicators($field);
870 C<$field> is a MARC::Field object
872 Generate a display form of the indicators of a variable
873 MARC field, replacing any blanks with '#'.
877 sub display_marc_indicators {
880 if ($field && $field->tag() >= 10) {
881 $indicators = $field->indicator(1) . $field->indicator(2);
882 $indicators =~ s/ /#/g;
887 sub GetNormalizedUPC {
888 my ($marcrecord,$marcflavour) = @_;
890 return unless $marcrecord;
891 if ($marcflavour eq 'UNIMARC') {
892 my @fields = $marcrecord->field('072');
893 foreach my $field (@fields) {
894 my $upc = _normalize_match_point($field->subfield('a'));
901 else { # assume marc21 if not unimarc
902 my @fields = $marcrecord->field('024');
903 foreach my $field (@fields) {
904 my $indicator = $field->indicator(1);
905 my $upc = _normalize_match_point($field->subfield('a'));
906 if ($upc && $indicator == 1 ) {
913 # Normalizes and returns the first valid ISBN found in the record
914 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
915 sub GetNormalizedISBN {
916 my ($isbn,$marcrecord,$marcflavour) = @_;
918 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
919 # anything after " | " should be removed, along with the delimiter
920 ($isbn) = split(/\|/, $isbn );
921 return _isbn_cleanup($isbn);
924 return unless $marcrecord;
926 if ($marcflavour eq 'UNIMARC') {
927 my @fields = $marcrecord->field('010');
928 foreach my $field (@fields) {
929 my $isbn = $field->subfield('a');
931 return _isbn_cleanup($isbn);
935 else { # assume marc21 if not unimarc
936 my @fields = $marcrecord->field('020');
937 foreach my $field (@fields) {
938 $isbn = $field->subfield('a');
940 return _isbn_cleanup($isbn);
946 sub GetNormalizedEAN {
947 my ($marcrecord,$marcflavour) = @_;
949 return unless $marcrecord;
951 if ($marcflavour eq 'UNIMARC') {
952 my @fields = $marcrecord->field('073');
953 foreach my $field (@fields) {
954 my $ean = _normalize_match_point($field->subfield('a'));
960 else { # assume marc21 if not unimarc
961 my @fields = $marcrecord->field('024');
962 foreach my $field (@fields) {
963 my $indicator = $field->indicator(1);
964 my $ean = _normalize_match_point($field->subfield('a'));
965 if ( $ean && $indicator == 3 ) {
972 sub GetNormalizedOCLCNumber {
973 my ($marcrecord,$marcflavour) = @_;
974 return unless $marcrecord;
976 if ($marcflavour ne 'UNIMARC' ) {
977 my @fields = $marcrecord->field('035');
978 foreach my $field (@fields) {
979 my $oclc = $field->subfield('a');
980 if ($oclc =~ /OCoLC/) {
981 $oclc =~ s/\(OCoLC\)//;
991 sub GetAuthvalueDropbox {
992 my ( $authcat, $default ) = @_;
993 my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
994 my $dbh = C4::Context->dbh;
998 FROM authorised_values
1001 LEFT JOIN authorised_values_branches ON ( id = av_id )
1006 $query .= " AND ( branchcode = ? OR branchcode IS NULL )" if $branch_limit;
1007 $query .= " GROUP BY lib ORDER BY category, lib, lib_opac";
1008 my $sth = $dbh->prepare($query);
1009 $sth->execute( $authcat, $branch_limit ? $branch_limit : () );
1012 my $option_list = [];
1013 my @authorised_values = ( q{} );
1014 while (my $av = $sth->fetchrow_hashref) {
1015 push @{$option_list}, {
1016 value => $av->{authorised_value},
1017 label => $av->{lib},
1018 default => ($default eq $av->{authorised_value}),
1022 if ( @{$option_list} ) {
1023 return $option_list;
1029 =head2 GetDailyQuote($opts)
1031 Takes a hashref of options
1033 Currently supported options are:
1035 'id' An exact quote id
1036 'random' Select a random quote
1037 noop When no option is passed in, this sub will return the quote timestamped for the current day
1039 The function returns an anonymous hash following this format:
1042 'source' => 'source-of-quote',
1043 'timestamp' => 'timestamp-value',
1044 'text' => 'text-of-quote',
1050 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1051 # at least for default option
1055 my $dbh = C4::Context->dbh;
1060 $query = 'SELECT * FROM quotes WHERE id = ?';
1061 $sth = $dbh->prepare($query);
1062 $sth->execute($opts{'id'});
1063 $quote = $sth->fetchrow_hashref();
1065 elsif ($opts{'random'}) {
1066 # Fall through... we also return a random quote as a catch-all if all else fails
1069 $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1070 $sth = $dbh->prepare($query);
1072 $quote = $sth->fetchrow_hashref();
1074 unless ($quote) { # if there are not matches, choose a random quote
1075 # get a list of all available quote ids
1076 $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1078 my $range = ($sth->fetchrow_array)[0];
1079 # chose a random id within that range if there is more than one quote
1080 my $offset = int(rand($range));
1082 $query = 'SELECT * FROM quotes ORDER BY id LIMIT 1 OFFSET ?';
1083 $sth = C4::Context->dbh->prepare($query);
1084 # see http://www.perlmonks.org/?node_id=837422 for why
1085 # we're being verbose and using bind_param
1086 $sth->bind_param(1, $offset, SQL_INTEGER);
1088 $quote = $sth->fetchrow_hashref();
1089 # update the timestamp for that quote
1090 $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1091 $sth = C4::Context->dbh->prepare($query);
1093 DateTime::Format::MySQL->format_datetime( dt_from_string() ),
1100 sub _normalize_match_point {
1101 my $match_point = shift;
1102 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1103 $normalized_match_point =~ s/-//g;
1105 return $normalized_match_point;
1110 return NormalizeISBN(
1113 format => 'ISBN-10',
1119 =head2 NormalizedISBN
1121 my $isbns = NormalizedISBN({
1123 strip_hyphens => [0,1],
1124 format => ['ISBN-10', 'ISBN-13']
1127 Returns an isbn validated by Business::ISBN.
1128 Optionally strips hyphens and/or forces the isbn
1129 to be of the specified format.
1131 If the string cannot be validated as an isbn,
1139 my $string = $params->{isbn};
1140 my $strip_hyphens = $params->{strip_hyphens};
1141 my $format = $params->{format};
1143 return unless $string;
1145 my $isbn = Business::ISBN->new($string);
1147 if ( $isbn && $isbn->is_valid() ) {
1149 if ( $format eq 'ISBN-10' ) {
1150 $isbn = $isbn->as_isbn10();
1152 elsif ( $format eq 'ISBN-13' ) {
1153 $isbn = $isbn->as_isbn13();
1155 return unless $isbn;
1157 if ($strip_hyphens) {
1158 $string = $isbn->as_string( [] );
1160 $string = $isbn->as_string();
1167 =head2 GetVariationsOfISBN
1169 my @isbns = GetVariationsOfISBN( $isbn );
1171 Returns a list of variations of the given isbn in
1172 both ISBN-10 and ISBN-13 formats, with and without
1175 In a scalar context, the isbns are returned as a
1176 string delimited by ' | '.
1180 sub GetVariationsOfISBN {
1183 return unless $isbn;
1187 push( @isbns, NormalizeISBN({ isbn => $isbn }) );
1188 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10' }) );
1189 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13' }) );
1190 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10', strip_hyphens => 1 }) );
1191 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13', strip_hyphens => 1 }) );
1193 # Strip out any "empty" strings from the array
1194 @isbns = grep { defined($_) && $_ =~ /\S/ } @isbns;
1196 return wantarray ? @isbns : join( " | ", @isbns );
1199 =head2 GetVariationsOfISBNs
1201 my @isbns = GetVariationsOfISBNs( @isbns );
1203 Returns a list of variations of the given isbns in
1204 both ISBN-10 and ISBN-13 formats, with and without
1207 In a scalar context, the isbns are returned as a
1208 string delimited by ' | '.
1212 sub GetVariationsOfISBNs {
1215 @isbns = map { GetVariationsOfISBN( $_ ) } @isbns;
1217 return wantarray ? @isbns : join( " | ", @isbns );
1220 =head2 NormalizedISSN
1222 my $issns = NormalizedISSN({
1224 strip_hyphen => [0,1]
1227 Returns an issn validated by Business::ISSN.
1228 Optionally strips hyphen.
1230 If the string cannot be validated as an issn,
1238 my $string = $params->{issn};
1239 my $strip_hyphen = $params->{strip_hyphen};
1241 my $issn = Business::ISSN->new($string);
1243 if ( $issn && $issn->is_valid ){
1245 if ($strip_hyphen) {
1246 $string = $issn->_issn;
1249 $string = $issn->as_string;
1256 =head2 GetVariationsOfISSN
1258 my @issns = GetVariationsOfISSN( $issn );
1260 Returns a list of variations of the given issn in
1261 with and without a hyphen.
1263 In a scalar context, the issns are returned as a
1264 string delimited by ' | '.
1268 sub GetVariationsOfISSN {
1271 return unless $issn;
1274 my $str = NormalizeISSN({ issn => $issn });
1277 push @issns, NormalizeISSN({ issn => $issn, strip_hyphen => 1 });
1282 # Strip out any "empty" strings from the array
1283 @issns = grep { defined($_) && $_ =~ /\S/ } @issns;
1285 return wantarray ? @issns : join( " | ", @issns );
1288 =head2 GetVariationsOfISSNs
1290 my @issns = GetVariationsOfISSNs( @issns );
1292 Returns a list of variations of the given issns in
1293 with and without a hyphen.
1295 In a scalar context, the issns are returned as a
1296 string delimited by ' | '.
1300 sub GetVariationsOfISSNs {
1303 @issns = map { GetVariationsOfISSN( $_ ) } @issns;
1305 return wantarray ? @issns : join( " | ", @issns );
1309 =head2 IsKohaFieldLinked
1311 my $is_linked = IsKohaFieldLinked({
1312 kohafield => $kohafield,
1313 frameworkcode => $frameworkcode,
1316 Return 1 if the field is linked
1320 sub IsKohaFieldLinked {
1321 my ( $params ) = @_;
1322 my $kohafield = $params->{kohafield};
1323 my $frameworkcode = $params->{frameworkcode} || '';
1324 my $dbh = C4::Context->dbh;
1325 my $is_linked = $dbh->selectcol_arrayref( q|
1327 FROM marc_subfield_structure
1328 WHERE frameworkcode = ?
1330 |,{}, $frameworkcode, $kohafield );
1331 return $is_linked->[0];