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);
39 &subfield_is_koha_internal_p
40 &GetPrinters &GetPrinter
41 &GetItemTypes &getitemtypeinfo
43 &GetSupportName &GetSupportList
45 &getframeworks &getframeworkinfo
46 &getauthtypes &getauthtype
52 &get_notforloan_label_of
55 &getitemtypeimagelocation
57 &GetAuthorisedValueCategories
58 &GetKohaAuthorisedValues
59 &GetKohaAuthorisedValuesFromField
60 &GetKohaAuthorisedValueLib
65 &GetNormalizedOCLCNumber
74 memoize('GetAuthorisedValues');
78 C4::Koha - Perl Module containing convenience functions for Koha scripts
86 Koha.pm provides many functions for Koha scripts.
94 $slash_date = &slashifyDate($dash_date);
96 Takes a string of the form "DD-MM-YYYY" (or anything separated by
97 dashes), converts it to the form "YYYY/MM/DD", and returns the result.
103 # accepts a date of the form xx-xx-xx[xx] and returns it in the
105 my @dateOut = split( '-', shift );
106 return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
112 my $string = DisplayISBN( $isbn );
118 if (!length ($isbn)==13 && !length ($isbn)==10) {
119 $isbn=_isbn_cleanup($isbn);
121 if (length ($isbn)<13){
123 if ( substr( $isbn, 0, 1 ) <= 7 ) {
124 $seg1 = substr( $isbn, 0, 1 );
126 elsif ( substr( $isbn, 0, 2 ) <= 94 ) {
127 $seg1 = substr( $isbn, 0, 2 );
129 elsif ( substr( $isbn, 0, 3 ) <= 995 ) {
130 $seg1 = substr( $isbn, 0, 3 );
132 elsif ( substr( $isbn, 0, 4 ) <= 9989 ) {
133 $seg1 = substr( $isbn, 0, 4 );
136 $seg1 = substr( $isbn, 0, 5 );
138 my $x = substr( $isbn, length($seg1) );
140 if ( substr( $x, 0, 2 ) <= 19 ) {
142 # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
143 $seg2 = substr( $x, 0, 2 );
145 elsif ( substr( $x, 0, 3 ) <= 699 ) {
146 $seg2 = substr( $x, 0, 3 );
148 elsif ( substr( $x, 0, 4 ) <= 8399 ) {
149 $seg2 = substr( $x, 0, 4 );
151 elsif ( substr( $x, 0, 5 ) <= 89999 ) {
152 $seg2 = substr( $x, 0, 5 );
154 elsif ( substr( $x, 0, 6 ) <= 9499999 ) {
155 $seg2 = substr( $x, 0, 6 );
158 $seg2 = substr( $x, 0, 7 );
160 my $seg3 = substr( $x, length($seg2) );
161 $seg3 = substr( $seg3, 0, length($seg3) - 1 );
162 my $seg4 = substr( $x, -1, 1 );
163 return "$seg1-$seg2-$seg3-$seg4";
166 $seg1 = substr( $isbn, 0, 3 );
168 if ( substr( $isbn, 3, 1 ) <= 7 ) {
169 $seg2 = substr( $isbn, 3, 1 );
171 elsif ( substr( $isbn, 3, 2 ) <= 94 ) {
172 $seg2 = substr( $isbn, 3, 2 );
174 elsif ( substr( $isbn, 3, 3 ) <= 995 ) {
175 $seg2 = substr( $isbn, 3, 3 );
177 elsif ( substr( $isbn, 3, 4 ) <= 9989 ) {
178 $seg2 = substr( $isbn, 3, 4 );
181 $seg2 = substr( $isbn, 3, 5 );
183 my $x = substr( $isbn, length($seg2) +3);
185 if ( substr( $x, 0, 2 ) <= 19 ) {
187 # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
188 $seg3 = substr( $x, 0, 2 );
190 elsif ( substr( $x, 0, 3 ) <= 699 ) {
191 $seg3 = substr( $x, 0, 3 );
193 elsif ( substr( $x, 0, 4 ) <= 8399 ) {
194 $seg3 = substr( $x, 0, 4 );
196 elsif ( substr( $x, 0, 5 ) <= 89999 ) {
197 $seg3 = substr( $x, 0, 5 );
199 elsif ( substr( $x, 0, 6 ) <= 9499999 ) {
200 $seg3 = substr( $x, 0, 6 );
203 $seg3 = substr( $x, 0, 7 );
205 my $seg4 = substr( $x, length($seg3) );
206 $seg4 = substr( $seg4, 0, length($seg4) - 1 );
207 my $seg5 = substr( $x, -1, 1 );
208 return "$seg1-$seg2-$seg3-$seg4-$seg5";
212 # FIXME.. this should be moved to a MARC-specific module
213 sub subfield_is_koha_internal_p ($) {
216 # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
217 # But real MARC subfields are always single-character
218 # so it really is safer just to check the length
220 return length $subfield != 1;
223 =head2 GetSupportName
225 $itemtypename = &GetSupportName($codestring);
227 Returns a string with the name of the itemtype.
233 return if (! $codestring);
235 my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
236 if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
243 my $sth = C4::Context->dbh->prepare($query);
244 $sth->execute($codestring);
245 ($resultstring)=$sth->fetchrow;
246 return $resultstring;
249 C4::Context->dbh->prepare(
250 "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
252 $sth->execute( $advanced_search_types, $codestring );
253 my $data = $sth->fetchrow_hashref;
254 return $$data{'lib'};
258 =head2 GetSupportList
260 $itemtypes = &GetSupportList();
262 Returns an array ref containing informations about Support (since itemtype is rather a circulation code when item-level-itypes is used).
264 build a HTML select with the following code :
266 =head3 in PERL SCRIPT
268 my $itemtypes = GetSupportList();
269 $template->param(itemtypeloop => $itemtypes);
273 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
274 <select name="itemtype">
275 <option value="">Default</option>
276 <!-- TMPL_LOOP name="itemtypeloop" -->
277 <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>
280 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
281 <input type="submit" value="OK" class="button">
287 my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
288 if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
294 my $sth = C4::Context->dbh->prepare($query);
296 return $sth->fetchall_arrayref({});
298 my $advsearchtypes = GetAuthorisedValues($advanced_search_types);
299 my @results= map {{itemtype=>$$_{authorised_value},description=>$$_{lib},imageurl=>$$_{imageurl}}} @$advsearchtypes;
305 $itemtypes = &GetItemTypes();
307 Returns information about existing itemtypes.
309 build a HTML select with the following code :
311 =head3 in PERL SCRIPT
313 my $itemtypes = GetItemTypes;
315 foreach my $thisitemtype (sort keys %$itemtypes) {
316 my $selected = 1 if $thisitemtype eq $itemtype;
317 my %row =(value => $thisitemtype,
318 selected => $selected,
319 description => $itemtypes->{$thisitemtype}->{'description'},
321 push @itemtypesloop, \%row;
323 $template->param(itemtypeloop => \@itemtypesloop);
327 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
328 <select name="itemtype">
329 <option value="">Default</option>
330 <!-- TMPL_LOOP name="itemtypeloop" -->
331 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
334 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
335 <input type="submit" value="OK" class="button">
342 # returns a reference to a hash of references to itemtypes...
344 my $dbh = C4::Context->dbh;
349 my $sth = $dbh->prepare($query);
351 while ( my $IT = $sth->fetchrow_hashref ) {
352 $itemtypes{ $IT->{'itemtype'} } = $IT;
354 return ( \%itemtypes );
357 sub get_itemtypeinfos_of {
360 my $placeholders = join( ', ', map { '?' } @itemtypes );
361 my $query = <<"END_SQL";
367 WHERE itemtype IN ( $placeholders )
370 return get_infos_of( $query, 'itemtype', undef, \@itemtypes );
373 # this is temporary until we separate collection codes and item types
377 my $dbh = C4::Context->dbh;
380 "SELECT * FROM authorised_values ORDER BY authorised_value");
382 while ( my $data = $sth->fetchrow_hashref ) {
383 if ( $data->{category} eq "CCODE" ) {
385 $results[$count] = $data;
391 return ( $count, @results );
396 $authtypes = &getauthtypes();
398 Returns information about existing authtypes.
400 build a HTML select with the following code :
402 =head3 in PERL SCRIPT
404 my $authtypes = getauthtypes;
406 foreach my $thisauthtype (keys %$authtypes) {
407 my $selected = 1 if $thisauthtype eq $authtype;
408 my %row =(value => $thisauthtype,
409 selected => $selected,
410 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
412 push @authtypesloop, \%row;
414 $template->param(itemtypeloop => \@itemtypesloop);
418 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
419 <select name="authtype">
420 <!-- TMPL_LOOP name="authtypeloop" -->
421 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
424 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
425 <input type="submit" value="OK" class="button">
433 # returns a reference to a hash of references to authtypes...
435 my $dbh = C4::Context->dbh;
436 my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
438 while ( my $IT = $sth->fetchrow_hashref ) {
439 $authtypes{ $IT->{'authtypecode'} } = $IT;
441 return ( \%authtypes );
445 my ($authtypecode) = @_;
447 # returns a reference to a hash of references to authtypes...
449 my $dbh = C4::Context->dbh;
450 my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
451 $sth->execute($authtypecode);
452 my $res = $sth->fetchrow_hashref;
458 $frameworks = &getframework();
460 Returns information about existing frameworks
462 build a HTML select with the following code :
464 =head3 in PERL SCRIPT
466 my $frameworks = frameworks();
468 foreach my $thisframework (keys %$frameworks) {
469 my $selected = 1 if $thisframework eq $frameworkcode;
470 my %row =(value => $thisframework,
471 selected => $selected,
472 description => $frameworks->{$thisframework}->{'frameworktext'},
474 push @frameworksloop, \%row;
476 $template->param(frameworkloop => \@frameworksloop);
480 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
481 <select name="frameworkcode">
482 <option value="">Default</option>
483 <!-- TMPL_LOOP name="frameworkloop" -->
484 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
487 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
488 <input type="submit" value="OK" class="button">
495 # returns a reference to a hash of references to branches...
497 my $dbh = C4::Context->dbh;
498 my $sth = $dbh->prepare("select * from biblio_framework");
500 while ( my $IT = $sth->fetchrow_hashref ) {
501 $itemtypes{ $IT->{'frameworkcode'} } = $IT;
503 return ( \%itemtypes );
506 =head2 getframeworkinfo
508 $frameworkinfo = &getframeworkinfo($frameworkcode);
510 Returns information about an frameworkcode.
514 sub getframeworkinfo {
515 my ($frameworkcode) = @_;
516 my $dbh = C4::Context->dbh;
518 $dbh->prepare("select * from biblio_framework where frameworkcode=?");
519 $sth->execute($frameworkcode);
520 my $res = $sth->fetchrow_hashref;
524 =head2 getitemtypeinfo
526 $itemtype = &getitemtype($itemtype);
528 Returns information about an itemtype.
532 sub getitemtypeinfo {
534 my $dbh = C4::Context->dbh;
535 my $sth = $dbh->prepare("select * from itemtypes where itemtype=?");
536 $sth->execute($itemtype);
537 my $res = $sth->fetchrow_hashref;
539 $res->{imageurl} = getitemtypeimagelocation( 'intranet', $res->{imageurl} );
544 =head2 getitemtypeimagedir
546 my $directory = getitemtypeimagedir( 'opac' );
548 pass in 'opac' or 'intranet'. Defaults to 'opac'.
550 returns the full path to the appropriate directory containing images.
554 sub getitemtypeimagedir {
555 my $src = shift || 'opac';
556 if ($src eq 'intranet') {
557 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
559 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('template') . '/itemtypeimg';
563 sub getitemtypeimagesrc {
564 my $src = shift || 'opac';
565 if ($src eq 'intranet') {
566 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
568 return '/opac-tmpl' . '/' . C4::Context->preference('template') . '/itemtypeimg';
572 sub getitemtypeimagelocation($$) {
573 my ( $src, $image ) = @_;
575 return '' if ( !$image );
577 my $scheme = ( uri_split( $image ) )[0];
579 return $image if ( $scheme );
581 return getitemtypeimagesrc( $src ) . '/' . $image;
584 =head3 _getImagesFromDirectory
586 Find all of the image files in a directory in the filesystem
588 parameters: a directory name
590 returns: a list of images in that directory.
592 Notes: this does not traverse into subdirectories. See
593 _getSubdirectoryNames for help with that.
594 Images are assumed to be files with .gif or .png file extensions.
595 The image names returned do not have the directory name on them.
599 sub _getImagesFromDirectory {
600 my $directoryname = shift;
601 return unless defined $directoryname;
602 return unless -d $directoryname;
604 if ( opendir ( my $dh, $directoryname ) ) {
605 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
607 @images = sort(@images);
610 warn "unable to opendir $directoryname: $!";
615 =head3 _getSubdirectoryNames
617 Find all of the directories in a directory in the filesystem
619 parameters: a directory name
621 returns: a list of subdirectories in that directory.
623 Notes: this does not traverse into subdirectories. Only the first
624 level of subdirectories are returned.
625 The directory names returned don't have the parent directory name on them.
629 sub _getSubdirectoryNames {
630 my $directoryname = shift;
631 return unless defined $directoryname;
632 return unless -d $directoryname;
634 if ( opendir ( my $dh, $directoryname ) ) {
635 my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
639 warn "unable to opendir $directoryname: $!";
646 returns: a listref of hashrefs. Each hash represents another collection of images.
648 { imagesetname => 'npl', # the name of the image set (npl is the original one)
649 images => listref of image hashrefs
652 each image is represented by a hashref like this:
654 { KohaImage => 'npl/image.gif',
655 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
656 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
657 checked => 0 or 1: was this the image passed to this method?
658 Note: I'd like to remove this somehow.
665 my $checked = $params{'checked'} || '';
667 my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
668 url => getitemtypeimagesrc('intranet'),
670 opac => { filesystem => getitemtypeimagedir('opac'),
671 url => getitemtypeimagesrc('opac'),
675 my @imagesets = (); # list of hasrefs of image set data to pass to template
676 my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
678 foreach my $imagesubdir ( @subdirectories ) {
679 my @imagelist = (); # hashrefs of image info
680 my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
681 my $imagesetactive = 0;
682 foreach my $thisimage ( @imagenames ) {
684 { KohaImage => "$imagesubdir/$thisimage",
685 StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
686 OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
687 checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
690 $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
692 push @imagesets, { imagesetname => $imagesubdir,
693 imagesetactive => $imagesetactive,
694 images => \@imagelist };
702 $printers = &GetPrinters();
703 @queues = keys %$printers;
705 Returns information about existing printer queues.
707 C<$printers> is a reference-to-hash whose keys are the print queues
708 defined in the printers table of the Koha database. The values are
709 references-to-hash, whose keys are the fields in the printers table.
715 my $dbh = C4::Context->dbh;
716 my $sth = $dbh->prepare("select * from printers");
718 while ( my $printer = $sth->fetchrow_hashref ) {
719 $printers{ $printer->{'printqueue'} } = $printer;
721 return ( \%printers );
726 $printer = GetPrinter( $query, $printers );
730 sub GetPrinter ($$) {
731 my ( $query, $printers ) = @_; # get printer for this query from printers
732 my $printer = $query->param('printer');
733 my %cookie = $query->cookie('userenv');
734 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
735 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
741 Returns the number of pages to display in a pagination bar, given the number
742 of items and the number of items per page.
747 my ( $nb_items, $nb_items_per_page ) = @_;
749 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
754 (@themes) = &getallthemes('opac');
755 (@themes) = &getallthemes('intranet');
757 Returns an array of all available themes.
765 if ( $type eq 'intranet' ) {
766 $htdocs = C4::Context->config('intrahtdocs');
769 $htdocs = C4::Context->config('opachtdocs');
771 opendir D, "$htdocs";
772 my @dirlist = readdir D;
773 foreach my $directory (@dirlist) {
774 -d "$htdocs/$directory/en" and push @themes, $directory;
781 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
784 link_value => 'su-to',
785 label_value => 'Topics',
787 [ '600', '601', '602', '603', '604', '605', '606', '610' ],
791 link_value => 'su-geo',
792 label_value => 'Places',
797 link_value => 'su-ut',
798 label_value => 'Titles',
799 tags => [ '500', '501', '502', '503', '504', ],
804 label_value => 'Authors',
805 tags => [ '700', '701', '702', ],
810 label_value => 'Series',
819 link_value => 'branch',
820 label_value => 'Libraries',
825 push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
830 link_value => 'su-to',
831 label_value => 'Topics',
837 # link_value => 'su-na',
838 # label_value => 'People and Organizations',
839 # tags => ['600', '610', '611'],
843 link_value => 'su-geo',
844 label_value => 'Places',
849 link_value => 'su-ut',
850 label_value => 'Titles',
856 label_value => 'Authors',
857 tags => [ '100', '110', '700', ],
862 label_value => 'Series',
863 tags => [ '440', '490', ],
869 link_value => 'branch',
870 label_value => 'Libraries',
875 push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
882 Return a href where a key is associated to a href. You give a query,
883 the name of the key among the fields returned by the query. If you
884 also give as third argument the name of the value, the function
885 returns a href of scalar. The optional 4th argument is an arrayref of
886 items passed to the C<execute()> call. It is designed to bind
887 parameters to any placeholders in your SQL.
896 # generic href of any information on the item, href of href.
897 my $iteminfos_of = get_infos_of($query, 'itemnumber');
898 print $iteminfos_of->{$itemnumber}{barcode};
900 # specific information, href of scalar
901 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
902 print $barcode_of_item->{$itemnumber};
907 my ( $query, $key_name, $value_name, $bind_params ) = @_;
909 my $dbh = C4::Context->dbh;
911 my $sth = $dbh->prepare($query);
912 $sth->execute( @$bind_params );
915 while ( my $row = $sth->fetchrow_hashref ) {
916 if ( defined $value_name ) {
917 $infos_of{ $row->{$key_name} } = $row->{$value_name};
920 $infos_of{ $row->{$key_name} } = $row;
928 =head2 get_notforloan_label_of
930 my $notforloan_label_of = get_notforloan_label_of();
932 Each authorised value of notforloan (information available in items and
933 itemtypes) is link to a single label.
935 Returns a href where keys are authorised values and values are corresponding
938 foreach my $authorised_value (keys %{$notforloan_label_of}) {
940 "authorised_value: %s => %s\n",
942 $notforloan_label_of->{$authorised_value}
948 # FIXME - why not use GetAuthorisedValues ??
950 sub get_notforloan_label_of {
951 my $dbh = C4::Context->dbh;
954 SELECT authorised_value
955 FROM marc_subfield_structure
956 WHERE kohafield = \'items.notforloan\'
959 my $sth = $dbh->prepare($query);
961 my ($statuscode) = $sth->fetchrow_array();
966 FROM authorised_values
969 $sth = $dbh->prepare($query);
970 $sth->execute($statuscode);
971 my %notforloan_label_of;
972 while ( my $row = $sth->fetchrow_hashref ) {
973 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
977 return \%notforloan_label_of;
980 =head2 displayServers
982 my $servers = displayServers();
983 my $servers = displayServers( $position );
984 my $servers = displayServers( $position, $type );
986 displayServers returns a listref of hashrefs, each containing
987 information about available z3950 servers. Each hashref has a format
991 'checked' => 'checked',
992 'encoding' => 'MARC-8'
994 'id' => 'LIBRARY OF CONGRESS',
998 'value' => 'z3950.loc.gov:7090/',
1004 sub displayServers {
1005 my ( $position, $type ) = @_;
1006 my $dbh = C4::Context->dbh;
1008 my $strsth = 'SELECT * FROM z3950servers';
1013 push @bind_params, $position;
1014 push @where_clauses, ' position = ? ';
1018 push @bind_params, $type;
1019 push @where_clauses, ' type = ? ';
1022 # reassemble where clause from where clause pieces
1023 if (@where_clauses) {
1024 $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
1027 my $rq = $dbh->prepare($strsth);
1028 $rq->execute(@bind_params);
1029 my @primaryserverloop;
1031 while ( my $data = $rq->fetchrow_hashref ) {
1032 push @primaryserverloop,
1033 { label => $data->{description},
1034 id => $data->{name},
1036 value => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
1037 encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
1038 checked => "checked",
1039 icon => $data->{icon},
1040 zed => $data->{type} eq 'zed',
1041 opensearch => $data->{type} eq 'opensearch'
1044 return \@primaryserverloop;
1047 =head2 GetAuthValCode
1049 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
1053 sub GetAuthValCode {
1054 my ($kohafield,$fwcode) = @_;
1055 my $dbh = C4::Context->dbh;
1056 $fwcode='' unless $fwcode;
1057 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
1058 $sth->execute($kohafield,$fwcode);
1059 my ($authvalcode) = $sth->fetchrow_array;
1060 return $authvalcode;
1063 =head2 GetAuthValCodeFromField
1065 $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
1067 C<$subfield> can be undefined
1071 sub GetAuthValCodeFromField {
1072 my ($field,$subfield,$fwcode) = @_;
1073 my $dbh = C4::Context->dbh;
1074 $fwcode='' unless $fwcode;
1076 if (defined $subfield) {
1077 $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
1078 $sth->execute($field,$subfield,$fwcode);
1080 $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
1081 $sth->execute($field,$fwcode);
1083 my ($authvalcode) = $sth->fetchrow_array;
1084 return $authvalcode;
1087 =head2 GetAuthorisedValues
1089 $authvalues = GetAuthorisedValues([$category], [$selected]);
1091 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
1093 C<$category> returns authorised values for just one category (optional).
1095 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1099 sub GetAuthorisedValues {
1100 my ($category,$selected,$opac) = @_;
1102 my $dbh = C4::Context->dbh;
1103 my $query = "SELECT * FROM authorised_values";
1104 $query .= " WHERE category = '" . $category . "'" if $category;
1105 $query .= " ORDER BY category, lib, lib_opac";
1106 my $sth = $dbh->prepare($query);
1108 while (my $data=$sth->fetchrow_hashref) {
1109 if ($selected && $selected eq $data->{'authorised_value'} ) {
1110 $data->{'selected'} = 1;
1112 if ($opac && $data->{'lib_opac'}) {
1113 $data->{'lib'} = $data->{'lib_opac'};
1115 push @results, $data;
1117 #my $data = $sth->fetchall_arrayref({});
1118 return \@results; #$data;
1121 =head2 GetAuthorisedValueCategories
1123 $auth_categories = GetAuthorisedValueCategories();
1125 Return an arrayref of all of the available authorised
1130 sub GetAuthorisedValueCategories {
1131 my $dbh = C4::Context->dbh;
1132 my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1135 while (my $category = $sth->fetchrow_array) {
1136 push @results, $category;
1141 =head2 GetKohaAuthorisedValues
1143 Takes $kohafield, $fwcode as parameters.
1145 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1147 Returns hashref of Code => description
1149 Returns undef if no authorised value category is defined for the kohafield.
1153 sub GetKohaAuthorisedValues {
1154 my ($kohafield,$fwcode,$opac) = @_;
1155 $fwcode='' unless $fwcode;
1157 my $dbh = C4::Context->dbh;
1158 my $avcode = GetAuthValCode($kohafield,$fwcode);
1160 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1161 $sth->execute($avcode);
1162 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1163 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1171 =head2 GetKohaAuthorisedValuesFromField
1173 Takes $field, $subfield, $fwcode as parameters.
1175 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1176 $subfield can be undefined
1178 Returns hashref of Code => description
1180 Returns undef if no authorised value category is defined for the given field and subfield
1184 sub GetKohaAuthorisedValuesFromField {
1185 my ($field, $subfield, $fwcode,$opac) = @_;
1186 $fwcode='' unless $fwcode;
1188 my $dbh = C4::Context->dbh;
1189 my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1191 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1192 $sth->execute($avcode);
1193 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1194 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1204 my $escaped_string = C4::Koha::xml_escape($string);
1206 Convert &, <, >, ', and " in a string to XML entities
1212 return '' unless defined $str;
1213 $str =~ s/&/&/g;
1216 $str =~ s/'/'/g;
1217 $str =~ s/"/"/g;
1221 =head2 GetKohaAuthorisedValueLib
1223 Takes $category, $authorised_value as parameters.
1225 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1227 Returns authorised value description
1231 sub GetKohaAuthorisedValueLib {
1232 my ($category,$authorised_value,$opac) = @_;
1234 my $dbh = C4::Context->dbh;
1235 my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1236 $sth->execute($category,$authorised_value);
1237 my $data = $sth->fetchrow_hashref;
1238 $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1242 =head2 display_marc_indicators
1244 my $display_form = C4::Koha::display_marc_indicators($field);
1246 C<$field> is a MARC::Field object
1248 Generate a display form of the indicators of a variable
1249 MARC field, replacing any blanks with '#'.
1253 sub display_marc_indicators {
1255 my $indicators = '';
1256 if ($field->tag() >= 10) {
1257 $indicators = $field->indicator(1) . $field->indicator(2);
1258 $indicators =~ s/ /#/g;
1263 sub GetNormalizedUPC {
1264 my ($record,$marcflavour) = @_;
1267 if ($marcflavour eq 'MARC21') {
1268 @fields = $record->field('024');
1269 foreach my $field (@fields) {
1270 my $indicator = $field->indicator(1);
1271 my $upc = _normalize_match_point($field->subfield('a'));
1272 if ($indicator == 1 and $upc ne '') {
1277 else { # assume unimarc if not marc21
1278 @fields = $record->field('072');
1279 foreach my $field (@fields) {
1280 my $upc = _normalize_match_point($field->subfield('a'));
1288 # Normalizes and returns the first valid ISBN found in the record
1289 # ISBN13 are converted into ISBN10. This is required to get Amazon cover book.
1290 sub GetNormalizedISBN {
1291 my ($isbn,$record,$marcflavour) = @_;
1294 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1295 # anything after " | " should be removed, along with the delimiter
1296 $isbn =~ s/(.*)( \| )(.*)/$1/;
1297 return _isbn_cleanup($isbn);
1299 return undef unless $record;
1301 if ($marcflavour eq 'MARC21') {
1302 @fields = $record->field('020');
1303 foreach my $field (@fields) {
1304 $isbn = $field->subfield('a');
1306 return _isbn_cleanup($isbn);
1312 else { # assume unimarc if not marc21
1313 @fields = $record->field('010');
1314 foreach my $field (@fields) {
1315 my $isbn = $field->subfield('a');
1317 return _isbn_cleanup($isbn);
1326 sub GetNormalizedEAN {
1327 my ($record,$marcflavour) = @_;
1330 if ($marcflavour eq 'MARC21') {
1331 @fields = $record->field('024');
1332 foreach my $field (@fields) {
1333 my $indicator = $field->indicator(1);
1334 $ean = _normalize_match_point($field->subfield('a'));
1335 if ($indicator == 3 and $ean ne '') {
1340 else { # assume unimarc if not marc21
1341 @fields = $record->field('073');
1342 foreach my $field (@fields) {
1343 $ean = _normalize_match_point($field->subfield('a'));
1350 sub GetNormalizedOCLCNumber {
1351 my ($record,$marcflavour) = @_;
1354 if ($marcflavour eq 'MARC21') {
1355 @fields = $record->field('035');
1356 foreach my $field (@fields) {
1357 $oclc = $field->subfield('a');
1358 if ($oclc =~ /OCoLC/) {
1359 $oclc =~ s/\(OCoLC\)//;
1366 else { # TODO: add UNIMARC fields
1370 sub _normalize_match_point {
1371 my $match_point = shift;
1372 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1373 $normalized_match_point =~ s/-//g;
1375 return $normalized_match_point;
1379 my $isbn = Business::ISBN->new( $_[0] );
1381 $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13';
1382 if (defined $isbn) {
1383 return $isbn->as_string([]);