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
49 &get_notforloan_label_of
52 &getitemtypeimagelocation
57 &GetNormalizedOCLCNumber
70 @EXPORT_OK = qw( GetDailyQuote );
75 C4::Koha - Perl Module containing convenience functions for Koha scripts
83 Koha.pm provides many functions for Koha scripts.
91 $itemtypes = &GetItemTypes( style => $style );
93 Returns information about existing itemtypes.
96 style: either 'array' or 'hash', defaults to 'hash'.
97 'array' returns an arrayref,
98 'hash' return a hashref with the itemtype value as the key
100 build a HTML select with the following code :
102 =head3 in PERL SCRIPT
104 my $itemtypes = GetItemTypes;
106 foreach my $thisitemtype (sort keys %$itemtypes) {
107 my $selected = 1 if $thisitemtype eq $itemtype;
108 my %row =(value => $thisitemtype,
109 selected => $selected,
110 description => $itemtypes->{$thisitemtype}->{'description'},
112 push @itemtypesloop, \%row;
114 $template->param(itemtypeloop => \@itemtypesloop);
118 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
119 <select name="itemtype">
120 <option value="">Default</option>
121 <!-- TMPL_LOOP name="itemtypeloop" -->
122 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
125 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
126 <input type="submit" value="OK" class="button">
133 my $style = defined( $params{'style'} ) ?
$params{'style'} : 'hash';
135 require C4
::Languages
;
136 my $language = C4
::Languages
::getlanguage
();
137 # returns a reference to a hash of references to itemtypes...
138 my $dbh = C4
::Context
->dbh;
142 itemtypes
.description
,
143 itemtypes
.rentalcharge
,
144 itemtypes
.notforloan
,
147 itemtypes
.checkinmsg
,
148 itemtypes
.checkinmsgtype
,
149 itemtypes
.sip_media_type
,
150 itemtypes
.hideinopac
,
151 itemtypes
.searchcategory
,
152 COALESCE
( localization
.translation
, itemtypes
.description
) AS translated_description
154 LEFT JOIN localization ON itemtypes
.itemtype
= localization
.code
155 AND localization
.entity
= 'itemtypes'
156 AND localization
.lang
= ?
159 my $sth = $dbh->prepare($query);
160 $sth->execute( $language );
162 if ( $style eq 'hash' ) {
164 while ( my $IT = $sth->fetchrow_hashref ) {
165 $itemtypes{ $IT->{'itemtype'} } = $IT;
167 return ( \
%itemtypes );
169 return [ sort { lc $a->{translated_description
} cmp lc $b->{translated_description
} } @
{ $sth->fetchall_arrayref( {} ) } ];
173 =head2 GetItemTypesCategorized
175 $categories = GetItemTypesCategorized();
177 Returns a hashref containing search categories.
178 A search category will be put in the hash if at least one of its itemtypes is visible in OPAC.
179 The categories must be part of Authorized Values (ITEMTYPECAT)
183 sub GetItemTypesCategorized
{
184 my $dbh = C4
::Context
->dbh;
185 # Order is important, so that partially hidden (some items are not visible in OPAC) search
186 # categories will be visible. hideinopac=0 must be last.
188 SELECT itemtype
, description
, imageurl
, hideinopac
, 0 as
'iscat' FROM itemtypes WHERE ISNULL
(searchcategory
) or length(searchcategory
) = 0
190 SELECT DISTINCT searchcategory AS
`itemtype`,
191 authorised_values
.lib_opac AS description
,
192 authorised_values
.imageurl AS imageurl
,
193 hideinopac
, 1 as
'iscat'
195 LEFT JOIN authorised_values ON searchcategory
= authorised_value
196 WHERE searchcategory
> '' and hideinopac
=1
198 SELECT DISTINCT searchcategory AS
`itemtype`,
199 authorised_values
.lib_opac AS description
,
200 authorised_values
.imageurl AS imageurl
,
201 hideinopac
, 1 as
'iscat'
203 LEFT JOIN authorised_values ON searchcategory
= authorised_value
204 WHERE searchcategory
> '' and hideinopac
=0
206 return ($dbh->selectall_hashref($query,'itemtype'));
209 =head2 getitemtypeinfo
211 $itemtype = &getitemtypeinfo($itemtype, [$interface]);
213 Returns information about an itemtype. The optional $interface argument
214 sets which interface ('opac' or 'intranet') to return the imageurl for.
215 Defaults to intranet.
219 sub getitemtypeinfo
{
220 my ($itemtype, $interface) = @_;
221 my $dbh = C4
::Context
->dbh;
222 require C4
::Languages
;
223 my $language = C4
::Languages
::getlanguage
();
224 my $it = $dbh->selectrow_hashref(q
|
227 itemtypes
.description
,
228 itemtypes
.rentalcharge
,
229 itemtypes
.notforloan
,
232 itemtypes
.checkinmsg
,
233 itemtypes
.checkinmsgtype
,
234 itemtypes
.sip_media_type
,
235 COALESCE
( localization
.translation
, itemtypes
.description
) AS translated_description
237 LEFT JOIN localization ON itemtypes
.itemtype
= localization
.code
238 AND localization
.entity
= 'itemtypes'
239 AND localization
.lang
= ?
240 WHERE itemtypes
.itemtype
= ?
241 |, undef, $language, $itemtype );
243 $it->{imageurl
} = getitemtypeimagelocation
( ( ( defined $interface && $interface eq 'opac' ) ?
'opac' : 'intranet' ), $it->{imageurl
} );
248 =head2 getitemtypeimagedir
250 my $directory = getitemtypeimagedir( 'opac' );
252 pass in 'opac' or 'intranet'. Defaults to 'opac'.
254 returns the full path to the appropriate directory containing images.
258 sub getitemtypeimagedir
{
259 my $src = shift || 'opac';
260 if ($src eq 'intranet') {
261 return C4
::Context
->config('intrahtdocs') . '/' .C4
::Context
->preference('template') . '/img/itemtypeimg';
263 return C4
::Context
->config('opachtdocs') . '/' . C4
::Context
->preference('opacthemes') . '/itemtypeimg';
267 sub getitemtypeimagesrc
{
268 my $src = shift || 'opac';
269 if ($src eq 'intranet') {
270 return '/intranet-tmpl' . '/' . C4
::Context
->preference('template') . '/img/itemtypeimg';
272 return '/opac-tmpl' . '/' . C4
::Context
->preference('opacthemes') . '/itemtypeimg';
276 sub getitemtypeimagelocation
{
277 my ( $src, $image ) = @_;
279 return '' if ( !$image );
282 my $scheme = ( URI
::Split
::uri_split
( $image ) )[0];
284 return $image if ( $scheme );
286 return getitemtypeimagesrc
( $src ) . '/' . $image;
289 =head3 _getImagesFromDirectory
291 Find all of the image files in a directory in the filesystem
293 parameters: a directory name
295 returns: a list of images in that directory.
297 Notes: this does not traverse into subdirectories. See
298 _getSubdirectoryNames for help with that.
299 Images are assumed to be files with .gif or .png file extensions.
300 The image names returned do not have the directory name on them.
304 sub _getImagesFromDirectory
{
305 my $directoryname = shift;
306 return unless defined $directoryname;
307 return unless -d
$directoryname;
309 if ( opendir ( my $dh, $directoryname ) ) {
310 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
312 @images = sort(@images);
315 warn "unable to opendir $directoryname: $!";
320 =head3 _getSubdirectoryNames
322 Find all of the directories in a directory in the filesystem
324 parameters: a directory name
326 returns: a list of subdirectories in that directory.
328 Notes: this does not traverse into subdirectories. Only the first
329 level of subdirectories are returned.
330 The directory names returned don't have the parent directory name on them.
334 sub _getSubdirectoryNames
{
335 my $directoryname = shift;
336 return unless defined $directoryname;
337 return unless -d
$directoryname;
339 if ( opendir ( my $dh, $directoryname ) ) {
340 my @directories = grep { -d File
::Spec
->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
344 warn "unable to opendir $directoryname: $!";
351 returns: a listref of hashrefs. Each hash represents another collection of images.
353 { imagesetname => 'npl', # the name of the image set (npl is the original one)
354 images => listref of image hashrefs
357 each image is represented by a hashref like this:
359 { KohaImage => 'npl/image.gif',
360 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
361 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
362 checked => 0 or 1: was this the image passed to this method?
363 Note: I'd like to remove this somehow.
370 my $checked = $params{'checked'} || '';
372 my $paths = { staff
=> { filesystem
=> getitemtypeimagedir
('intranet'),
373 url
=> getitemtypeimagesrc
('intranet'),
375 opac
=> { filesystem
=> getitemtypeimagedir
('opac'),
376 url
=> getitemtypeimagesrc
('opac'),
380 my @imagesets = (); # list of hasrefs of image set data to pass to template
381 my @subdirectories = _getSubdirectoryNames
( $paths->{'staff'}{'filesystem'} );
382 foreach my $imagesubdir ( @subdirectories ) {
383 warn $imagesubdir if $DEBUG;
384 my @imagelist = (); # hashrefs of image info
385 my @imagenames = _getImagesFromDirectory
( File
::Spec
->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
386 my $imagesetactive = 0;
387 foreach my $thisimage ( @imagenames ) {
389 { KohaImage
=> "$imagesubdir/$thisimage",
390 StaffImageUrl
=> join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
391 OpacImageUrl
=> join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
392 checked
=> "$imagesubdir/$thisimage" eq $checked ?
1 : 0,
395 $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
397 push @imagesets, { imagesetname
=> $imagesubdir,
398 imagesetactive
=> $imagesetactive,
399 images
=> \
@imagelist };
407 $printers = &GetPrinters();
408 @queues = keys %$printers;
410 Returns information about existing printer queues.
412 C<$printers> is a reference-to-hash whose keys are the print queues
413 defined in the printers table of the Koha database. The values are
414 references-to-hash, whose keys are the fields in the printers table.
420 my $dbh = C4
::Context
->dbh;
421 my $sth = $dbh->prepare("select * from printers");
423 while ( my $printer = $sth->fetchrow_hashref ) {
424 $printers{ $printer->{'printqueue'} } = $printer;
426 return ( \
%printers );
431 $printer = GetPrinter( $query, $printers );
436 my ( $query, $printers ) = @_; # get printer for this query from printers
437 my $printer = $query->param('printer');
438 my %cookie = $query->cookie('userenv');
439 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
440 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
446 Returns the number of pages to display in a pagination bar, given the number
447 of items and the number of items per page.
452 my ( $nb_items, $nb_items_per_page ) = @_;
454 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
459 (@themes) = &getallthemes('opac');
460 (@themes) = &getallthemes('intranet');
462 Returns an array of all available themes.
470 if ( $type eq 'intranet' ) {
471 $htdocs = C4
::Context
->config('intrahtdocs');
474 $htdocs = C4
::Context
->config('opachtdocs');
476 opendir D
, "$htdocs";
477 my @dirlist = readdir D
;
478 foreach my $directory (@dirlist) {
479 next if $directory eq 'lib';
480 -d
"$htdocs/$directory/en" and push @themes, $directory;
487 if ( C4
::Context
->preference("marcflavour") eq "UNIMARC" ) {
492 tags
=> [ qw
/ 600ab 601ab 602a 604at 605a 606ax 610a / ],
498 tags
=> [ qw
/ 607a / ],
504 tags
=> [ qw
/ 500a 501a 503a / ],
510 tags
=> [ qw
/ 700ab 701ab 702ab / ],
511 sep
=> C4
::Context
->preference("UNIMARCAuthorsFacetsSeparator"),
516 tags
=> [ qw
/ 225a / ],
522 tags
=> [ qw
/ 995e / ],
526 unless ( Koha
::Libraries
->search->count == 1 )
528 my $DisplayLibraryFacets = C4
::Context
->preference('DisplayLibraryFacets');
529 if ( $DisplayLibraryFacets eq 'both'
530 || $DisplayLibraryFacets eq 'holding' )
535 idx
=> 'holdingbranch',
536 label
=> 'HoldingLibrary',
537 tags
=> [qw
/ 995c /],
542 if ( $DisplayLibraryFacets eq 'both'
543 || $DisplayLibraryFacets eq 'home' )
549 label
=> 'HomeLibrary',
550 tags
=> [qw
/ 995b /],
561 tags
=> [ qw
/ 650a / ],
566 # label => 'People and Organizations',
567 # tags => [ qw/ 600a 610a 611a / ],
573 tags
=> [ qw
/ 651a / ],
579 tags
=> [ qw
/ 630a / ],
585 tags
=> [ qw
/ 100a 110a 700a / ],
591 tags
=> [ qw
/ 440a 490a / ],
596 label
=> 'ItemTypes',
597 tags
=> [ qw
/ 952y 942c / ],
603 tags
=> [ qw
/ 952c / ],
607 unless ( Koha
::Libraries
->search->count == 1 )
609 my $DisplayLibraryFacets = C4
::Context
->preference('DisplayLibraryFacets');
610 if ( $DisplayLibraryFacets eq 'both'
611 || $DisplayLibraryFacets eq 'holding' )
616 idx
=> 'holdingbranch',
617 label
=> 'HoldingLibrary',
618 tags
=> [qw
/ 952b /],
623 if ( $DisplayLibraryFacets eq 'both'
624 || $DisplayLibraryFacets eq 'home' )
630 label
=> 'HomeLibrary',
631 tags
=> [qw
/ 952a /],
640 =head2 get_notforloan_label_of
642 my $notforloan_label_of = get_notforloan_label_of();
644 Each authorised value of notforloan (information available in items and
645 itemtypes) is link to a single label.
647 Returns a href where keys are authorised values and values are corresponding
650 foreach my $authorised_value (keys %{$notforloan_label_of}) {
652 "authorised_value: %s => %s\n",
654 $notforloan_label_of->{$authorised_value}
660 # FIXME - why not use GetAuthorisedValues ??
662 sub get_notforloan_label_of
{
663 my $dbh = C4
::Context
->dbh;
666 SELECT authorised_value
667 FROM marc_subfield_structure
668 WHERE kohafield = \'items.notforloan\'
671 my $sth = $dbh->prepare($query);
673 my ($statuscode) = $sth->fetchrow_array();
678 FROM authorised_values
681 $sth = $dbh->prepare($query);
682 $sth->execute($statuscode);
683 my %notforloan_label_of;
684 while ( my $row = $sth->fetchrow_hashref ) {
685 $notforloan_label_of{ $row->{authorised_value
} } = $row->{lib
};
689 return \
%notforloan_label_of;
692 =head2 GetAuthorisedValues
694 $authvalues = GetAuthorisedValues([$category]);
696 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
698 C<$category> returns authorised values for just one category (optional).
700 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
704 sub GetAuthorisedValues
{
705 my ( $category, $opac ) = @_;
707 # Is this cached already?
708 $opac = $opac ?
1 : 0; # normalise to be safe
710 C4
::Context
->userenv ? C4
::Context
->userenv->{"branch"} : "";
712 "AuthorisedValues-$category-$opac-$branch_limit";
713 my $cache = Koha
::Caches
->get_instance();
714 my $result = $cache->get_from_cache($cache_key);
715 return $result if $result;
718 my $dbh = C4
::Context
->dbh;
721 FROM authorised_values av
724 LEFT JOIN authorised_values_branches ON
( id
= av_id
)
729 push @where_strings, "category = ?";
730 push @where_args, $category;
733 push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
734 push @where_args, $branch_limit;
736 if(@where_strings > 0) {
737 $query .= " WHERE " . join(" AND ", @where_strings);
739 $query .= ' ORDER BY category, ' . (
740 $opac ?
'COALESCE(lib_opac, lib)'
744 my $sth = $dbh->prepare($query);
746 $sth->execute( @where_args );
747 while (my $data=$sth->fetchrow_hashref) {
748 if ($opac && $data->{lib_opac
}) {
749 $data->{lib
} = $data->{lib_opac
};
751 push @results, $data;
755 $cache->set_in_cache( $cache_key, \
@results, { expiry
=> 5 } );
761 my $escaped_string = C4::Koha::xml_escape($string);
763 Convert &, <, >, ', and " in a string to XML entities
769 return '' unless defined $str;
773 $str =~ s/'/'/g;
774 $str =~ s/"/"/g;
778 =head2 display_marc_indicators
780 my $display_form = C4::Koha::display_marc_indicators($field);
782 C<$field> is a MARC::Field object
784 Generate a display form of the indicators of a variable
785 MARC field, replacing any blanks with '#'.
789 sub display_marc_indicators
{
792 if ($field && $field->tag() >= 10) {
793 $indicators = $field->indicator(1) . $field->indicator(2);
794 $indicators =~ s/ /#/g;
799 sub GetNormalizedUPC
{
800 my ($marcrecord,$marcflavour) = @_;
802 return unless $marcrecord;
803 if ($marcflavour eq 'UNIMARC') {
804 my @fields = $marcrecord->field('072');
805 foreach my $field (@fields) {
806 my $upc = _normalize_match_point
($field->subfield('a'));
813 else { # assume marc21 if not unimarc
814 my @fields = $marcrecord->field('024');
815 foreach my $field (@fields) {
816 my $indicator = $field->indicator(1);
817 my $upc = _normalize_match_point
($field->subfield('a'));
818 if ($upc && $indicator == 1 ) {
825 # Normalizes and returns the first valid ISBN found in the record
826 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
827 sub GetNormalizedISBN
{
828 my ($isbn,$marcrecord,$marcflavour) = @_;
830 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
831 # anything after " | " should be removed, along with the delimiter
832 ($isbn) = split(/\|/, $isbn );
833 return _isbn_cleanup
($isbn);
836 return unless $marcrecord;
838 if ($marcflavour eq 'UNIMARC') {
839 my @fields = $marcrecord->field('010');
840 foreach my $field (@fields) {
841 my $isbn = $field->subfield('a');
843 return _isbn_cleanup
($isbn);
847 else { # assume marc21 if not unimarc
848 my @fields = $marcrecord->field('020');
849 foreach my $field (@fields) {
850 $isbn = $field->subfield('a');
852 return _isbn_cleanup
($isbn);
858 sub GetNormalizedEAN
{
859 my ($marcrecord,$marcflavour) = @_;
861 return unless $marcrecord;
863 if ($marcflavour eq 'UNIMARC') {
864 my @fields = $marcrecord->field('073');
865 foreach my $field (@fields) {
866 my $ean = _normalize_match_point
($field->subfield('a'));
872 else { # assume marc21 if not unimarc
873 my @fields = $marcrecord->field('024');
874 foreach my $field (@fields) {
875 my $indicator = $field->indicator(1);
876 my $ean = _normalize_match_point
($field->subfield('a'));
877 if ( $ean && $indicator == 3 ) {
884 sub GetNormalizedOCLCNumber
{
885 my ($marcrecord,$marcflavour) = @_;
886 return unless $marcrecord;
888 if ($marcflavour ne 'UNIMARC' ) {
889 my @fields = $marcrecord->field('035');
890 foreach my $field (@fields) {
891 my $oclc = $field->subfield('a');
892 if ($oclc =~ /OCoLC/) {
893 $oclc =~ s/\(OCoLC\)//;
903 sub GetAuthvalueDropbox
{
904 my ( $authcat, $default ) = @_;
905 my $branch_limit = C4
::Context
->userenv ? C4
::Context
->userenv->{"branch"} : "";
906 my $dbh = C4
::Context
->dbh;
910 FROM authorised_values
913 LEFT JOIN authorised_values_branches ON
( id
= av_id
)
918 $query .= " AND ( branchcode = ? OR branchcode IS NULL )" if $branch_limit;
919 $query .= " GROUP BY lib ORDER BY category, lib, lib_opac";
920 my $sth = $dbh->prepare($query);
921 $sth->execute( $authcat, $branch_limit ?
$branch_limit : () );
924 my $option_list = [];
925 my @authorised_values = ( q{} );
926 while (my $av = $sth->fetchrow_hashref) {
927 push @
{$option_list}, {
928 value
=> $av->{authorised_value
},
930 default => ($default eq $av->{authorised_value
}),
934 if ( @
{$option_list} ) {
941 =head2 GetDailyQuote($opts)
943 Takes a hashref of options
945 Currently supported options are:
947 'id' An exact quote id
948 'random' Select a random quote
949 noop When no option is passed in, this sub will return the quote timestamped for the current day
951 The function returns an anonymous hash following this format:
954 'source' => 'source-of-quote',
955 'timestamp' => 'timestamp-value',
956 'text' => 'text-of-quote',
962 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
963 # at least for default option
967 my $dbh = C4
::Context
->dbh;
972 $query = 'SELECT * FROM quotes WHERE id = ?';
973 $sth = $dbh->prepare($query);
974 $sth->execute($opts{'id'});
975 $quote = $sth->fetchrow_hashref();
977 elsif ($opts{'random'}) {
978 # Fall through... we also return a random quote as a catch-all if all else fails
981 $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
982 $sth = $dbh->prepare($query);
984 $quote = $sth->fetchrow_hashref();
986 unless ($quote) { # if there are not matches, choose a random quote
987 # get a list of all available quote ids
988 $sth = C4
::Context
->dbh->prepare('SELECT count(*) FROM quotes;');
990 my $range = ($sth->fetchrow_array)[0];
991 # chose a random id within that range if there is more than one quote
992 my $offset = int(rand($range));
994 $query = 'SELECT * FROM quotes ORDER BY id LIMIT 1 OFFSET ?';
995 $sth = C4
::Context
->dbh->prepare($query);
996 # see http://www.perlmonks.org/?node_id=837422 for why
997 # we're being verbose and using bind_param
998 $sth->bind_param(1, $offset, SQL_INTEGER
);
1000 $quote = $sth->fetchrow_hashref();
1001 # update the timestamp for that quote
1002 $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1003 $sth = C4
::Context
->dbh->prepare($query);
1005 DateTime
::Format
::MySQL
->format_datetime( dt_from_string
() ),
1012 sub _normalize_match_point
{
1013 my $match_point = shift;
1014 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1015 $normalized_match_point =~ s/-//g;
1017 return $normalized_match_point;
1022 return NormalizeISBN
(
1025 format
=> 'ISBN-10',
1031 =head2 NormalizedISBN
1033 my $isbns = NormalizedISBN({
1035 strip_hyphens => [0,1],
1036 format => ['ISBN-10', 'ISBN-13']
1039 Returns an isbn validated by Business::ISBN.
1040 Optionally strips hyphens and/or forces the isbn
1041 to be of the specified format.
1043 If the string cannot be validated as an isbn,
1051 my $string = $params->{isbn
};
1052 my $strip_hyphens = $params->{strip_hyphens
};
1053 my $format = $params->{format
};
1055 return unless $string;
1057 my $isbn = Business
::ISBN
->new($string);
1059 if ( $isbn && $isbn->is_valid() ) {
1061 if ( $format eq 'ISBN-10' ) {
1062 $isbn = $isbn->as_isbn10();
1064 elsif ( $format eq 'ISBN-13' ) {
1065 $isbn = $isbn->as_isbn13();
1067 return unless $isbn;
1069 if ($strip_hyphens) {
1070 $string = $isbn->as_string( [] );
1072 $string = $isbn->as_string();
1079 =head2 GetVariationsOfISBN
1081 my @isbns = GetVariationsOfISBN( $isbn );
1083 Returns a list of variations of the given isbn in
1084 both ISBN-10 and ISBN-13 formats, with and without
1087 In a scalar context, the isbns are returned as a
1088 string delimited by ' | '.
1092 sub GetVariationsOfISBN
{
1095 return unless $isbn;
1099 push( @isbns, NormalizeISBN
({ isbn
=> $isbn }) );
1100 push( @isbns, NormalizeISBN
({ isbn
=> $isbn, format
=> 'ISBN-10' }) );
1101 push( @isbns, NormalizeISBN
({ isbn
=> $isbn, format
=> 'ISBN-13' }) );
1102 push( @isbns, NormalizeISBN
({ isbn
=> $isbn, format
=> 'ISBN-10', strip_hyphens
=> 1 }) );
1103 push( @isbns, NormalizeISBN
({ isbn
=> $isbn, format
=> 'ISBN-13', strip_hyphens
=> 1 }) );
1105 # Strip out any "empty" strings from the array
1106 @isbns = grep { defined($_) && $_ =~ /\S/ } @isbns;
1108 return wantarray ?
@isbns : join( " | ", @isbns );
1111 =head2 GetVariationsOfISBNs
1113 my @isbns = GetVariationsOfISBNs( @isbns );
1115 Returns a list of variations of the given isbns in
1116 both ISBN-10 and ISBN-13 formats, with and without
1119 In a scalar context, the isbns are returned as a
1120 string delimited by ' | '.
1124 sub GetVariationsOfISBNs
{
1127 @isbns = map { GetVariationsOfISBN
( $_ ) } @isbns;
1129 return wantarray ?
@isbns : join( " | ", @isbns );
1132 =head2 NormalizedISSN
1134 my $issns = NormalizedISSN({
1136 strip_hyphen => [0,1]
1139 Returns an issn validated by Business::ISSN.
1140 Optionally strips hyphen.
1142 If the string cannot be validated as an issn,
1150 my $string = $params->{issn
};
1151 my $strip_hyphen = $params->{strip_hyphen
};
1153 my $issn = Business
::ISSN
->new($string);
1155 if ( $issn && $issn->is_valid ){
1157 if ($strip_hyphen) {
1158 $string = $issn->_issn;
1161 $string = $issn->as_string;
1168 =head2 GetVariationsOfISSN
1170 my @issns = GetVariationsOfISSN( $issn );
1172 Returns a list of variations of the given issn in
1173 with and without a hyphen.
1175 In a scalar context, the issns are returned as a
1176 string delimited by ' | '.
1180 sub GetVariationsOfISSN
{
1183 return unless $issn;
1186 my $str = NormalizeISSN
({ issn
=> $issn });
1189 push @issns, NormalizeISSN
({ issn
=> $issn, strip_hyphen
=> 1 });
1194 # Strip out any "empty" strings from the array
1195 @issns = grep { defined($_) && $_ =~ /\S/ } @issns;
1197 return wantarray ?
@issns : join( " | ", @issns );
1200 =head2 GetVariationsOfISSNs
1202 my @issns = GetVariationsOfISSNs( @issns );
1204 Returns a list of variations of the given issns in
1205 with and without a hyphen.
1207 In a scalar context, the issns are returned as a
1208 string delimited by ' | '.
1212 sub GetVariationsOfISSNs
{
1215 @issns = map { GetVariationsOfISSN
( $_ ) } @issns;
1217 return wantarray ?
@issns : join( " | ", @issns );
1221 =head2 IsKohaFieldLinked
1223 my $is_linked = IsKohaFieldLinked({
1224 kohafield => $kohafield,
1225 frameworkcode => $frameworkcode,
1228 Return 1 if the field is linked
1232 sub IsKohaFieldLinked
{
1233 my ( $params ) = @_;
1234 my $kohafield = $params->{kohafield
};
1235 my $frameworkcode = $params->{frameworkcode
} || '';
1236 my $dbh = C4
::Context
->dbh;
1237 my $is_linked = $dbh->selectcol_arrayref( q
|
1239 FROM marc_subfield_structure
1240 WHERE frameworkcode
= ?
1242 |,{}, $frameworkcode, $kohafield );
1243 return $is_linked->[0];