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
51 &getitemtypeimagelocation
56 &GetNormalizedOCLCNumber
69 @EXPORT_OK = qw( GetDailyQuote );
74 C4::Koha - Perl Module containing convenience functions for Koha scripts
82 Koha.pm provides many functions for Koha scripts.
90 $itemtypes = &GetItemTypes( style => $style );
92 Returns information about existing itemtypes.
95 style: either 'array' or 'hash', defaults to 'hash'.
96 'array' returns an arrayref,
97 'hash' return a hashref with the itemtype value as the key
99 build a HTML select with the following code :
101 =head3 in PERL SCRIPT
103 my $itemtypes = GetItemTypes;
105 foreach my $thisitemtype (sort keys %$itemtypes) {
106 my $selected = 1 if $thisitemtype eq $itemtype;
107 my %row =(value => $thisitemtype,
108 selected => $selected,
109 description => $itemtypes->{$thisitemtype}->{'description'},
111 push @itemtypesloop, \%row;
113 $template->param(itemtypeloop => \@itemtypesloop);
117 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
118 <select name="itemtype">
119 <option value="">Default</option>
120 <!-- TMPL_LOOP name="itemtypeloop" -->
121 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
124 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
125 <input type="submit" value="OK" class="button">
132 my $style = defined( $params{'style'} ) ?
$params{'style'} : 'hash';
134 require C4
::Languages
;
135 my $language = C4
::Languages
::getlanguage
();
136 # returns a reference to a hash of references to itemtypes...
137 my $dbh = C4
::Context
->dbh;
141 itemtypes
.description
,
142 itemtypes
.rentalcharge
,
143 itemtypes
.notforloan
,
146 itemtypes
.checkinmsg
,
147 itemtypes
.checkinmsgtype
,
148 itemtypes
.sip_media_type
,
149 itemtypes
.hideinopac
,
150 itemtypes
.searchcategory
,
151 COALESCE
( localization
.translation
, itemtypes
.description
) AS translated_description
153 LEFT JOIN localization ON itemtypes
.itemtype
= localization
.code
154 AND localization
.entity
= 'itemtypes'
155 AND localization
.lang
= ?
158 my $sth = $dbh->prepare($query);
159 $sth->execute( $language );
161 if ( $style eq 'hash' ) {
163 while ( my $IT = $sth->fetchrow_hashref ) {
164 $itemtypes{ $IT->{'itemtype'} } = $IT;
166 return ( \
%itemtypes );
168 return [ sort { lc $a->{translated_description
} cmp lc $b->{translated_description
} } @
{ $sth->fetchall_arrayref( {} ) } ];
172 =head2 GetItemTypesCategorized
174 $categories = GetItemTypesCategorized();
176 Returns a hashref containing search categories.
177 A search category will be put in the hash if at least one of its itemtypes is visible in OPAC.
178 The categories must be part of Authorized Values (ITEMTYPECAT)
182 sub GetItemTypesCategorized
{
183 my $dbh = C4
::Context
->dbh;
184 # Order is important, so that partially hidden (some items are not visible in OPAC) search
185 # categories will be visible. hideinopac=0 must be last.
187 SELECT itemtype
, description
, imageurl
, hideinopac
, 0 as
'iscat' FROM itemtypes WHERE ISNULL
(searchcategory
) or length(searchcategory
) = 0
189 SELECT DISTINCT searchcategory AS
`itemtype`,
190 authorised_values
.lib_opac AS description
,
191 authorised_values
.imageurl AS imageurl
,
192 hideinopac
, 1 as
'iscat'
194 LEFT JOIN authorised_values ON searchcategory
= authorised_value
195 WHERE searchcategory
> '' and hideinopac
=1
197 SELECT DISTINCT searchcategory AS
`itemtype`,
198 authorised_values
.lib_opac AS description
,
199 authorised_values
.imageurl AS imageurl
,
200 hideinopac
, 1 as
'iscat'
202 LEFT JOIN authorised_values ON searchcategory
= authorised_value
203 WHERE searchcategory
> '' and hideinopac
=0
205 return ($dbh->selectall_hashref($query,'itemtype'));
208 =head2 getitemtypeinfo
210 $itemtype = &getitemtypeinfo($itemtype, [$interface]);
212 Returns information about an itemtype. The optional $interface argument
213 sets which interface ('opac' or 'intranet') to return the imageurl for.
214 Defaults to intranet.
218 sub getitemtypeinfo
{
219 my ($itemtype, $interface) = @_;
220 my $dbh = C4
::Context
->dbh;
221 require C4
::Languages
;
222 my $language = C4
::Languages
::getlanguage
();
223 my $it = $dbh->selectrow_hashref(q
|
226 itemtypes
.description
,
227 itemtypes
.rentalcharge
,
228 itemtypes
.notforloan
,
231 itemtypes
.checkinmsg
,
232 itemtypes
.checkinmsgtype
,
233 itemtypes
.sip_media_type
,
234 COALESCE
( localization
.translation
, itemtypes
.description
) AS translated_description
236 LEFT JOIN localization ON itemtypes
.itemtype
= localization
.code
237 AND localization
.entity
= 'itemtypes'
238 AND localization
.lang
= ?
239 WHERE itemtypes
.itemtype
= ?
240 |, undef, $language, $itemtype );
242 $it->{imageurl
} = getitemtypeimagelocation
( ( ( defined $interface && $interface eq 'opac' ) ?
'opac' : 'intranet' ), $it->{imageurl
} );
247 =head2 getitemtypeimagedir
249 my $directory = getitemtypeimagedir( 'opac' );
251 pass in 'opac' or 'intranet'. Defaults to 'opac'.
253 returns the full path to the appropriate directory containing images.
257 sub getitemtypeimagedir
{
258 my $src = shift || 'opac';
259 if ($src eq 'intranet') {
260 return C4
::Context
->config('intrahtdocs') . '/' .C4
::Context
->preference('template') . '/img/itemtypeimg';
262 return C4
::Context
->config('opachtdocs') . '/' . C4
::Context
->preference('opacthemes') . '/itemtypeimg';
266 sub getitemtypeimagesrc
{
267 my $src = shift || 'opac';
268 if ($src eq 'intranet') {
269 return '/intranet-tmpl' . '/' . C4
::Context
->preference('template') . '/img/itemtypeimg';
271 return '/opac-tmpl' . '/' . C4
::Context
->preference('opacthemes') . '/itemtypeimg';
275 sub getitemtypeimagelocation
{
276 my ( $src, $image ) = @_;
278 return '' if ( !$image );
281 my $scheme = ( URI
::Split
::uri_split
( $image ) )[0];
283 return $image if ( $scheme );
285 return getitemtypeimagesrc
( $src ) . '/' . $image;
288 =head3 _getImagesFromDirectory
290 Find all of the image files in a directory in the filesystem
292 parameters: a directory name
294 returns: a list of images in that directory.
296 Notes: this does not traverse into subdirectories. See
297 _getSubdirectoryNames for help with that.
298 Images are assumed to be files with .gif or .png file extensions.
299 The image names returned do not have the directory name on them.
303 sub _getImagesFromDirectory
{
304 my $directoryname = shift;
305 return unless defined $directoryname;
306 return unless -d
$directoryname;
308 if ( opendir ( my $dh, $directoryname ) ) {
309 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
311 @images = sort(@images);
314 warn "unable to opendir $directoryname: $!";
319 =head3 _getSubdirectoryNames
321 Find all of the directories in a directory in the filesystem
323 parameters: a directory name
325 returns: a list of subdirectories in that directory.
327 Notes: this does not traverse into subdirectories. Only the first
328 level of subdirectories are returned.
329 The directory names returned don't have the parent directory name on them.
333 sub _getSubdirectoryNames
{
334 my $directoryname = shift;
335 return unless defined $directoryname;
336 return unless -d
$directoryname;
338 if ( opendir ( my $dh, $directoryname ) ) {
339 my @directories = grep { -d File
::Spec
->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
343 warn "unable to opendir $directoryname: $!";
350 returns: a listref of hashrefs. Each hash represents another collection of images.
352 { imagesetname => 'npl', # the name of the image set (npl is the original one)
353 images => listref of image hashrefs
356 each image is represented by a hashref like this:
358 { KohaImage => 'npl/image.gif',
359 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
360 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
361 checked => 0 or 1: was this the image passed to this method?
362 Note: I'd like to remove this somehow.
369 my $checked = $params{'checked'} || '';
371 my $paths = { staff
=> { filesystem
=> getitemtypeimagedir
('intranet'),
372 url
=> getitemtypeimagesrc
('intranet'),
374 opac
=> { filesystem
=> getitemtypeimagedir
('opac'),
375 url
=> getitemtypeimagesrc
('opac'),
379 my @imagesets = (); # list of hasrefs of image set data to pass to template
380 my @subdirectories = _getSubdirectoryNames
( $paths->{'staff'}{'filesystem'} );
381 foreach my $imagesubdir ( @subdirectories ) {
382 warn $imagesubdir if $DEBUG;
383 my @imagelist = (); # hashrefs of image info
384 my @imagenames = _getImagesFromDirectory
( File
::Spec
->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
385 my $imagesetactive = 0;
386 foreach my $thisimage ( @imagenames ) {
388 { KohaImage
=> "$imagesubdir/$thisimage",
389 StaffImageUrl
=> join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
390 OpacImageUrl
=> join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
391 checked
=> "$imagesubdir/$thisimage" eq $checked ?
1 : 0,
394 $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
396 push @imagesets, { imagesetname
=> $imagesubdir,
397 imagesetactive
=> $imagesetactive,
398 images
=> \
@imagelist };
406 $printers = &GetPrinters();
407 @queues = keys %$printers;
409 Returns information about existing printer queues.
411 C<$printers> is a reference-to-hash whose keys are the print queues
412 defined in the printers table of the Koha database. The values are
413 references-to-hash, whose keys are the fields in the printers table.
419 my $dbh = C4
::Context
->dbh;
420 my $sth = $dbh->prepare("select * from printers");
422 while ( my $printer = $sth->fetchrow_hashref ) {
423 $printers{ $printer->{'printqueue'} } = $printer;
425 return ( \
%printers );
430 $printer = GetPrinter( $query, $printers );
435 my ( $query, $printers ) = @_; # get printer for this query from printers
436 my $printer = $query->param('printer');
437 my %cookie = $query->cookie('userenv');
438 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
439 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
445 Returns the number of pages to display in a pagination bar, given the number
446 of items and the number of items per page.
451 my ( $nb_items, $nb_items_per_page ) = @_;
453 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
458 (@themes) = &getallthemes('opac');
459 (@themes) = &getallthemes('intranet');
461 Returns an array of all available themes.
469 if ( $type eq 'intranet' ) {
470 $htdocs = C4
::Context
->config('intrahtdocs');
473 $htdocs = C4
::Context
->config('opachtdocs');
475 opendir D
, "$htdocs";
476 my @dirlist = readdir D
;
477 foreach my $directory (@dirlist) {
478 next if $directory eq 'lib';
479 -d
"$htdocs/$directory/en" and push @themes, $directory;
486 if ( C4
::Context
->preference("marcflavour") eq "UNIMARC" ) {
491 tags
=> [ qw
/ 600ab 601ab 602a 604at 605a 606ax 610a / ],
497 tags
=> [ qw
/ 607a / ],
503 tags
=> [ qw
/ 500a 501a 503a / ],
509 tags
=> [ qw
/ 700ab 701ab 702ab / ],
510 sep
=> C4
::Context
->preference("UNIMARCAuthorsFacetsSeparator"),
515 tags
=> [ qw
/ 225a / ],
521 tags
=> [ qw
/ 995e / ],
525 unless ( Koha
::Libraries
->search->count == 1 )
527 my $DisplayLibraryFacets = C4
::Context
->preference('DisplayLibraryFacets');
528 if ( $DisplayLibraryFacets eq 'both'
529 || $DisplayLibraryFacets eq 'holding' )
534 idx
=> 'holdingbranch',
535 label
=> 'HoldingLibrary',
536 tags
=> [qw
/ 995c /],
541 if ( $DisplayLibraryFacets eq 'both'
542 || $DisplayLibraryFacets eq 'home' )
548 label
=> 'HomeLibrary',
549 tags
=> [qw
/ 995b /],
560 tags
=> [ qw
/ 650a / ],
565 # label => 'People and Organizations',
566 # tags => [ qw/ 600a 610a 611a / ],
572 tags
=> [ qw
/ 651a / ],
578 tags
=> [ qw
/ 630a / ],
584 tags
=> [ qw
/ 100a 110a 700a / ],
590 tags
=> [ qw
/ 440a 490a / ],
595 label
=> 'ItemTypes',
596 tags
=> [ qw
/ 952y 942c / ],
602 tags
=> [ qw
/ 952c / ],
606 unless ( Koha
::Libraries
->search->count == 1 )
608 my $DisplayLibraryFacets = C4
::Context
->preference('DisplayLibraryFacets');
609 if ( $DisplayLibraryFacets eq 'both'
610 || $DisplayLibraryFacets eq 'holding' )
615 idx
=> 'holdingbranch',
616 label
=> 'HoldingLibrary',
617 tags
=> [qw
/ 952b /],
622 if ( $DisplayLibraryFacets eq 'both'
623 || $DisplayLibraryFacets eq 'home' )
629 label
=> 'HomeLibrary',
630 tags
=> [qw
/ 952a /],
639 =head2 GetAuthorisedValues
641 $authvalues = GetAuthorisedValues([$category]);
643 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
645 C<$category> returns authorised values for just one category (optional).
647 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
651 sub GetAuthorisedValues
{
652 my ( $category, $opac ) = @_;
654 # Is this cached already?
655 $opac = $opac ?
1 : 0; # normalise to be safe
657 C4
::Context
->userenv ? C4
::Context
->userenv->{"branch"} : "";
659 "AuthorisedValues-$category-$opac-$branch_limit";
660 my $cache = Koha
::Caches
->get_instance();
661 my $result = $cache->get_from_cache($cache_key);
662 return $result if $result;
665 my $dbh = C4
::Context
->dbh;
668 FROM authorised_values av
671 LEFT JOIN authorised_values_branches ON
( id
= av_id
)
676 push @where_strings, "category = ?";
677 push @where_args, $category;
680 push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
681 push @where_args, $branch_limit;
683 if(@where_strings > 0) {
684 $query .= " WHERE " . join(" AND ", @where_strings);
686 $query .= ' ORDER BY category, ' . (
687 $opac ?
'COALESCE(lib_opac, lib)'
691 my $sth = $dbh->prepare($query);
693 $sth->execute( @where_args );
694 while (my $data=$sth->fetchrow_hashref) {
695 if ($opac && $data->{lib_opac
}) {
696 $data->{lib
} = $data->{lib_opac
};
698 push @results, $data;
702 $cache->set_in_cache( $cache_key, \
@results, { expiry
=> 5 } );
708 my $escaped_string = C4::Koha::xml_escape($string);
710 Convert &, <, >, ', and " in a string to XML entities
716 return '' unless defined $str;
720 $str =~ s/'/'/g;
721 $str =~ s/"/"/g;
725 =head2 display_marc_indicators
727 my $display_form = C4::Koha::display_marc_indicators($field);
729 C<$field> is a MARC::Field object
731 Generate a display form of the indicators of a variable
732 MARC field, replacing any blanks with '#'.
736 sub display_marc_indicators
{
739 if ($field && $field->tag() >= 10) {
740 $indicators = $field->indicator(1) . $field->indicator(2);
741 $indicators =~ s/ /#/g;
746 sub GetNormalizedUPC
{
747 my ($marcrecord,$marcflavour) = @_;
749 return unless $marcrecord;
750 if ($marcflavour eq 'UNIMARC') {
751 my @fields = $marcrecord->field('072');
752 foreach my $field (@fields) {
753 my $upc = _normalize_match_point
($field->subfield('a'));
760 else { # assume marc21 if not unimarc
761 my @fields = $marcrecord->field('024');
762 foreach my $field (@fields) {
763 my $indicator = $field->indicator(1);
764 my $upc = _normalize_match_point
($field->subfield('a'));
765 if ($upc && $indicator == 1 ) {
772 # Normalizes and returns the first valid ISBN found in the record
773 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
774 sub GetNormalizedISBN
{
775 my ($isbn,$marcrecord,$marcflavour) = @_;
777 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
778 # anything after " | " should be removed, along with the delimiter
779 ($isbn) = split(/\|/, $isbn );
780 return _isbn_cleanup
($isbn);
783 return unless $marcrecord;
785 if ($marcflavour eq 'UNIMARC') {
786 my @fields = $marcrecord->field('010');
787 foreach my $field (@fields) {
788 my $isbn = $field->subfield('a');
790 return _isbn_cleanup
($isbn);
794 else { # assume marc21 if not unimarc
795 my @fields = $marcrecord->field('020');
796 foreach my $field (@fields) {
797 $isbn = $field->subfield('a');
799 return _isbn_cleanup
($isbn);
805 sub GetNormalizedEAN
{
806 my ($marcrecord,$marcflavour) = @_;
808 return unless $marcrecord;
810 if ($marcflavour eq 'UNIMARC') {
811 my @fields = $marcrecord->field('073');
812 foreach my $field (@fields) {
813 my $ean = _normalize_match_point
($field->subfield('a'));
819 else { # assume marc21 if not unimarc
820 my @fields = $marcrecord->field('024');
821 foreach my $field (@fields) {
822 my $indicator = $field->indicator(1);
823 my $ean = _normalize_match_point
($field->subfield('a'));
824 if ( $ean && $indicator == 3 ) {
831 sub GetNormalizedOCLCNumber
{
832 my ($marcrecord,$marcflavour) = @_;
833 return unless $marcrecord;
835 if ($marcflavour ne 'UNIMARC' ) {
836 my @fields = $marcrecord->field('035');
837 foreach my $field (@fields) {
838 my $oclc = $field->subfield('a');
839 if ($oclc =~ /OCoLC/) {
840 $oclc =~ s/\(OCoLC\)//;
850 =head2 GetDailyQuote($opts)
852 Takes a hashref of options
854 Currently supported options are:
856 'id' An exact quote id
857 'random' Select a random quote
858 noop When no option is passed in, this sub will return the quote timestamped for the current day
860 The function returns an anonymous hash following this format:
863 'source' => 'source-of-quote',
864 'timestamp' => 'timestamp-value',
865 'text' => 'text-of-quote',
871 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
872 # at least for default option
876 my $dbh = C4
::Context
->dbh;
881 $query = 'SELECT * FROM quotes WHERE id = ?';
882 $sth = $dbh->prepare($query);
883 $sth->execute($opts{'id'});
884 $quote = $sth->fetchrow_hashref();
886 elsif ($opts{'random'}) {
887 # Fall through... we also return a random quote as a catch-all if all else fails
890 $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
891 $sth = $dbh->prepare($query);
893 $quote = $sth->fetchrow_hashref();
895 unless ($quote) { # if there are not matches, choose a random quote
896 # get a list of all available quote ids
897 $sth = C4
::Context
->dbh->prepare('SELECT count(*) FROM quotes;');
899 my $range = ($sth->fetchrow_array)[0];
900 # chose a random id within that range if there is more than one quote
901 my $offset = int(rand($range));
903 $query = 'SELECT * FROM quotes ORDER BY id LIMIT 1 OFFSET ?';
904 $sth = C4
::Context
->dbh->prepare($query);
905 # see http://www.perlmonks.org/?node_id=837422 for why
906 # we're being verbose and using bind_param
907 $sth->bind_param(1, $offset, SQL_INTEGER
);
909 $quote = $sth->fetchrow_hashref();
910 # update the timestamp for that quote
911 $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
912 $sth = C4
::Context
->dbh->prepare($query);
914 DateTime
::Format
::MySQL
->format_datetime( dt_from_string
() ),
921 sub _normalize_match_point
{
922 my $match_point = shift;
923 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
924 $normalized_match_point =~ s/-//g;
926 return $normalized_match_point;
931 return NormalizeISBN
(
940 =head2 NormalizedISBN
942 my $isbns = NormalizedISBN({
944 strip_hyphens => [0,1],
945 format => ['ISBN-10', 'ISBN-13']
948 Returns an isbn validated by Business::ISBN.
949 Optionally strips hyphens and/or forces the isbn
950 to be of the specified format.
952 If the string cannot be validated as an isbn,
960 my $string = $params->{isbn
};
961 my $strip_hyphens = $params->{strip_hyphens
};
962 my $format = $params->{format
};
964 return unless $string;
966 my $isbn = Business
::ISBN
->new($string);
968 if ( $isbn && $isbn->is_valid() ) {
970 if ( $format eq 'ISBN-10' ) {
971 $isbn = $isbn->as_isbn10();
973 elsif ( $format eq 'ISBN-13' ) {
974 $isbn = $isbn->as_isbn13();
978 if ($strip_hyphens) {
979 $string = $isbn->as_string( [] );
981 $string = $isbn->as_string();
988 =head2 GetVariationsOfISBN
990 my @isbns = GetVariationsOfISBN( $isbn );
992 Returns a list of variations of the given isbn in
993 both ISBN-10 and ISBN-13 formats, with and without
996 In a scalar context, the isbns are returned as a
997 string delimited by ' | '.
1001 sub GetVariationsOfISBN
{
1004 return unless $isbn;
1008 push( @isbns, NormalizeISBN
({ isbn
=> $isbn }) );
1009 push( @isbns, NormalizeISBN
({ isbn
=> $isbn, format
=> 'ISBN-10' }) );
1010 push( @isbns, NormalizeISBN
({ isbn
=> $isbn, format
=> 'ISBN-13' }) );
1011 push( @isbns, NormalizeISBN
({ isbn
=> $isbn, format
=> 'ISBN-10', strip_hyphens
=> 1 }) );
1012 push( @isbns, NormalizeISBN
({ isbn
=> $isbn, format
=> 'ISBN-13', strip_hyphens
=> 1 }) );
1014 # Strip out any "empty" strings from the array
1015 @isbns = grep { defined($_) && $_ =~ /\S/ } @isbns;
1017 return wantarray ?
@isbns : join( " | ", @isbns );
1020 =head2 GetVariationsOfISBNs
1022 my @isbns = GetVariationsOfISBNs( @isbns );
1024 Returns a list of variations of the given isbns in
1025 both ISBN-10 and ISBN-13 formats, with and without
1028 In a scalar context, the isbns are returned as a
1029 string delimited by ' | '.
1033 sub GetVariationsOfISBNs
{
1036 @isbns = map { GetVariationsOfISBN
( $_ ) } @isbns;
1038 return wantarray ?
@isbns : join( " | ", @isbns );
1041 =head2 NormalizedISSN
1043 my $issns = NormalizedISSN({
1045 strip_hyphen => [0,1]
1048 Returns an issn validated by Business::ISSN.
1049 Optionally strips hyphen.
1051 If the string cannot be validated as an issn,
1059 my $string = $params->{issn
};
1060 my $strip_hyphen = $params->{strip_hyphen
};
1062 my $issn = Business
::ISSN
->new($string);
1064 if ( $issn && $issn->is_valid ){
1066 if ($strip_hyphen) {
1067 $string = $issn->_issn;
1070 $string = $issn->as_string;
1077 =head2 GetVariationsOfISSN
1079 my @issns = GetVariationsOfISSN( $issn );
1081 Returns a list of variations of the given issn in
1082 with and without a hyphen.
1084 In a scalar context, the issns are returned as a
1085 string delimited by ' | '.
1089 sub GetVariationsOfISSN
{
1092 return unless $issn;
1095 my $str = NormalizeISSN
({ issn
=> $issn });
1098 push @issns, NormalizeISSN
({ issn
=> $issn, strip_hyphen
=> 1 });
1103 # Strip out any "empty" strings from the array
1104 @issns = grep { defined($_) && $_ =~ /\S/ } @issns;
1106 return wantarray ?
@issns : join( " | ", @issns );
1109 =head2 GetVariationsOfISSNs
1111 my @issns = GetVariationsOfISSNs( @issns );
1113 Returns a list of variations of the given issns in
1114 with and without a hyphen.
1116 In a scalar context, the issns are returned as a
1117 string delimited by ' | '.
1121 sub GetVariationsOfISSNs
{
1124 @issns = map { GetVariationsOfISSN
( $_ ) } @issns;
1126 return wantarray ?
@issns : join( " | ", @issns );
1130 =head2 IsKohaFieldLinked
1132 my $is_linked = IsKohaFieldLinked({
1133 kohafield => $kohafield,
1134 frameworkcode => $frameworkcode,
1137 Return 1 if the field is linked
1141 sub IsKohaFieldLinked
{
1142 my ( $params ) = @_;
1143 my $kohafield = $params->{kohafield
};
1144 my $frameworkcode = $params->{frameworkcode
} || '';
1145 my $dbh = C4
::Context
->dbh;
1146 my $is_linked = $dbh->selectcol_arrayref( q
|
1148 FROM marc_subfield_structure
1149 WHERE frameworkcode
= ?
1151 |,{}, $frameworkcode, $kohafield );
1152 return $is_linked->[0];