3 # Copyright 2000-2002 Katipo Communications
4 # Parts Copyright 2010 Nelsonville Public Library
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it under the
9 # terms of the GNU General Public License as published by the Free Software
10 # Foundation; either version 2 of the License, or (at your option) any later
13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License along
18 # with Koha; if not, write to the Free Software Foundation, Inc.,
19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
23 #use warnings; FIXME - Bug 2505
26 use URI::Split qw(uri_split);
30 use vars qw($VERSION @ISA @EXPORT $DEBUG);
38 &subfield_is_koha_internal_p
39 &GetPrinters &GetPrinter
40 &GetItemTypes &getitemtypeinfo
42 &GetSupportName &GetSupportList
44 &getframeworks &getframeworkinfo
45 &getauthtypes &getauthtype
51 &get_notforloan_label_of
54 &getitemtypeimagelocation
56 &GetAuthorisedValueCategories
57 &GetKohaAuthorisedValues
58 &GetKohaAuthorisedValuesFromField
59 &GetKohaAuthorisedValueLib
64 &GetNormalizedOCLCNumber
73 memoize('GetAuthorisedValues');
77 C4::Koha - Perl Module containing convenience functions for Koha scripts
85 Koha.pm provides many functions for Koha scripts.
93 $slash_date = &slashifyDate($dash_date);
95 Takes a string of the form "DD-MM-YYYY" (or anything separated by
96 dashes), converts it to the form "YYYY/MM/DD", and returns the result.
102 # accepts a date of the form xx-xx-xx[xx] and returns it in the
104 my @dateOut = split( '-', shift );
105 return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
108 # FIXME.. this should be moved to a MARC-specific module
109 sub subfield_is_koha_internal_p ($) {
112 # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
113 # But real MARC subfields are always single-character
114 # so it really is safer just to check the length
116 return length $subfield != 1;
119 =head2 GetSupportName
121 $itemtypename = &GetSupportName($codestring);
123 Returns a string with the name of the itemtype.
129 return if (! $codestring);
131 my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
132 if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
139 my $sth = C4::Context->dbh->prepare($query);
140 $sth->execute($codestring);
141 ($resultstring)=$sth->fetchrow;
142 return $resultstring;
145 C4::Context->dbh->prepare(
146 "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
148 $sth->execute( $advanced_search_types, $codestring );
149 my $data = $sth->fetchrow_hashref;
150 return $$data{'lib'};
154 =head2 GetSupportList
156 $itemtypes = &GetSupportList();
158 Returns an array ref containing informations about Support (since itemtype is rather a circulation code when item-level-itypes is used).
160 build a HTML select with the following code :
162 =head3 in PERL SCRIPT
164 my $itemtypes = GetSupportList();
165 $template->param(itemtypeloop => $itemtypes);
169 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
170 <select name="itemtype">
171 <option value="">Default</option>
172 <!-- TMPL_LOOP name="itemtypeloop" -->
173 <option value="<!-- TMPL_VAR name="itemtype" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->> <!--TMPL_IF Name="imageurl"--><img alt="<!-- TMPL_VAR name="description" -->" src="<!--TMPL_VAR Name="imageurl"-->><!--TMPL_ELSE-->"<!-- TMPL_VAR name="description" --><!--/TMPL_IF--></option>
176 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
177 <input type="submit" value="OK" class="button">
183 my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
184 if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
190 my $sth = C4::Context->dbh->prepare($query);
192 return $sth->fetchall_arrayref({});
194 my $advsearchtypes = GetAuthorisedValues($advanced_search_types);
195 my @results= map {{itemtype=>$$_{authorised_value},description=>$$_{lib},imageurl=>$$_{imageurl}}} @$advsearchtypes;
201 $itemtypes = &GetItemTypes();
203 Returns information about existing itemtypes.
205 build a HTML select with the following code :
207 =head3 in PERL SCRIPT
209 my $itemtypes = GetItemTypes;
211 foreach my $thisitemtype (sort keys %$itemtypes) {
212 my $selected = 1 if $thisitemtype eq $itemtype;
213 my %row =(value => $thisitemtype,
214 selected => $selected,
215 description => $itemtypes->{$thisitemtype}->{'description'},
217 push @itemtypesloop, \%row;
219 $template->param(itemtypeloop => \@itemtypesloop);
223 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
224 <select name="itemtype">
225 <option value="">Default</option>
226 <!-- TMPL_LOOP name="itemtypeloop" -->
227 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
230 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
231 <input type="submit" value="OK" class="button">
238 # returns a reference to a hash of references to itemtypes...
240 my $dbh = C4::Context->dbh;
245 my $sth = $dbh->prepare($query);
247 while ( my $IT = $sth->fetchrow_hashref ) {
248 $itemtypes{ $IT->{'itemtype'} } = $IT;
250 return ( \%itemtypes );
253 sub get_itemtypeinfos_of {
256 my $placeholders = join( ', ', map { '?' } @itemtypes );
257 my $query = <<"END_SQL";
263 WHERE itemtype IN ( $placeholders )
266 return get_infos_of( $query, 'itemtype', undef, \@itemtypes );
269 # this is temporary until we separate collection codes and item types
273 my $dbh = C4::Context->dbh;
276 "SELECT * FROM authorised_values ORDER BY authorised_value");
278 while ( my $data = $sth->fetchrow_hashref ) {
279 if ( $data->{category} eq "CCODE" ) {
281 $results[$count] = $data;
287 return ( $count, @results );
292 $authtypes = &getauthtypes();
294 Returns information about existing authtypes.
296 build a HTML select with the following code :
298 =head3 in PERL SCRIPT
300 my $authtypes = getauthtypes;
302 foreach my $thisauthtype (keys %$authtypes) {
303 my $selected = 1 if $thisauthtype eq $authtype;
304 my %row =(value => $thisauthtype,
305 selected => $selected,
306 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
308 push @authtypesloop, \%row;
310 $template->param(itemtypeloop => \@itemtypesloop);
314 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
315 <select name="authtype">
316 <!-- TMPL_LOOP name="authtypeloop" -->
317 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
320 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
321 <input type="submit" value="OK" class="button">
329 # returns a reference to a hash of references to authtypes...
331 my $dbh = C4::Context->dbh;
332 my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
334 while ( my $IT = $sth->fetchrow_hashref ) {
335 $authtypes{ $IT->{'authtypecode'} } = $IT;
337 return ( \%authtypes );
341 my ($authtypecode) = @_;
343 # returns a reference to a hash of references to authtypes...
345 my $dbh = C4::Context->dbh;
346 my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
347 $sth->execute($authtypecode);
348 my $res = $sth->fetchrow_hashref;
354 $frameworks = &getframework();
356 Returns information about existing frameworks
358 build a HTML select with the following code :
360 =head3 in PERL SCRIPT
362 my $frameworks = frameworks();
364 foreach my $thisframework (keys %$frameworks) {
365 my $selected = 1 if $thisframework eq $frameworkcode;
366 my %row =(value => $thisframework,
367 selected => $selected,
368 description => $frameworks->{$thisframework}->{'frameworktext'},
370 push @frameworksloop, \%row;
372 $template->param(frameworkloop => \@frameworksloop);
376 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
377 <select name="frameworkcode">
378 <option value="">Default</option>
379 <!-- TMPL_LOOP name="frameworkloop" -->
380 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
383 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
384 <input type="submit" value="OK" class="button">
391 # returns a reference to a hash of references to branches...
393 my $dbh = C4::Context->dbh;
394 my $sth = $dbh->prepare("select * from biblio_framework");
396 while ( my $IT = $sth->fetchrow_hashref ) {
397 $itemtypes{ $IT->{'frameworkcode'} } = $IT;
399 return ( \%itemtypes );
402 =head2 getframeworkinfo
404 $frameworkinfo = &getframeworkinfo($frameworkcode);
406 Returns information about an frameworkcode.
410 sub getframeworkinfo {
411 my ($frameworkcode) = @_;
412 my $dbh = C4::Context->dbh;
414 $dbh->prepare("select * from biblio_framework where frameworkcode=?");
415 $sth->execute($frameworkcode);
416 my $res = $sth->fetchrow_hashref;
420 =head2 getitemtypeinfo
422 $itemtype = &getitemtype($itemtype);
424 Returns information about an itemtype.
428 sub getitemtypeinfo {
430 my $dbh = C4::Context->dbh;
431 my $sth = $dbh->prepare("select * from itemtypes where itemtype=?");
432 $sth->execute($itemtype);
433 my $res = $sth->fetchrow_hashref;
435 $res->{imageurl} = getitemtypeimagelocation( 'intranet', $res->{imageurl} );
440 =head2 getitemtypeimagedir
442 my $directory = getitemtypeimagedir( 'opac' );
444 pass in 'opac' or 'intranet'. Defaults to 'opac'.
446 returns the full path to the appropriate directory containing images.
450 sub getitemtypeimagedir {
451 my $src = shift || 'opac';
452 if ($src eq 'intranet') {
453 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
455 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('template') . '/itemtypeimg';
459 sub getitemtypeimagesrc {
460 my $src = shift || 'opac';
461 if ($src eq 'intranet') {
462 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
464 return '/opac-tmpl' . '/' . C4::Context->preference('template') . '/itemtypeimg';
468 sub getitemtypeimagelocation($$) {
469 my ( $src, $image ) = @_;
471 return '' if ( !$image );
473 my $scheme = ( uri_split( $image ) )[0];
475 return $image if ( $scheme );
477 return getitemtypeimagesrc( $src ) . '/' . $image;
480 =head3 _getImagesFromDirectory
482 Find all of the image files in a directory in the filesystem
484 parameters: a directory name
486 returns: a list of images in that directory.
488 Notes: this does not traverse into subdirectories. See
489 _getSubdirectoryNames for help with that.
490 Images are assumed to be files with .gif or .png file extensions.
491 The image names returned do not have the directory name on them.
495 sub _getImagesFromDirectory {
496 my $directoryname = shift;
497 return unless defined $directoryname;
498 return unless -d $directoryname;
500 if ( opendir ( my $dh, $directoryname ) ) {
501 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
503 @images = sort(@images);
506 warn "unable to opendir $directoryname: $!";
511 =head3 _getSubdirectoryNames
513 Find all of the directories in a directory in the filesystem
515 parameters: a directory name
517 returns: a list of subdirectories in that directory.
519 Notes: this does not traverse into subdirectories. Only the first
520 level of subdirectories are returned.
521 The directory names returned don't have the parent directory name on them.
525 sub _getSubdirectoryNames {
526 my $directoryname = shift;
527 return unless defined $directoryname;
528 return unless -d $directoryname;
530 if ( opendir ( my $dh, $directoryname ) ) {
531 my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
535 warn "unable to opendir $directoryname: $!";
542 returns: a listref of hashrefs. Each hash represents another collection of images.
544 { imagesetname => 'npl', # the name of the image set (npl is the original one)
545 images => listref of image hashrefs
548 each image is represented by a hashref like this:
550 { KohaImage => 'npl/image.gif',
551 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
552 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
553 checked => 0 or 1: was this the image passed to this method?
554 Note: I'd like to remove this somehow.
561 my $checked = $params{'checked'} || '';
563 my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
564 url => getitemtypeimagesrc('intranet'),
566 opac => { filesystem => getitemtypeimagedir('opac'),
567 url => getitemtypeimagesrc('opac'),
571 my @imagesets = (); # list of hasrefs of image set data to pass to template
572 my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
574 foreach my $imagesubdir ( @subdirectories ) {
575 my @imagelist = (); # hashrefs of image info
576 my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
577 my $imagesetactive = 0;
578 foreach my $thisimage ( @imagenames ) {
580 { KohaImage => "$imagesubdir/$thisimage",
581 StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
582 OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
583 checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
586 $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
588 push @imagesets, { imagesetname => $imagesubdir,
589 imagesetactive => $imagesetactive,
590 images => \@imagelist };
598 $printers = &GetPrinters();
599 @queues = keys %$printers;
601 Returns information about existing printer queues.
603 C<$printers> is a reference-to-hash whose keys are the print queues
604 defined in the printers table of the Koha database. The values are
605 references-to-hash, whose keys are the fields in the printers table.
611 my $dbh = C4::Context->dbh;
612 my $sth = $dbh->prepare("select * from printers");
614 while ( my $printer = $sth->fetchrow_hashref ) {
615 $printers{ $printer->{'printqueue'} } = $printer;
617 return ( \%printers );
622 $printer = GetPrinter( $query, $printers );
626 sub GetPrinter ($$) {
627 my ( $query, $printers ) = @_; # get printer for this query from printers
628 my $printer = $query->param('printer');
629 my %cookie = $query->cookie('userenv');
630 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
631 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
637 Returns the number of pages to display in a pagination bar, given the number
638 of items and the number of items per page.
643 my ( $nb_items, $nb_items_per_page ) = @_;
645 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
650 (@themes) = &getallthemes('opac');
651 (@themes) = &getallthemes('intranet');
653 Returns an array of all available themes.
661 if ( $type eq 'intranet' ) {
662 $htdocs = C4::Context->config('intrahtdocs');
665 $htdocs = C4::Context->config('opachtdocs');
667 opendir D, "$htdocs";
668 my @dirlist = readdir D;
669 foreach my $directory (@dirlist) {
670 -d "$htdocs/$directory/en" and push @themes, $directory;
677 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
680 link_value => 'su-to',
681 label_value => 'Topics',
683 [ '600', '601', '602', '603', '604', '605', '606', '610' ],
687 link_value => 'su-geo',
688 label_value => 'Places',
693 link_value => 'su-ut',
694 label_value => 'Titles',
695 tags => [ '500', '501', '502', '503', '504', ],
700 label_value => 'Authors',
701 tags => [ '700', '701', '702', ],
706 label_value => 'Series',
715 link_value => 'branch',
716 label_value => 'Libraries',
721 push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
726 link_value => 'su-to',
727 label_value => 'Topics',
733 # link_value => 'su-na',
734 # label_value => 'People and Organizations',
735 # tags => ['600', '610', '611'],
739 link_value => 'su-geo',
740 label_value => 'Places',
745 link_value => 'su-ut',
746 label_value => 'Titles',
752 label_value => 'Authors',
753 tags => [ '100', '110', '700', ],
758 label_value => 'Series',
759 tags => [ '440', '490', ],
765 link_value => 'branch',
766 label_value => 'Libraries',
771 push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
778 Return a href where a key is associated to a href. You give a query,
779 the name of the key among the fields returned by the query. If you
780 also give as third argument the name of the value, the function
781 returns a href of scalar. The optional 4th argument is an arrayref of
782 items passed to the C<execute()> call. It is designed to bind
783 parameters to any placeholders in your SQL.
792 # generic href of any information on the item, href of href.
793 my $iteminfos_of = get_infos_of($query, 'itemnumber');
794 print $iteminfos_of->{$itemnumber}{barcode};
796 # specific information, href of scalar
797 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
798 print $barcode_of_item->{$itemnumber};
803 my ( $query, $key_name, $value_name, $bind_params ) = @_;
805 my $dbh = C4::Context->dbh;
807 my $sth = $dbh->prepare($query);
808 $sth->execute( @$bind_params );
811 while ( my $row = $sth->fetchrow_hashref ) {
812 if ( defined $value_name ) {
813 $infos_of{ $row->{$key_name} } = $row->{$value_name};
816 $infos_of{ $row->{$key_name} } = $row;
824 =head2 get_notforloan_label_of
826 my $notforloan_label_of = get_notforloan_label_of();
828 Each authorised value of notforloan (information available in items and
829 itemtypes) is link to a single label.
831 Returns a href where keys are authorised values and values are corresponding
834 foreach my $authorised_value (keys %{$notforloan_label_of}) {
836 "authorised_value: %s => %s\n",
838 $notforloan_label_of->{$authorised_value}
844 # FIXME - why not use GetAuthorisedValues ??
846 sub get_notforloan_label_of {
847 my $dbh = C4::Context->dbh;
850 SELECT authorised_value
851 FROM marc_subfield_structure
852 WHERE kohafield = \'items.notforloan\'
855 my $sth = $dbh->prepare($query);
857 my ($statuscode) = $sth->fetchrow_array();
862 FROM authorised_values
865 $sth = $dbh->prepare($query);
866 $sth->execute($statuscode);
867 my %notforloan_label_of;
868 while ( my $row = $sth->fetchrow_hashref ) {
869 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
873 return \%notforloan_label_of;
876 =head2 displayServers
878 my $servers = displayServers();
879 my $servers = displayServers( $position );
880 my $servers = displayServers( $position, $type );
882 displayServers returns a listref of hashrefs, each containing
883 information about available z3950 servers. Each hashref has a format
887 'checked' => 'checked',
888 'encoding' => 'MARC-8'
890 'id' => 'LIBRARY OF CONGRESS',
894 'value' => 'z3950.loc.gov:7090/',
901 my ( $position, $type ) = @_;
902 my $dbh = C4::Context->dbh;
904 my $strsth = 'SELECT * FROM z3950servers';
909 push @bind_params, $position;
910 push @where_clauses, ' position = ? ';
914 push @bind_params, $type;
915 push @where_clauses, ' type = ? ';
918 # reassemble where clause from where clause pieces
919 if (@where_clauses) {
920 $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
923 my $rq = $dbh->prepare($strsth);
924 $rq->execute(@bind_params);
925 my @primaryserverloop;
927 while ( my $data = $rq->fetchrow_hashref ) {
928 push @primaryserverloop,
929 { label => $data->{description},
932 value => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
933 encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
934 checked => "checked",
935 icon => $data->{icon},
936 zed => $data->{type} eq 'zed',
937 opensearch => $data->{type} eq 'opensearch'
940 return \@primaryserverloop;
943 =head2 GetAuthValCode
945 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
950 my ($kohafield,$fwcode) = @_;
951 my $dbh = C4::Context->dbh;
952 $fwcode='' unless $fwcode;
953 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
954 $sth->execute($kohafield,$fwcode);
955 my ($authvalcode) = $sth->fetchrow_array;
959 =head2 GetAuthValCodeFromField
961 $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
963 C<$subfield> can be undefined
967 sub GetAuthValCodeFromField {
968 my ($field,$subfield,$fwcode) = @_;
969 my $dbh = C4::Context->dbh;
970 $fwcode='' unless $fwcode;
972 if (defined $subfield) {
973 $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
974 $sth->execute($field,$subfield,$fwcode);
976 $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
977 $sth->execute($field,$fwcode);
979 my ($authvalcode) = $sth->fetchrow_array;
983 =head2 GetAuthorisedValues
985 $authvalues = GetAuthorisedValues([$category], [$selected]);
987 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
989 C<$category> returns authorised values for just one category (optional).
991 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
995 sub GetAuthorisedValues {
996 my ($category,$selected,$opac) = @_;
998 my $dbh = C4::Context->dbh;
999 my $query = "SELECT * FROM authorised_values";
1000 $query .= " WHERE category = '" . $category . "'" if $category;
1001 $query .= " ORDER BY category, lib, lib_opac";
1002 my $sth = $dbh->prepare($query);
1004 while (my $data=$sth->fetchrow_hashref) {
1005 if ($selected && $selected eq $data->{'authorised_value'} ) {
1006 $data->{'selected'} = 1;
1008 if ($opac && $data->{'lib_opac'}) {
1009 $data->{'lib'} = $data->{'lib_opac'};
1011 push @results, $data;
1013 #my $data = $sth->fetchall_arrayref({});
1014 return \@results; #$data;
1017 =head2 GetAuthorisedValueCategories
1019 $auth_categories = GetAuthorisedValueCategories();
1021 Return an arrayref of all of the available authorised
1026 sub GetAuthorisedValueCategories {
1027 my $dbh = C4::Context->dbh;
1028 my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1031 while (my $category = $sth->fetchrow_array) {
1032 push @results, $category;
1037 =head2 GetKohaAuthorisedValues
1039 Takes $kohafield, $fwcode as parameters.
1041 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1043 Returns hashref of Code => description
1045 Returns undef if no authorised value category is defined for the kohafield.
1049 sub GetKohaAuthorisedValues {
1050 my ($kohafield,$fwcode,$opac) = @_;
1051 $fwcode='' unless $fwcode;
1053 my $dbh = C4::Context->dbh;
1054 my $avcode = GetAuthValCode($kohafield,$fwcode);
1056 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1057 $sth->execute($avcode);
1058 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1059 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1067 =head2 GetKohaAuthorisedValuesFromField
1069 Takes $field, $subfield, $fwcode as parameters.
1071 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1072 $subfield can be undefined
1074 Returns hashref of Code => description
1076 Returns undef if no authorised value category is defined for the given field and subfield
1080 sub GetKohaAuthorisedValuesFromField {
1081 my ($field, $subfield, $fwcode,$opac) = @_;
1082 $fwcode='' unless $fwcode;
1084 my $dbh = C4::Context->dbh;
1085 my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1087 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1088 $sth->execute($avcode);
1089 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1090 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1100 my $escaped_string = C4::Koha::xml_escape($string);
1102 Convert &, <, >, ', and " in a string to XML entities
1108 return '' unless defined $str;
1109 $str =~ s/&/&/g;
1112 $str =~ s/'/'/g;
1113 $str =~ s/"/"/g;
1117 =head2 GetKohaAuthorisedValueLib
1119 Takes $category, $authorised_value as parameters.
1121 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1123 Returns authorised value description
1127 sub GetKohaAuthorisedValueLib {
1128 my ($category,$authorised_value,$opac) = @_;
1130 my $dbh = C4::Context->dbh;
1131 my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1132 $sth->execute($category,$authorised_value);
1133 my $data = $sth->fetchrow_hashref;
1134 $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1138 =head2 display_marc_indicators
1140 my $display_form = C4::Koha::display_marc_indicators($field);
1142 C<$field> is a MARC::Field object
1144 Generate a display form of the indicators of a variable
1145 MARC field, replacing any blanks with '#'.
1149 sub display_marc_indicators {
1151 my $indicators = '';
1152 if ($field->tag() >= 10) {
1153 $indicators = $field->indicator(1) . $field->indicator(2);
1154 $indicators =~ s/ /#/g;
1159 sub GetNormalizedUPC {
1160 my ($record,$marcflavour) = @_;
1163 if ($marcflavour eq 'MARC21') {
1164 @fields = $record->field('024');
1165 foreach my $field (@fields) {
1166 my $indicator = $field->indicator(1);
1167 my $upc = _normalize_match_point($field->subfield('a'));
1168 if ($indicator == 1 and $upc ne '') {
1173 else { # assume unimarc if not marc21
1174 @fields = $record->field('072');
1175 foreach my $field (@fields) {
1176 my $upc = _normalize_match_point($field->subfield('a'));
1184 # Normalizes and returns the first valid ISBN found in the record
1185 # ISBN13 are converted into ISBN10. This is required to get Amazon cover book.
1186 sub GetNormalizedISBN {
1187 my ($isbn,$record,$marcflavour) = @_;
1190 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1191 # anything after " | " should be removed, along with the delimiter
1192 $isbn =~ s/(.*)( \| )(.*)/$1/;
1193 return _isbn_cleanup($isbn);
1195 return undef unless $record;
1197 if ($marcflavour eq 'MARC21') {
1198 @fields = $record->field('020');
1199 foreach my $field (@fields) {
1200 $isbn = $field->subfield('a');
1202 return _isbn_cleanup($isbn);
1208 else { # assume unimarc if not marc21
1209 @fields = $record->field('010');
1210 foreach my $field (@fields) {
1211 my $isbn = $field->subfield('a');
1213 return _isbn_cleanup($isbn);
1222 sub GetNormalizedEAN {
1223 my ($record,$marcflavour) = @_;
1226 if ($marcflavour eq 'MARC21') {
1227 @fields = $record->field('024');
1228 foreach my $field (@fields) {
1229 my $indicator = $field->indicator(1);
1230 $ean = _normalize_match_point($field->subfield('a'));
1231 if ($indicator == 3 and $ean ne '') {
1236 else { # assume unimarc if not marc21
1237 @fields = $record->field('073');
1238 foreach my $field (@fields) {
1239 $ean = _normalize_match_point($field->subfield('a'));
1246 sub GetNormalizedOCLCNumber {
1247 my ($record,$marcflavour) = @_;
1250 if ($marcflavour eq 'MARC21') {
1251 @fields = $record->field('035');
1252 foreach my $field (@fields) {
1253 $oclc = $field->subfield('a');
1254 if ($oclc =~ /OCoLC/) {
1255 $oclc =~ s/\(OCoLC\)//;
1262 else { # TODO: add UNIMARC fields
1266 sub _normalize_match_point {
1267 my $match_point = shift;
1268 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1269 $normalized_match_point =~ s/-//g;
1271 return $normalized_match_point;
1275 my $isbn = Business::ISBN->new( $_[0] );
1277 $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13';
1278 if (defined $isbn) {
1279 return $isbn->as_string([]);