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
50 &get_notforloan_label_of
53 &getitemtypeimagelocation
58 &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 getitemtypeinfo
212 $itemtype = &getitemtypeinfo($itemtype, [$interface]);
214 Returns information about an itemtype. The optional $interface argument
215 sets which interface ('opac' or 'intranet') to return the imageurl for.
216 Defaults to intranet.
220 sub getitemtypeinfo {
221 my ($itemtype, $interface) = @_;
222 my $dbh = C4::Context->dbh;
223 require C4::Languages;
224 my $language = C4::Languages::getlanguage();
225 my $it = $dbh->selectrow_hashref(q|
228 itemtypes.description,
229 itemtypes.rentalcharge,
230 itemtypes.notforloan,
233 itemtypes.checkinmsg,
234 itemtypes.checkinmsgtype,
235 itemtypes.sip_media_type,
236 COALESCE( localization.translation, itemtypes.description ) AS translated_description
238 LEFT JOIN localization ON itemtypes.itemtype = localization.code
239 AND localization.entity = 'itemtypes'
240 AND localization.lang = ?
241 WHERE itemtypes.itemtype = ?
242 |, undef, $language, $itemtype );
244 $it->{imageurl} = getitemtypeimagelocation( ( ( defined $interface && $interface eq 'opac' ) ? 'opac' : 'intranet' ), $it->{imageurl} );
249 =head2 getitemtypeimagedir
251 my $directory = getitemtypeimagedir( 'opac' );
253 pass in 'opac' or 'intranet'. Defaults to 'opac'.
255 returns the full path to the appropriate directory containing images.
259 sub getitemtypeimagedir {
260 my $src = shift || 'opac';
261 if ($src eq 'intranet') {
262 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
264 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
268 sub getitemtypeimagesrc {
269 my $src = shift || 'opac';
270 if ($src eq 'intranet') {
271 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
273 return '/opac-tmpl' . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
277 sub getitemtypeimagelocation {
278 my ( $src, $image ) = @_;
280 return '' if ( !$image );
283 my $scheme = ( URI::Split::uri_split( $image ) )[0];
285 return $image if ( $scheme );
287 return getitemtypeimagesrc( $src ) . '/' . $image;
290 =head3 _getImagesFromDirectory
292 Find all of the image files in a directory in the filesystem
294 parameters: a directory name
296 returns: a list of images in that directory.
298 Notes: this does not traverse into subdirectories. See
299 _getSubdirectoryNames for help with that.
300 Images are assumed to be files with .gif or .png file extensions.
301 The image names returned do not have the directory name on them.
305 sub _getImagesFromDirectory {
306 my $directoryname = shift;
307 return unless defined $directoryname;
308 return unless -d $directoryname;
310 if ( opendir ( my $dh, $directoryname ) ) {
311 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
313 @images = sort(@images);
316 warn "unable to opendir $directoryname: $!";
321 =head3 _getSubdirectoryNames
323 Find all of the directories in a directory in the filesystem
325 parameters: a directory name
327 returns: a list of subdirectories in that directory.
329 Notes: this does not traverse into subdirectories. Only the first
330 level of subdirectories are returned.
331 The directory names returned don't have the parent directory name on them.
335 sub _getSubdirectoryNames {
336 my $directoryname = shift;
337 return unless defined $directoryname;
338 return unless -d $directoryname;
340 if ( opendir ( my $dh, $directoryname ) ) {
341 my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
345 warn "unable to opendir $directoryname: $!";
352 returns: a listref of hashrefs. Each hash represents another collection of images.
354 { imagesetname => 'npl', # the name of the image set (npl is the original one)
355 images => listref of image hashrefs
358 each image is represented by a hashref like this:
360 { KohaImage => 'npl/image.gif',
361 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
362 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
363 checked => 0 or 1: was this the image passed to this method?
364 Note: I'd like to remove this somehow.
371 my $checked = $params{'checked'} || '';
373 my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
374 url => getitemtypeimagesrc('intranet'),
376 opac => { filesystem => getitemtypeimagedir('opac'),
377 url => getitemtypeimagesrc('opac'),
381 my @imagesets = (); # list of hasrefs of image set data to pass to template
382 my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
383 foreach my $imagesubdir ( @subdirectories ) {
384 warn $imagesubdir if $DEBUG;
385 my @imagelist = (); # hashrefs of image info
386 my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
387 my $imagesetactive = 0;
388 foreach my $thisimage ( @imagenames ) {
390 { KohaImage => "$imagesubdir/$thisimage",
391 StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
392 OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
393 checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
396 $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
398 push @imagesets, { imagesetname => $imagesubdir,
399 imagesetactive => $imagesetactive,
400 images => \@imagelist };
408 $printers = &GetPrinters();
409 @queues = keys %$printers;
411 Returns information about existing printer queues.
413 C<$printers> is a reference-to-hash whose keys are the print queues
414 defined in the printers table of the Koha database. The values are
415 references-to-hash, whose keys are the fields in the printers table.
421 my $dbh = C4::Context->dbh;
422 my $sth = $dbh->prepare("select * from printers");
424 while ( my $printer = $sth->fetchrow_hashref ) {
425 $printers{ $printer->{'printqueue'} } = $printer;
427 return ( \%printers );
432 $printer = GetPrinter( $query, $printers );
437 my ( $query, $printers ) = @_; # get printer for this query from printers
438 my $printer = $query->param('printer');
439 my %cookie = $query->cookie('userenv');
440 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
441 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
447 Returns the number of pages to display in a pagination bar, given the number
448 of items and the number of items per page.
453 my ( $nb_items, $nb_items_per_page ) = @_;
455 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
460 (@themes) = &getallthemes('opac');
461 (@themes) = &getallthemes('intranet');
463 Returns an array of all available themes.
471 if ( $type eq 'intranet' ) {
472 $htdocs = C4::Context->config('intrahtdocs');
475 $htdocs = C4::Context->config('opachtdocs');
477 opendir D, "$htdocs";
478 my @dirlist = readdir D;
479 foreach my $directory (@dirlist) {
480 next if $directory eq 'lib';
481 -d "$htdocs/$directory/en" and push @themes, $directory;
488 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
493 tags => [ qw/ 600ab 601ab 602a 604at 605a 606ax 610a / ],
499 tags => [ qw/ 607a / ],
505 tags => [ qw/ 500a 501a 503a / ],
511 tags => [ qw/ 700ab 701ab 702ab / ],
512 sep => C4::Context->preference("UNIMARCAuthorsFacetsSeparator"),
517 tags => [ qw/ 225a / ],
523 tags => [ qw/ 995e / ],
527 unless ( Koha::Libraries->search->count == 1 )
529 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
530 if ( $DisplayLibraryFacets eq 'both'
531 || $DisplayLibraryFacets eq 'holding' )
536 idx => 'holdingbranch',
537 label => 'HoldingLibrary',
538 tags => [qw / 995c /],
543 if ( $DisplayLibraryFacets eq 'both'
544 || $DisplayLibraryFacets eq 'home' )
550 label => 'HomeLibrary',
551 tags => [qw / 995b /],
562 tags => [ qw/ 650a / ],
567 # label => 'People and Organizations',
568 # tags => [ qw/ 600a 610a 611a / ],
574 tags => [ qw/ 651a / ],
580 tags => [ qw/ 630a / ],
586 tags => [ qw/ 100a 110a 700a / ],
592 tags => [ qw/ 440a 490a / ],
597 label => 'ItemTypes',
598 tags => [ qw/ 952y 942c / ],
604 tags => [ qw / 952c / ],
608 unless ( Koha::Libraries->search->count == 1 )
610 my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
611 if ( $DisplayLibraryFacets eq 'both'
612 || $DisplayLibraryFacets eq 'holding' )
617 idx => 'holdingbranch',
618 label => 'HoldingLibrary',
619 tags => [qw / 952b /],
624 if ( $DisplayLibraryFacets eq 'both'
625 || $DisplayLibraryFacets eq 'home' )
631 label => 'HomeLibrary',
632 tags => [qw / 952a /],
643 Return a href where a key is associated to a href. You give a query,
644 the name of the key among the fields returned by the query. If you
645 also give as third argument the name of the value, the function
646 returns a href of scalar. The optional 4th argument is an arrayref of
647 items passed to the C<execute()> call. It is designed to bind
648 parameters to any placeholders in your SQL.
657 # generic href of any information on the item, href of href.
658 my $iteminfos_of = get_infos_of($query, 'itemnumber');
659 print $iteminfos_of->{$itemnumber}{barcode};
661 # specific information, href of scalar
662 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
663 print $barcode_of_item->{$itemnumber};
668 my ( $query, $key_name, $value_name, $bind_params ) = @_;
670 my $dbh = C4::Context->dbh;
672 my $sth = $dbh->prepare($query);
673 $sth->execute( @$bind_params );
676 while ( my $row = $sth->fetchrow_hashref ) {
677 if ( defined $value_name ) {
678 $infos_of{ $row->{$key_name} } = $row->{$value_name};
681 $infos_of{ $row->{$key_name} } = $row;
689 =head2 get_notforloan_label_of
691 my $notforloan_label_of = get_notforloan_label_of();
693 Each authorised value of notforloan (information available in items and
694 itemtypes) is link to a single label.
696 Returns a href where keys are authorised values and values are corresponding
699 foreach my $authorised_value (keys %{$notforloan_label_of}) {
701 "authorised_value: %s => %s\n",
703 $notforloan_label_of->{$authorised_value}
709 # FIXME - why not use GetAuthorisedValues ??
711 sub get_notforloan_label_of {
712 my $dbh = C4::Context->dbh;
715 SELECT authorised_value
716 FROM marc_subfield_structure
717 WHERE kohafield = \'items.notforloan\'
720 my $sth = $dbh->prepare($query);
722 my ($statuscode) = $sth->fetchrow_array();
727 FROM authorised_values
730 $sth = $dbh->prepare($query);
731 $sth->execute($statuscode);
732 my %notforloan_label_of;
733 while ( my $row = $sth->fetchrow_hashref ) {
734 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
738 return \%notforloan_label_of;
741 =head2 GetAuthorisedValues
743 $authvalues = GetAuthorisedValues([$category]);
745 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
747 C<$category> returns authorised values for just one category (optional).
749 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
753 sub GetAuthorisedValues {
754 my ( $category, $opac ) = @_;
756 # Is this cached already?
757 $opac = $opac ? 1 : 0; # normalise to be safe
759 C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
761 "AuthorisedValues-$category-$opac-$branch_limit";
762 my $cache = Koha::Caches->get_instance();
763 my $result = $cache->get_from_cache($cache_key);
764 return $result if $result;
767 my $dbh = C4::Context->dbh;
770 FROM authorised_values av
773 LEFT JOIN authorised_values_branches ON ( id = av_id )
778 push @where_strings, "category = ?";
779 push @where_args, $category;
782 push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
783 push @where_args, $branch_limit;
785 if(@where_strings > 0) {
786 $query .= " WHERE " . join(" AND ", @where_strings);
788 $query .= ' ORDER BY category, ' . (
789 $opac ? 'COALESCE(lib_opac, lib)'
793 my $sth = $dbh->prepare($query);
795 $sth->execute( @where_args );
796 while (my $data=$sth->fetchrow_hashref) {
797 if ($opac && $data->{lib_opac}) {
798 $data->{lib} = $data->{lib_opac};
800 push @results, $data;
804 $cache->set_in_cache( $cache_key, \@results, { expiry => 5 } );
810 my $escaped_string = C4::Koha::xml_escape($string);
812 Convert &, <, >, ', and " in a string to XML entities
818 return '' unless defined $str;
822 $str =~ s/'/'/g;
823 $str =~ s/"/"/g;
827 =head2 display_marc_indicators
829 my $display_form = C4::Koha::display_marc_indicators($field);
831 C<$field> is a MARC::Field object
833 Generate a display form of the indicators of a variable
834 MARC field, replacing any blanks with '#'.
838 sub display_marc_indicators {
841 if ($field && $field->tag() >= 10) {
842 $indicators = $field->indicator(1) . $field->indicator(2);
843 $indicators =~ s/ /#/g;
848 sub GetNormalizedUPC {
849 my ($marcrecord,$marcflavour) = @_;
851 return unless $marcrecord;
852 if ($marcflavour eq 'UNIMARC') {
853 my @fields = $marcrecord->field('072');
854 foreach my $field (@fields) {
855 my $upc = _normalize_match_point($field->subfield('a'));
862 else { # assume marc21 if not unimarc
863 my @fields = $marcrecord->field('024');
864 foreach my $field (@fields) {
865 my $indicator = $field->indicator(1);
866 my $upc = _normalize_match_point($field->subfield('a'));
867 if ($upc && $indicator == 1 ) {
874 # Normalizes and returns the first valid ISBN found in the record
875 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
876 sub GetNormalizedISBN {
877 my ($isbn,$marcrecord,$marcflavour) = @_;
879 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
880 # anything after " | " should be removed, along with the delimiter
881 ($isbn) = split(/\|/, $isbn );
882 return _isbn_cleanup($isbn);
885 return unless $marcrecord;
887 if ($marcflavour eq 'UNIMARC') {
888 my @fields = $marcrecord->field('010');
889 foreach my $field (@fields) {
890 my $isbn = $field->subfield('a');
892 return _isbn_cleanup($isbn);
896 else { # assume marc21 if not unimarc
897 my @fields = $marcrecord->field('020');
898 foreach my $field (@fields) {
899 $isbn = $field->subfield('a');
901 return _isbn_cleanup($isbn);
907 sub GetNormalizedEAN {
908 my ($marcrecord,$marcflavour) = @_;
910 return unless $marcrecord;
912 if ($marcflavour eq 'UNIMARC') {
913 my @fields = $marcrecord->field('073');
914 foreach my $field (@fields) {
915 my $ean = _normalize_match_point($field->subfield('a'));
921 else { # assume marc21 if not unimarc
922 my @fields = $marcrecord->field('024');
923 foreach my $field (@fields) {
924 my $indicator = $field->indicator(1);
925 my $ean = _normalize_match_point($field->subfield('a'));
926 if ( $ean && $indicator == 3 ) {
933 sub GetNormalizedOCLCNumber {
934 my ($marcrecord,$marcflavour) = @_;
935 return unless $marcrecord;
937 if ($marcflavour ne 'UNIMARC' ) {
938 my @fields = $marcrecord->field('035');
939 foreach my $field (@fields) {
940 my $oclc = $field->subfield('a');
941 if ($oclc =~ /OCoLC/) {
942 $oclc =~ s/\(OCoLC\)//;
952 sub GetAuthvalueDropbox {
953 my ( $authcat, $default ) = @_;
954 my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
955 my $dbh = C4::Context->dbh;
959 FROM authorised_values
962 LEFT JOIN authorised_values_branches ON ( id = av_id )
967 $query .= " AND ( branchcode = ? OR branchcode IS NULL )" if $branch_limit;
968 $query .= " GROUP BY lib ORDER BY category, lib, lib_opac";
969 my $sth = $dbh->prepare($query);
970 $sth->execute( $authcat, $branch_limit ? $branch_limit : () );
973 my $option_list = [];
974 my @authorised_values = ( q{} );
975 while (my $av = $sth->fetchrow_hashref) {
976 push @{$option_list}, {
977 value => $av->{authorised_value},
979 default => ($default eq $av->{authorised_value}),
983 if ( @{$option_list} ) {
990 =head2 GetDailyQuote($opts)
992 Takes a hashref of options
994 Currently supported options are:
996 'id' An exact quote id
997 'random' Select a random quote
998 noop When no option is passed in, this sub will return the quote timestamped for the current day
1000 The function returns an anonymous hash following this format:
1003 'source' => 'source-of-quote',
1004 'timestamp' => 'timestamp-value',
1005 'text' => 'text-of-quote',
1011 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1012 # at least for default option
1016 my $dbh = C4::Context->dbh;
1021 $query = 'SELECT * FROM quotes WHERE id = ?';
1022 $sth = $dbh->prepare($query);
1023 $sth->execute($opts{'id'});
1024 $quote = $sth->fetchrow_hashref();
1026 elsif ($opts{'random'}) {
1027 # Fall through... we also return a random quote as a catch-all if all else fails
1030 $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1031 $sth = $dbh->prepare($query);
1033 $quote = $sth->fetchrow_hashref();
1035 unless ($quote) { # if there are not matches, choose a random quote
1036 # get a list of all available quote ids
1037 $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1039 my $range = ($sth->fetchrow_array)[0];
1040 # chose a random id within that range if there is more than one quote
1041 my $offset = int(rand($range));
1043 $query = 'SELECT * FROM quotes ORDER BY id LIMIT 1 OFFSET ?';
1044 $sth = C4::Context->dbh->prepare($query);
1045 # see http://www.perlmonks.org/?node_id=837422 for why
1046 # we're being verbose and using bind_param
1047 $sth->bind_param(1, $offset, SQL_INTEGER);
1049 $quote = $sth->fetchrow_hashref();
1050 # update the timestamp for that quote
1051 $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1052 $sth = C4::Context->dbh->prepare($query);
1054 DateTime::Format::MySQL->format_datetime( dt_from_string() ),
1061 sub _normalize_match_point {
1062 my $match_point = shift;
1063 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1064 $normalized_match_point =~ s/-//g;
1066 return $normalized_match_point;
1071 return NormalizeISBN(
1074 format => 'ISBN-10',
1080 =head2 NormalizedISBN
1082 my $isbns = NormalizedISBN({
1084 strip_hyphens => [0,1],
1085 format => ['ISBN-10', 'ISBN-13']
1088 Returns an isbn validated by Business::ISBN.
1089 Optionally strips hyphens and/or forces the isbn
1090 to be of the specified format.
1092 If the string cannot be validated as an isbn,
1100 my $string = $params->{isbn};
1101 my $strip_hyphens = $params->{strip_hyphens};
1102 my $format = $params->{format};
1104 return unless $string;
1106 my $isbn = Business::ISBN->new($string);
1108 if ( $isbn && $isbn->is_valid() ) {
1110 if ( $format eq 'ISBN-10' ) {
1111 $isbn = $isbn->as_isbn10();
1113 elsif ( $format eq 'ISBN-13' ) {
1114 $isbn = $isbn->as_isbn13();
1116 return unless $isbn;
1118 if ($strip_hyphens) {
1119 $string = $isbn->as_string( [] );
1121 $string = $isbn->as_string();
1128 =head2 GetVariationsOfISBN
1130 my @isbns = GetVariationsOfISBN( $isbn );
1132 Returns a list of variations of the given isbn in
1133 both ISBN-10 and ISBN-13 formats, with and without
1136 In a scalar context, the isbns are returned as a
1137 string delimited by ' | '.
1141 sub GetVariationsOfISBN {
1144 return unless $isbn;
1148 push( @isbns, NormalizeISBN({ isbn => $isbn }) );
1149 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10' }) );
1150 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13' }) );
1151 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10', strip_hyphens => 1 }) );
1152 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13', strip_hyphens => 1 }) );
1154 # Strip out any "empty" strings from the array
1155 @isbns = grep { defined($_) && $_ =~ /\S/ } @isbns;
1157 return wantarray ? @isbns : join( " | ", @isbns );
1160 =head2 GetVariationsOfISBNs
1162 my @isbns = GetVariationsOfISBNs( @isbns );
1164 Returns a list of variations of the given isbns in
1165 both ISBN-10 and ISBN-13 formats, with and without
1168 In a scalar context, the isbns are returned as a
1169 string delimited by ' | '.
1173 sub GetVariationsOfISBNs {
1176 @isbns = map { GetVariationsOfISBN( $_ ) } @isbns;
1178 return wantarray ? @isbns : join( " | ", @isbns );
1181 =head2 NormalizedISSN
1183 my $issns = NormalizedISSN({
1185 strip_hyphen => [0,1]
1188 Returns an issn validated by Business::ISSN.
1189 Optionally strips hyphen.
1191 If the string cannot be validated as an issn,
1199 my $string = $params->{issn};
1200 my $strip_hyphen = $params->{strip_hyphen};
1202 my $issn = Business::ISSN->new($string);
1204 if ( $issn && $issn->is_valid ){
1206 if ($strip_hyphen) {
1207 $string = $issn->_issn;
1210 $string = $issn->as_string;
1217 =head2 GetVariationsOfISSN
1219 my @issns = GetVariationsOfISSN( $issn );
1221 Returns a list of variations of the given issn in
1222 with and without a hyphen.
1224 In a scalar context, the issns are returned as a
1225 string delimited by ' | '.
1229 sub GetVariationsOfISSN {
1232 return unless $issn;
1235 my $str = NormalizeISSN({ issn => $issn });
1238 push @issns, NormalizeISSN({ issn => $issn, strip_hyphen => 1 });
1243 # Strip out any "empty" strings from the array
1244 @issns = grep { defined($_) && $_ =~ /\S/ } @issns;
1246 return wantarray ? @issns : join( " | ", @issns );
1249 =head2 GetVariationsOfISSNs
1251 my @issns = GetVariationsOfISSNs( @issns );
1253 Returns a list of variations of the given issns in
1254 with and without a hyphen.
1256 In a scalar context, the issns are returned as a
1257 string delimited by ' | '.
1261 sub GetVariationsOfISSNs {
1264 @issns = map { GetVariationsOfISSN( $_ ) } @issns;
1266 return wantarray ? @issns : join( " | ", @issns );
1270 =head2 IsKohaFieldLinked
1272 my $is_linked = IsKohaFieldLinked({
1273 kohafield => $kohafield,
1274 frameworkcode => $frameworkcode,
1277 Return 1 if the field is linked
1281 sub IsKohaFieldLinked {
1282 my ( $params ) = @_;
1283 my $kohafield = $params->{kohafield};
1284 my $frameworkcode = $params->{frameworkcode} || '';
1285 my $dbh = C4::Context->dbh;
1286 my $is_linked = $dbh->selectcol_arrayref( q|
1288 FROM marc_subfield_structure
1289 WHERE frameworkcode = ?
1291 |,{}, $frameworkcode, $kohafield );
1292 return $is_linked->[0];