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 sub GetAuthvalueDropbox {
851 my ( $authcat, $default ) = @_;
852 my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
853 my $dbh = C4::Context->dbh;
857 FROM authorised_values
860 LEFT JOIN authorised_values_branches ON ( id = av_id )
865 $query .= " AND ( branchcode = ? OR branchcode IS NULL )" if $branch_limit;
866 $query .= " GROUP BY lib ORDER BY category, lib, lib_opac";
867 my $sth = $dbh->prepare($query);
868 $sth->execute( $authcat, $branch_limit ? $branch_limit : () );
871 my $option_list = [];
872 my @authorised_values = ( q{} );
873 while (my $av = $sth->fetchrow_hashref) {
874 push @{$option_list}, {
875 value => $av->{authorised_value},
877 default => ($default eq $av->{authorised_value}),
881 if ( @{$option_list} ) {
888 =head2 GetDailyQuote($opts)
890 Takes a hashref of options
892 Currently supported options are:
894 'id' An exact quote id
895 'random' Select a random quote
896 noop When no option is passed in, this sub will return the quote timestamped for the current day
898 The function returns an anonymous hash following this format:
901 'source' => 'source-of-quote',
902 'timestamp' => 'timestamp-value',
903 'text' => 'text-of-quote',
909 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
910 # at least for default option
914 my $dbh = C4::Context->dbh;
919 $query = 'SELECT * FROM quotes WHERE id = ?';
920 $sth = $dbh->prepare($query);
921 $sth->execute($opts{'id'});
922 $quote = $sth->fetchrow_hashref();
924 elsif ($opts{'random'}) {
925 # Fall through... we also return a random quote as a catch-all if all else fails
928 $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
929 $sth = $dbh->prepare($query);
931 $quote = $sth->fetchrow_hashref();
933 unless ($quote) { # if there are not matches, choose a random quote
934 # get a list of all available quote ids
935 $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
937 my $range = ($sth->fetchrow_array)[0];
938 # chose a random id within that range if there is more than one quote
939 my $offset = int(rand($range));
941 $query = 'SELECT * FROM quotes ORDER BY id LIMIT 1 OFFSET ?';
942 $sth = C4::Context->dbh->prepare($query);
943 # see http://www.perlmonks.org/?node_id=837422 for why
944 # we're being verbose and using bind_param
945 $sth->bind_param(1, $offset, SQL_INTEGER);
947 $quote = $sth->fetchrow_hashref();
948 # update the timestamp for that quote
949 $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
950 $sth = C4::Context->dbh->prepare($query);
952 DateTime::Format::MySQL->format_datetime( dt_from_string() ),
959 sub _normalize_match_point {
960 my $match_point = shift;
961 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
962 $normalized_match_point =~ s/-//g;
964 return $normalized_match_point;
969 return NormalizeISBN(
978 =head2 NormalizedISBN
980 my $isbns = NormalizedISBN({
982 strip_hyphens => [0,1],
983 format => ['ISBN-10', 'ISBN-13']
986 Returns an isbn validated by Business::ISBN.
987 Optionally strips hyphens and/or forces the isbn
988 to be of the specified format.
990 If the string cannot be validated as an isbn,
998 my $string = $params->{isbn};
999 my $strip_hyphens = $params->{strip_hyphens};
1000 my $format = $params->{format};
1002 return unless $string;
1004 my $isbn = Business::ISBN->new($string);
1006 if ( $isbn && $isbn->is_valid() ) {
1008 if ( $format eq 'ISBN-10' ) {
1009 $isbn = $isbn->as_isbn10();
1011 elsif ( $format eq 'ISBN-13' ) {
1012 $isbn = $isbn->as_isbn13();
1014 return unless $isbn;
1016 if ($strip_hyphens) {
1017 $string = $isbn->as_string( [] );
1019 $string = $isbn->as_string();
1026 =head2 GetVariationsOfISBN
1028 my @isbns = GetVariationsOfISBN( $isbn );
1030 Returns a list of variations of the given isbn in
1031 both ISBN-10 and ISBN-13 formats, with and without
1034 In a scalar context, the isbns are returned as a
1035 string delimited by ' | '.
1039 sub GetVariationsOfISBN {
1042 return unless $isbn;
1046 push( @isbns, NormalizeISBN({ isbn => $isbn }) );
1047 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10' }) );
1048 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13' }) );
1049 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10', strip_hyphens => 1 }) );
1050 push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13', strip_hyphens => 1 }) );
1052 # Strip out any "empty" strings from the array
1053 @isbns = grep { defined($_) && $_ =~ /\S/ } @isbns;
1055 return wantarray ? @isbns : join( " | ", @isbns );
1058 =head2 GetVariationsOfISBNs
1060 my @isbns = GetVariationsOfISBNs( @isbns );
1062 Returns a list of variations of the given isbns in
1063 both ISBN-10 and ISBN-13 formats, with and without
1066 In a scalar context, the isbns are returned as a
1067 string delimited by ' | '.
1071 sub GetVariationsOfISBNs {
1074 @isbns = map { GetVariationsOfISBN( $_ ) } @isbns;
1076 return wantarray ? @isbns : join( " | ", @isbns );
1079 =head2 NormalizedISSN
1081 my $issns = NormalizedISSN({
1083 strip_hyphen => [0,1]
1086 Returns an issn validated by Business::ISSN.
1087 Optionally strips hyphen.
1089 If the string cannot be validated as an issn,
1097 my $string = $params->{issn};
1098 my $strip_hyphen = $params->{strip_hyphen};
1100 my $issn = Business::ISSN->new($string);
1102 if ( $issn && $issn->is_valid ){
1104 if ($strip_hyphen) {
1105 $string = $issn->_issn;
1108 $string = $issn->as_string;
1115 =head2 GetVariationsOfISSN
1117 my @issns = GetVariationsOfISSN( $issn );
1119 Returns a list of variations of the given issn in
1120 with and without a hyphen.
1122 In a scalar context, the issns are returned as a
1123 string delimited by ' | '.
1127 sub GetVariationsOfISSN {
1130 return unless $issn;
1133 my $str = NormalizeISSN({ issn => $issn });
1136 push @issns, NormalizeISSN({ issn => $issn, strip_hyphen => 1 });
1141 # Strip out any "empty" strings from the array
1142 @issns = grep { defined($_) && $_ =~ /\S/ } @issns;
1144 return wantarray ? @issns : join( " | ", @issns );
1147 =head2 GetVariationsOfISSNs
1149 my @issns = GetVariationsOfISSNs( @issns );
1151 Returns a list of variations of the given issns in
1152 with and without a hyphen.
1154 In a scalar context, the issns are returned as a
1155 string delimited by ' | '.
1159 sub GetVariationsOfISSNs {
1162 @issns = map { GetVariationsOfISSN( $_ ) } @issns;
1164 return wantarray ? @issns : join( " | ", @issns );
1168 =head2 IsKohaFieldLinked
1170 my $is_linked = IsKohaFieldLinked({
1171 kohafield => $kohafield,
1172 frameworkcode => $frameworkcode,
1175 Return 1 if the field is linked
1179 sub IsKohaFieldLinked {
1180 my ( $params ) = @_;
1181 my $kohafield = $params->{kohafield};
1182 my $frameworkcode = $params->{frameworkcode} || '';
1183 my $dbh = C4::Context->dbh;
1184 my $is_linked = $dbh->selectcol_arrayref( q|
1186 FROM marc_subfield_structure
1187 WHERE frameworkcode = ?
1189 |,{}, $frameworkcode, $kohafield );
1190 return $is_linked->[0];