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
60 &GetAuthorisedValueByCode
61 &GetKohaImageurlFromAuthorisedValues
66 &GetNormalizedOCLCNumber
75 memoize('GetAuthorisedValues');
79 C4::Koha - Perl Module containing convenience functions for Koha scripts
87 Koha.pm provides many functions for Koha scripts.
95 $slash_date = &slashifyDate($dash_date);
97 Takes a string of the form "DD-MM-YYYY" (or anything separated by
98 dashes), converts it to the form "YYYY/MM/DD", and returns the result.
104 # accepts a date of the form xx-xx-xx[xx] and returns it in the
106 my @dateOut = split( '-', shift );
107 return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
110 # FIXME.. this should be moved to a MARC-specific module
111 sub subfield_is_koha_internal_p ($) {
114 # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
115 # But real MARC subfields are always single-character
116 # so it really is safer just to check the length
118 return length $subfield != 1;
121 =head2 GetSupportName
123 $itemtypename = &GetSupportName($codestring);
125 Returns a string with the name of the itemtype.
131 return if (! $codestring);
133 my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
134 if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
141 my $sth = C4::Context->dbh->prepare($query);
142 $sth->execute($codestring);
143 ($resultstring)=$sth->fetchrow;
144 return $resultstring;
147 C4::Context->dbh->prepare(
148 "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
150 $sth->execute( $advanced_search_types, $codestring );
151 my $data = $sth->fetchrow_hashref;
152 return $$data{'lib'};
156 =head2 GetSupportList
158 $itemtypes = &GetSupportList();
160 Returns an array ref containing informations about Support (since itemtype is rather a circulation code when item-level-itypes is used).
162 build a HTML select with the following code :
164 =head3 in PERL SCRIPT
166 my $itemtypes = GetSupportList();
167 $template->param(itemtypeloop => $itemtypes);
171 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
172 <select name="itemtype">
173 <option value="">Default</option>
174 <!-- TMPL_LOOP name="itemtypeloop" -->
175 <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>
178 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
179 <input type="submit" value="OK" class="button">
185 my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
186 if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
192 my $sth = C4::Context->dbh->prepare($query);
194 return $sth->fetchall_arrayref({});
196 my $advsearchtypes = GetAuthorisedValues($advanced_search_types);
197 my @results= map {{itemtype=>$$_{authorised_value},description=>$$_{lib},imageurl=>$$_{imageurl}}} @$advsearchtypes;
203 $itemtypes = &GetItemTypes();
205 Returns information about existing itemtypes.
207 build a HTML select with the following code :
209 =head3 in PERL SCRIPT
211 my $itemtypes = GetItemTypes;
213 foreach my $thisitemtype (sort keys %$itemtypes) {
214 my $selected = 1 if $thisitemtype eq $itemtype;
215 my %row =(value => $thisitemtype,
216 selected => $selected,
217 description => $itemtypes->{$thisitemtype}->{'description'},
219 push @itemtypesloop, \%row;
221 $template->param(itemtypeloop => \@itemtypesloop);
225 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
226 <select name="itemtype">
227 <option value="">Default</option>
228 <!-- TMPL_LOOP name="itemtypeloop" -->
229 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
232 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
233 <input type="submit" value="OK" class="button">
240 # returns a reference to a hash of references to itemtypes...
242 my $dbh = C4::Context->dbh;
247 my $sth = $dbh->prepare($query);
249 while ( my $IT = $sth->fetchrow_hashref ) {
250 $itemtypes{ $IT->{'itemtype'} } = $IT;
252 return ( \%itemtypes );
255 sub get_itemtypeinfos_of {
258 my $placeholders = join( ', ', map { '?' } @itemtypes );
259 my $query = <<"END_SQL";
265 WHERE itemtype IN ( $placeholders )
268 return get_infos_of( $query, 'itemtype', undef, \@itemtypes );
271 # this is temporary until we separate collection codes and item types
275 my $dbh = C4::Context->dbh;
278 "SELECT * FROM authorised_values ORDER BY authorised_value");
280 while ( my $data = $sth->fetchrow_hashref ) {
281 if ( $data->{category} eq "CCODE" ) {
283 $results[$count] = $data;
289 return ( $count, @results );
294 $authtypes = &getauthtypes();
296 Returns information about existing authtypes.
298 build a HTML select with the following code :
300 =head3 in PERL SCRIPT
302 my $authtypes = getauthtypes;
304 foreach my $thisauthtype (keys %$authtypes) {
305 my $selected = 1 if $thisauthtype eq $authtype;
306 my %row =(value => $thisauthtype,
307 selected => $selected,
308 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
310 push @authtypesloop, \%row;
312 $template->param(itemtypeloop => \@itemtypesloop);
316 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
317 <select name="authtype">
318 <!-- TMPL_LOOP name="authtypeloop" -->
319 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
322 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
323 <input type="submit" value="OK" class="button">
331 # returns a reference to a hash of references to authtypes...
333 my $dbh = C4::Context->dbh;
334 my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
336 while ( my $IT = $sth->fetchrow_hashref ) {
337 $authtypes{ $IT->{'authtypecode'} } = $IT;
339 return ( \%authtypes );
343 my ($authtypecode) = @_;
345 # returns a reference to a hash of references to authtypes...
347 my $dbh = C4::Context->dbh;
348 my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
349 $sth->execute($authtypecode);
350 my $res = $sth->fetchrow_hashref;
356 $frameworks = &getframework();
358 Returns information about existing frameworks
360 build a HTML select with the following code :
362 =head3 in PERL SCRIPT
364 my $frameworks = frameworks();
366 foreach my $thisframework (keys %$frameworks) {
367 my $selected = 1 if $thisframework eq $frameworkcode;
368 my %row =(value => $thisframework,
369 selected => $selected,
370 description => $frameworks->{$thisframework}->{'frameworktext'},
372 push @frameworksloop, \%row;
374 $template->param(frameworkloop => \@frameworksloop);
378 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
379 <select name="frameworkcode">
380 <option value="">Default</option>
381 <!-- TMPL_LOOP name="frameworkloop" -->
382 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
385 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
386 <input type="submit" value="OK" class="button">
393 # returns a reference to a hash of references to branches...
395 my $dbh = C4::Context->dbh;
396 my $sth = $dbh->prepare("select * from biblio_framework");
398 while ( my $IT = $sth->fetchrow_hashref ) {
399 $itemtypes{ $IT->{'frameworkcode'} } = $IT;
401 return ( \%itemtypes );
404 =head2 getframeworkinfo
406 $frameworkinfo = &getframeworkinfo($frameworkcode);
408 Returns information about an frameworkcode.
412 sub getframeworkinfo {
413 my ($frameworkcode) = @_;
414 my $dbh = C4::Context->dbh;
416 $dbh->prepare("select * from biblio_framework where frameworkcode=?");
417 $sth->execute($frameworkcode);
418 my $res = $sth->fetchrow_hashref;
422 =head2 getitemtypeinfo
424 $itemtype = &getitemtype($itemtype);
426 Returns information about an itemtype.
430 sub getitemtypeinfo {
432 my $dbh = C4::Context->dbh;
433 my $sth = $dbh->prepare("select * from itemtypes where itemtype=?");
434 $sth->execute($itemtype);
435 my $res = $sth->fetchrow_hashref;
437 $res->{imageurl} = getitemtypeimagelocation( 'intranet', $res->{imageurl} );
442 =head2 getitemtypeimagedir
444 my $directory = getitemtypeimagedir( 'opac' );
446 pass in 'opac' or 'intranet'. Defaults to 'opac'.
448 returns the full path to the appropriate directory containing images.
452 sub getitemtypeimagedir {
453 my $src = shift || 'opac';
454 if ($src eq 'intranet') {
455 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
457 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('template') . '/itemtypeimg';
461 sub getitemtypeimagesrc {
462 my $src = shift || 'opac';
463 if ($src eq 'intranet') {
464 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
466 return '/opac-tmpl' . '/' . C4::Context->preference('template') . '/itemtypeimg';
470 sub getitemtypeimagelocation($$) {
471 my ( $src, $image ) = @_;
473 return '' if ( !$image );
475 my $scheme = ( uri_split( $image ) )[0];
477 return $image if ( $scheme );
479 return getitemtypeimagesrc( $src ) . '/' . $image;
482 =head3 _getImagesFromDirectory
484 Find all of the image files in a directory in the filesystem
486 parameters: a directory name
488 returns: a list of images in that directory.
490 Notes: this does not traverse into subdirectories. See
491 _getSubdirectoryNames for help with that.
492 Images are assumed to be files with .gif or .png file extensions.
493 The image names returned do not have the directory name on them.
497 sub _getImagesFromDirectory {
498 my $directoryname = shift;
499 return unless defined $directoryname;
500 return unless -d $directoryname;
502 if ( opendir ( my $dh, $directoryname ) ) {
503 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
505 @images = sort(@images);
508 warn "unable to opendir $directoryname: $!";
513 =head3 _getSubdirectoryNames
515 Find all of the directories in a directory in the filesystem
517 parameters: a directory name
519 returns: a list of subdirectories in that directory.
521 Notes: this does not traverse into subdirectories. Only the first
522 level of subdirectories are returned.
523 The directory names returned don't have the parent directory name on them.
527 sub _getSubdirectoryNames {
528 my $directoryname = shift;
529 return unless defined $directoryname;
530 return unless -d $directoryname;
532 if ( opendir ( my $dh, $directoryname ) ) {
533 my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
537 warn "unable to opendir $directoryname: $!";
544 returns: a listref of hashrefs. Each hash represents another collection of images.
546 { imagesetname => 'npl', # the name of the image set (npl is the original one)
547 images => listref of image hashrefs
550 each image is represented by a hashref like this:
552 { KohaImage => 'npl/image.gif',
553 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
554 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
555 checked => 0 or 1: was this the image passed to this method?
556 Note: I'd like to remove this somehow.
563 my $checked = $params{'checked'} || '';
565 my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
566 url => getitemtypeimagesrc('intranet'),
568 opac => { filesystem => getitemtypeimagedir('opac'),
569 url => getitemtypeimagesrc('opac'),
573 my @imagesets = (); # list of hasrefs of image set data to pass to template
574 my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
575 warn $paths->{'staff'}{'filesystem'};
576 foreach my $imagesubdir ( @subdirectories ) {
578 my @imagelist = (); # hashrefs of image info
579 my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
580 my $imagesetactive = 0;
581 foreach my $thisimage ( @imagenames ) {
583 { KohaImage => "$imagesubdir/$thisimage",
584 StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
585 OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
586 checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
589 $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
591 push @imagesets, { imagesetname => $imagesubdir,
592 imagesetactive => $imagesetactive,
593 images => \@imagelist };
601 $printers = &GetPrinters();
602 @queues = keys %$printers;
604 Returns information about existing printer queues.
606 C<$printers> is a reference-to-hash whose keys are the print queues
607 defined in the printers table of the Koha database. The values are
608 references-to-hash, whose keys are the fields in the printers table.
614 my $dbh = C4::Context->dbh;
615 my $sth = $dbh->prepare("select * from printers");
617 while ( my $printer = $sth->fetchrow_hashref ) {
618 $printers{ $printer->{'printqueue'} } = $printer;
620 return ( \%printers );
625 $printer = GetPrinter( $query, $printers );
629 sub GetPrinter ($$) {
630 my ( $query, $printers ) = @_; # get printer for this query from printers
631 my $printer = $query->param('printer');
632 my %cookie = $query->cookie('userenv');
633 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
634 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
640 Returns the number of pages to display in a pagination bar, given the number
641 of items and the number of items per page.
646 my ( $nb_items, $nb_items_per_page ) = @_;
648 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
653 (@themes) = &getallthemes('opac');
654 (@themes) = &getallthemes('intranet');
656 Returns an array of all available themes.
664 if ( $type eq 'intranet' ) {
665 $htdocs = C4::Context->config('intrahtdocs');
668 $htdocs = C4::Context->config('opachtdocs');
670 opendir D, "$htdocs";
671 my @dirlist = readdir D;
672 foreach my $directory (@dirlist) {
673 -d "$htdocs/$directory/en" and push @themes, $directory;
680 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
683 link_value => 'su-to',
684 label_value => 'Topics',
686 [ '600', '601', '602', '603', '604', '605', '606', '610' ],
690 link_value => 'su-geo',
691 label_value => 'Places',
696 link_value => 'su-ut',
697 label_value => 'Titles',
698 tags => [ '500', '501', '502', '503', '504', ],
703 label_value => 'Authors',
704 tags => [ '700', '701', '702', ],
709 label_value => 'Series',
718 link_value => 'branch',
719 label_value => 'Libraries',
724 push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
729 link_value => 'su-to',
730 label_value => 'Topics',
736 # link_value => 'su-na',
737 # label_value => 'People and Organizations',
738 # tags => ['600', '610', '611'],
742 link_value => 'su-geo',
743 label_value => 'Places',
748 link_value => 'su-ut',
749 label_value => 'Titles',
755 label_value => 'Authors',
756 tags => [ '100', '110', '700', ],
761 label_value => 'Series',
762 tags => [ '440', '490', ],
768 link_value => 'branch',
769 label_value => 'Libraries',
774 push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
781 Return a href where a key is associated to a href. You give a query,
782 the name of the key among the fields returned by the query. If you
783 also give as third argument the name of the value, the function
784 returns a href of scalar. The optional 4th argument is an arrayref of
785 items passed to the C<execute()> call. It is designed to bind
786 parameters to any placeholders in your SQL.
795 # generic href of any information on the item, href of href.
796 my $iteminfos_of = get_infos_of($query, 'itemnumber');
797 print $iteminfos_of->{$itemnumber}{barcode};
799 # specific information, href of scalar
800 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
801 print $barcode_of_item->{$itemnumber};
806 my ( $query, $key_name, $value_name, $bind_params ) = @_;
808 my $dbh = C4::Context->dbh;
810 my $sth = $dbh->prepare($query);
811 $sth->execute( @$bind_params );
814 while ( my $row = $sth->fetchrow_hashref ) {
815 if ( defined $value_name ) {
816 $infos_of{ $row->{$key_name} } = $row->{$value_name};
819 $infos_of{ $row->{$key_name} } = $row;
827 =head2 get_notforloan_label_of
829 my $notforloan_label_of = get_notforloan_label_of();
831 Each authorised value of notforloan (information available in items and
832 itemtypes) is link to a single label.
834 Returns a href where keys are authorised values and values are corresponding
837 foreach my $authorised_value (keys %{$notforloan_label_of}) {
839 "authorised_value: %s => %s\n",
841 $notforloan_label_of->{$authorised_value}
847 # FIXME - why not use GetAuthorisedValues ??
849 sub get_notforloan_label_of {
850 my $dbh = C4::Context->dbh;
853 SELECT authorised_value
854 FROM marc_subfield_structure
855 WHERE kohafield = \'items.notforloan\'
858 my $sth = $dbh->prepare($query);
860 my ($statuscode) = $sth->fetchrow_array();
865 FROM authorised_values
868 $sth = $dbh->prepare($query);
869 $sth->execute($statuscode);
870 my %notforloan_label_of;
871 while ( my $row = $sth->fetchrow_hashref ) {
872 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
876 return \%notforloan_label_of;
879 =head2 displayServers
881 my $servers = displayServers();
882 my $servers = displayServers( $position );
883 my $servers = displayServers( $position, $type );
885 displayServers returns a listref of hashrefs, each containing
886 information about available z3950 servers. Each hashref has a format
890 'checked' => 'checked',
891 'encoding' => 'MARC-8'
893 'id' => 'LIBRARY OF CONGRESS',
897 'value' => 'z3950.loc.gov:7090/',
904 my ( $position, $type ) = @_;
905 my $dbh = C4::Context->dbh;
907 my $strsth = 'SELECT * FROM z3950servers';
912 push @bind_params, $position;
913 push @where_clauses, ' position = ? ';
917 push @bind_params, $type;
918 push @where_clauses, ' type = ? ';
921 # reassemble where clause from where clause pieces
922 if (@where_clauses) {
923 $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
926 my $rq = $dbh->prepare($strsth);
927 $rq->execute(@bind_params);
928 my @primaryserverloop;
930 while ( my $data = $rq->fetchrow_hashref ) {
931 push @primaryserverloop,
932 { label => $data->{description},
935 value => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
936 encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
937 checked => "checked",
938 icon => $data->{icon},
939 zed => $data->{type} eq 'zed',
940 opensearch => $data->{type} eq 'opensearch'
943 return \@primaryserverloop;
947 =head2 GetKohaImageurlFromAuthorisedValues
949 $authhorised_value = GetKohaImageurlFromAuthorisedValues( $category, $authvalcode );
951 Return the first url of the authorised value image represented by $lib.
955 sub GetKohaImageurlFromAuthorisedValues {
956 my ( $category, $lib ) = @_;
957 my $dbh = C4::Context->dbh;
958 my $sth = $dbh->prepare("SELECT imageurl FROM authorised_values WHERE category=? AND lib =?");
959 $sth->execute( $category, $lib );
960 while ( my $data = $sth->fetchrow_hashref ) {
961 return $data->{'imageurl'};
965 =head2 GetAuthValCode
967 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
972 my ($kohafield,$fwcode) = @_;
973 my $dbh = C4::Context->dbh;
974 $fwcode='' unless $fwcode;
975 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
976 $sth->execute($kohafield,$fwcode);
977 my ($authvalcode) = $sth->fetchrow_array;
981 =head2 GetAuthValCodeFromField
983 $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
985 C<$subfield> can be undefined
989 sub GetAuthValCodeFromField {
990 my ($field,$subfield,$fwcode) = @_;
991 my $dbh = C4::Context->dbh;
992 $fwcode='' unless $fwcode;
994 if (defined $subfield) {
995 $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
996 $sth->execute($field,$subfield,$fwcode);
998 $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
999 $sth->execute($field,$fwcode);
1001 my ($authvalcode) = $sth->fetchrow_array;
1002 return $authvalcode;
1005 =head2 GetAuthorisedValues
1007 $authvalues = GetAuthorisedValues([$category], [$selected]);
1009 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
1011 C<$category> returns authorised values for just one category (optional).
1013 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1017 sub GetAuthorisedValues {
1018 my ($category,$selected,$opac) = @_;
1020 my $dbh = C4::Context->dbh;
1021 my $query = "SELECT * FROM authorised_values";
1022 $query .= " WHERE category = '" . $category . "'" if $category;
1023 $query .= " ORDER BY category, lib, lib_opac";
1024 my $sth = $dbh->prepare($query);
1026 while (my $data=$sth->fetchrow_hashref) {
1027 if ($selected && $selected eq $data->{'authorised_value'} ) {
1028 $data->{'selected'} = 1;
1030 if ($opac && $data->{'lib_opac'}) {
1031 $data->{'lib'} = $data->{'lib_opac'};
1033 push @results, $data;
1035 #my $data = $sth->fetchall_arrayref({});
1036 return \@results; #$data;
1039 =head2 GetAuthorisedValueCategories
1041 $auth_categories = GetAuthorisedValueCategories();
1043 Return an arrayref of all of the available authorised
1048 sub GetAuthorisedValueCategories {
1049 my $dbh = C4::Context->dbh;
1050 my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1053 while (my $category = $sth->fetchrow_array) {
1054 push @results, $category;
1059 =head2 GetAuthorisedValueByCode
1061 $authhorised_value = GetAuthorisedValueByCode( $category, $authvalcode );
1063 Return an hashref of the authorised value represented by $authvalcode.
1067 sub GetAuthorisedValueByCode {
1068 my ( $category, $authvalcode ) = @_;
1070 my $dbh = C4::Context->dbh;
1071 my $sth = $dbh->prepare("SELECT lib FROM authorised_values WHERE category=? AND authorised_value =?");
1072 $sth->execute( $category, $authvalcode );
1073 while ( my $data = $sth->fetchrow_hashref ) {
1074 return $data->{'lib'};
1078 =head2 GetKohaAuthorisedValues
1080 Takes $kohafield, $fwcode as parameters.
1082 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1084 Returns hashref of Code => description
1086 Returns undef if no authorised value category is defined for the kohafield.
1090 sub GetKohaAuthorisedValues {
1091 my ($kohafield,$fwcode,$opac) = @_;
1092 $fwcode='' unless $fwcode;
1094 my $dbh = C4::Context->dbh;
1095 my $avcode = GetAuthValCode($kohafield,$fwcode);
1097 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1098 $sth->execute($avcode);
1099 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1100 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1108 =head2 GetKohaAuthorisedValuesFromField
1110 Takes $field, $subfield, $fwcode as parameters.
1112 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1113 $subfield can be undefined
1115 Returns hashref of Code => description
1117 Returns undef if no authorised value category is defined for the given field and subfield
1121 sub GetKohaAuthorisedValuesFromField {
1122 my ($field, $subfield, $fwcode,$opac) = @_;
1123 $fwcode='' unless $fwcode;
1125 my $dbh = C4::Context->dbh;
1126 my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1128 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1129 $sth->execute($avcode);
1130 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1131 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1141 my $escaped_string = C4::Koha::xml_escape($string);
1143 Convert &, <, >, ', and " in a string to XML entities
1149 return '' unless defined $str;
1150 $str =~ s/&/&/g;
1153 $str =~ s/'/'/g;
1154 $str =~ s/"/"/g;
1158 =head2 GetKohaAuthorisedValueLib
1160 Takes $category, $authorised_value as parameters.
1162 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1164 Returns authorised value description
1168 sub GetKohaAuthorisedValueLib {
1169 my ($category,$authorised_value,$opac) = @_;
1171 my $dbh = C4::Context->dbh;
1172 my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1173 $sth->execute($category,$authorised_value);
1174 my $data = $sth->fetchrow_hashref;
1175 $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1179 =head2 display_marc_indicators
1181 my $display_form = C4::Koha::display_marc_indicators($field);
1183 C<$field> is a MARC::Field object
1185 Generate a display form of the indicators of a variable
1186 MARC field, replacing any blanks with '#'.
1190 sub display_marc_indicators {
1192 my $indicators = '';
1193 if ($field->tag() >= 10) {
1194 $indicators = $field->indicator(1) . $field->indicator(2);
1195 $indicators =~ s/ /#/g;
1200 sub GetNormalizedUPC {
1201 my ($record,$marcflavour) = @_;
1204 if ($marcflavour eq 'MARC21') {
1205 @fields = $record->field('024');
1206 foreach my $field (@fields) {
1207 my $indicator = $field->indicator(1);
1208 my $upc = _normalize_match_point($field->subfield('a'));
1209 if ($indicator == 1 and $upc ne '') {
1214 else { # assume unimarc if not marc21
1215 @fields = $record->field('072');
1216 foreach my $field (@fields) {
1217 my $upc = _normalize_match_point($field->subfield('a'));
1225 # Normalizes and returns the first valid ISBN found in the record
1226 # ISBN13 are converted into ISBN10. This is required to get Amazon cover book.
1227 sub GetNormalizedISBN {
1228 my ($isbn,$record,$marcflavour) = @_;
1231 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1232 # anything after " | " should be removed, along with the delimiter
1233 $isbn =~ s/(.*)( \| )(.*)/$1/;
1234 return _isbn_cleanup($isbn);
1236 return undef unless $record;
1238 if ($marcflavour eq 'MARC21') {
1239 @fields = $record->field('020');
1240 foreach my $field (@fields) {
1241 $isbn = $field->subfield('a');
1243 return _isbn_cleanup($isbn);
1249 else { # assume unimarc if not marc21
1250 @fields = $record->field('010');
1251 foreach my $field (@fields) {
1252 my $isbn = $field->subfield('a');
1254 return _isbn_cleanup($isbn);
1263 sub GetNormalizedEAN {
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 $ean = _normalize_match_point($field->subfield('a'));
1272 if ($indicator == 3 and $ean ne '') {
1277 else { # assume unimarc if not marc21
1278 @fields = $record->field('073');
1279 foreach my $field (@fields) {
1280 $ean = _normalize_match_point($field->subfield('a'));
1287 sub GetNormalizedOCLCNumber {
1288 my ($record,$marcflavour) = @_;
1291 if ($marcflavour eq 'MARC21') {
1292 @fields = $record->field('035');
1293 foreach my $field (@fields) {
1294 $oclc = $field->subfield('a');
1295 if ($oclc =~ /OCoLC/) {
1296 $oclc =~ s/\(OCoLC\)//;
1303 else { # TODO: add UNIMARC fields
1307 sub _normalize_match_point {
1308 my $match_point = shift;
1309 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1310 $normalized_match_point =~ s/-//g;
1312 return $normalized_match_point;
1316 my $isbn = Business::ISBN->new( $_[0] );
1318 $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13';
1319 if (defined $isbn) {
1320 return $isbn->as_string([]);