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 under the
10 # terms of the GNU General Public License as published by the Free Software
11 # Foundation; either version 2 of the License, or (at your option) any later
14 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
15 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
16 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License along
19 # with Koha; if not, write to the Free Software Foundation, Inc.,
20 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
24 #use warnings; FIXME - Bug 2505
27 use C4::Branch qw(GetBranchesCount);
28 use Koha::DateUtils qw(dt_from_string);
30 use DateTime::Format::MySQL;
31 use autouse 'Data::Dumper' => qw(Dumper);
32 use DBI qw(:sql_types);
34 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $DEBUG);
37 $VERSION = 3.07.00.049;
42 &subfield_is_koha_internal_p
43 &GetPrinters &GetPrinter
44 &GetItemTypes &getitemtypeinfo
46 &GetSupportName &GetSupportList
48 &getframeworks &getframeworkinfo
49 &getauthtypes &getauthtype
55 &get_notforloan_label_of
58 &getitemtypeimagelocation
60 &GetAuthorisedValueCategories
61 &IsAuthorisedValueCategory
62 &GetKohaAuthorisedValues
63 &GetKohaAuthorisedValuesFromField
64 &GetKohaAuthorisedValueLib
65 &GetAuthorisedValueByCode
66 &GetKohaImageurlFromAuthorisedValues
72 &GetNormalizedOCLCNumber
78 @EXPORT_OK = qw( GetDailyQuote );
82 memoize('GetAuthorisedValues');
86 C4::Koha - Perl Module containing convenience functions for Koha scripts
94 Koha.pm provides many functions for Koha scripts.
102 $slash_date = &slashifyDate($dash_date);
104 Takes a string of the form "DD-MM-YYYY" (or anything separated by
105 dashes), converts it to the form "YYYY/MM/DD", and returns the result.
111 # accepts a date of the form xx-xx-xx[xx] and returns it in the
113 my @dateOut = split( '-', shift );
114 return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
117 # FIXME.. this should be moved to a MARC-specific module
118 sub subfield_is_koha_internal_p {
121 # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
122 # But real MARC subfields are always single-character
123 # so it really is safer just to check the length
125 return length $subfield != 1;
128 =head2 GetSupportName
130 $itemtypename = &GetSupportName($codestring);
132 Returns a string with the name of the itemtype.
138 return if (! $codestring);
140 my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
141 if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
148 my $sth = C4::Context->dbh->prepare($query);
149 $sth->execute($codestring);
150 ($resultstring)=$sth->fetchrow;
151 return $resultstring;
154 C4::Context->dbh->prepare(
155 "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
157 $sth->execute( $advanced_search_types, $codestring );
158 my $data = $sth->fetchrow_hashref;
159 return $$data{'lib'};
163 =head2 GetSupportList
165 $itemtypes = &GetSupportList();
167 Returns an array ref containing informations about Support (since itemtype is rather a circulation code when item-level-itypes is used).
169 build a HTML select with the following code :
171 =head3 in PERL SCRIPT
173 my $itemtypes = GetSupportList();
174 $template->param(itemtypeloop => $itemtypes);
178 <select name="itemtype" id="itemtype">
179 <option value=""></option>
180 [% FOREACH itemtypeloo IN itemtypeloop %]
181 [% IF ( itemtypeloo.selected ) %]
182 <option value="[% itemtypeloo.itemtype %]" selected="selected">[% itemtypeloo.description %]</option>
184 <option value="[% itemtypeloo.itemtype %]">[% itemtypeloo.description %]</option>
192 my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
193 if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
199 my $sth = C4::Context->dbh->prepare($query);
201 return $sth->fetchall_arrayref({});
203 my $advsearchtypes = GetAuthorisedValues($advanced_search_types);
204 my @results= map {{itemtype=>$$_{authorised_value},description=>$$_{lib},imageurl=>$$_{imageurl}}} @$advsearchtypes;
210 $itemtypes = &GetItemTypes();
212 Returns information about existing itemtypes.
214 build a HTML select with the following code :
216 =head3 in PERL SCRIPT
218 my $itemtypes = GetItemTypes;
220 foreach my $thisitemtype (sort keys %$itemtypes) {
221 my $selected = 1 if $thisitemtype eq $itemtype;
222 my %row =(value => $thisitemtype,
223 selected => $selected,
224 description => $itemtypes->{$thisitemtype}->{'description'},
226 push @itemtypesloop, \%row;
228 $template->param(itemtypeloop => \@itemtypesloop);
232 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
233 <select name="itemtype">
234 <option value="">Default</option>
235 <!-- TMPL_LOOP name="itemtypeloop" -->
236 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
239 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
240 <input type="submit" value="OK" class="button">
247 # returns a reference to a hash of references to itemtypes...
249 my $dbh = C4::Context->dbh;
254 my $sth = $dbh->prepare($query);
256 while ( my $IT = $sth->fetchrow_hashref ) {
257 $itemtypes{ $IT->{'itemtype'} } = $IT;
259 return ( \%itemtypes );
262 sub get_itemtypeinfos_of {
265 my $placeholders = join( ', ', map { '?' } @itemtypes );
266 my $query = <<"END_SQL";
272 WHERE itemtype IN ( $placeholders )
275 return get_infos_of( $query, 'itemtype', undef, \@itemtypes );
278 # this is temporary until we separate collection codes and item types
282 my $dbh = C4::Context->dbh;
285 "SELECT * FROM authorised_values ORDER BY authorised_value");
287 while ( my $data = $sth->fetchrow_hashref ) {
288 if ( $data->{category} eq "CCODE" ) {
290 $results[$count] = $data;
296 return ( $count, @results );
301 $authtypes = &getauthtypes();
303 Returns information about existing authtypes.
305 build a HTML select with the following code :
307 =head3 in PERL SCRIPT
309 my $authtypes = getauthtypes;
311 foreach my $thisauthtype (keys %$authtypes) {
312 my $selected = 1 if $thisauthtype eq $authtype;
313 my %row =(value => $thisauthtype,
314 selected => $selected,
315 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
317 push @authtypesloop, \%row;
319 $template->param(itemtypeloop => \@itemtypesloop);
323 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
324 <select name="authtype">
325 <!-- TMPL_LOOP name="authtypeloop" -->
326 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
329 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
330 <input type="submit" value="OK" class="button">
338 # returns a reference to a hash of references to authtypes...
340 my $dbh = C4::Context->dbh;
341 my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
343 while ( my $IT = $sth->fetchrow_hashref ) {
344 $authtypes{ $IT->{'authtypecode'} } = $IT;
346 return ( \%authtypes );
350 my ($authtypecode) = @_;
352 # returns a reference to a hash of references to authtypes...
354 my $dbh = C4::Context->dbh;
355 my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
356 $sth->execute($authtypecode);
357 my $res = $sth->fetchrow_hashref;
363 $frameworks = &getframework();
365 Returns information about existing frameworks
367 build a HTML select with the following code :
369 =head3 in PERL SCRIPT
371 my $frameworks = frameworks();
373 foreach my $thisframework (keys %$frameworks) {
374 my $selected = 1 if $thisframework eq $frameworkcode;
375 my %row =(value => $thisframework,
376 selected => $selected,
377 description => $frameworks->{$thisframework}->{'frameworktext'},
379 push @frameworksloop, \%row;
381 $template->param(frameworkloop => \@frameworksloop);
385 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
386 <select name="frameworkcode">
387 <option value="">Default</option>
388 <!-- TMPL_LOOP name="frameworkloop" -->
389 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
392 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
393 <input type="submit" value="OK" class="button">
400 # returns a reference to a hash of references to branches...
402 my $dbh = C4::Context->dbh;
403 my $sth = $dbh->prepare("select * from biblio_framework");
405 while ( my $IT = $sth->fetchrow_hashref ) {
406 $itemtypes{ $IT->{'frameworkcode'} } = $IT;
408 return ( \%itemtypes );
411 =head2 getframeworkinfo
413 $frameworkinfo = &getframeworkinfo($frameworkcode);
415 Returns information about an frameworkcode.
419 sub getframeworkinfo {
420 my ($frameworkcode) = @_;
421 my $dbh = C4::Context->dbh;
423 $dbh->prepare("select * from biblio_framework where frameworkcode=?");
424 $sth->execute($frameworkcode);
425 my $res = $sth->fetchrow_hashref;
429 =head2 getitemtypeinfo
431 $itemtype = &getitemtypeinfo($itemtype, [$interface]);
433 Returns information about an itemtype. The optional $interface argument
434 sets which interface ('opac' or 'intranet') to return the imageurl for.
435 Defaults to intranet.
439 sub getitemtypeinfo {
440 my ($itemtype, $interface) = @_;
441 my $dbh = C4::Context->dbh;
442 my $sth = $dbh->prepare("select * from itemtypes where itemtype=?");
443 $sth->execute($itemtype);
444 my $res = $sth->fetchrow_hashref;
446 $res->{imageurl} = getitemtypeimagelocation( ( ( defined $interface && $interface eq 'opac' ) ? 'opac' : 'intranet' ), $res->{imageurl} );
451 =head2 getitemtypeimagedir
453 my $directory = getitemtypeimagedir( 'opac' );
455 pass in 'opac' or 'intranet'. Defaults to 'opac'.
457 returns the full path to the appropriate directory containing images.
461 sub getitemtypeimagedir {
462 my $src = shift || 'opac';
463 if ($src eq 'intranet') {
464 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
466 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
470 sub getitemtypeimagesrc {
471 my $src = shift || 'opac';
472 if ($src eq 'intranet') {
473 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
475 return '/opac-tmpl' . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
479 sub getitemtypeimagelocation {
480 my ( $src, $image ) = @_;
482 return '' if ( !$image );
485 my $scheme = ( URI::Split::uri_split( $image ) )[0];
487 return $image if ( $scheme );
489 return getitemtypeimagesrc( $src ) . '/' . $image;
492 =head3 _getImagesFromDirectory
494 Find all of the image files in a directory in the filesystem
496 parameters: a directory name
498 returns: a list of images in that directory.
500 Notes: this does not traverse into subdirectories. See
501 _getSubdirectoryNames for help with that.
502 Images are assumed to be files with .gif or .png file extensions.
503 The image names returned do not have the directory name on them.
507 sub _getImagesFromDirectory {
508 my $directoryname = shift;
509 return unless defined $directoryname;
510 return unless -d $directoryname;
512 if ( opendir ( my $dh, $directoryname ) ) {
513 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
515 @images = sort(@images);
518 warn "unable to opendir $directoryname: $!";
523 =head3 _getSubdirectoryNames
525 Find all of the directories in a directory in the filesystem
527 parameters: a directory name
529 returns: a list of subdirectories in that directory.
531 Notes: this does not traverse into subdirectories. Only the first
532 level of subdirectories are returned.
533 The directory names returned don't have the parent directory name on them.
537 sub _getSubdirectoryNames {
538 my $directoryname = shift;
539 return unless defined $directoryname;
540 return unless -d $directoryname;
542 if ( opendir ( my $dh, $directoryname ) ) {
543 my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
547 warn "unable to opendir $directoryname: $!";
554 returns: a listref of hashrefs. Each hash represents another collection of images.
556 { imagesetname => 'npl', # the name of the image set (npl is the original one)
557 images => listref of image hashrefs
560 each image is represented by a hashref like this:
562 { KohaImage => 'npl/image.gif',
563 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
564 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
565 checked => 0 or 1: was this the image passed to this method?
566 Note: I'd like to remove this somehow.
573 my $checked = $params{'checked'} || '';
575 my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
576 url => getitemtypeimagesrc('intranet'),
578 opac => { filesystem => getitemtypeimagedir('opac'),
579 url => getitemtypeimagesrc('opac'),
583 my @imagesets = (); # list of hasrefs of image set data to pass to template
584 my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
585 foreach my $imagesubdir ( @subdirectories ) {
586 warn $imagesubdir if $DEBUG;
587 my @imagelist = (); # hashrefs of image info
588 my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
589 my $imagesetactive = 0;
590 foreach my $thisimage ( @imagenames ) {
592 { KohaImage => "$imagesubdir/$thisimage",
593 StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
594 OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
595 checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
598 $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
600 push @imagesets, { imagesetname => $imagesubdir,
601 imagesetactive => $imagesetactive,
602 images => \@imagelist };
610 $printers = &GetPrinters();
611 @queues = keys %$printers;
613 Returns information about existing printer queues.
615 C<$printers> is a reference-to-hash whose keys are the print queues
616 defined in the printers table of the Koha database. The values are
617 references-to-hash, whose keys are the fields in the printers table.
623 my $dbh = C4::Context->dbh;
624 my $sth = $dbh->prepare("select * from printers");
626 while ( my $printer = $sth->fetchrow_hashref ) {
627 $printers{ $printer->{'printqueue'} } = $printer;
629 return ( \%printers );
634 $printer = GetPrinter( $query, $printers );
639 my ( $query, $printers ) = @_; # get printer for this query from printers
640 my $printer = $query->param('printer');
641 my %cookie = $query->cookie('userenv');
642 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
643 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
649 Returns the number of pages to display in a pagination bar, given the number
650 of items and the number of items per page.
655 my ( $nb_items, $nb_items_per_page ) = @_;
657 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
662 (@themes) = &getallthemes('opac');
663 (@themes) = &getallthemes('intranet');
665 Returns an array of all available themes.
673 if ( $type eq 'intranet' ) {
674 $htdocs = C4::Context->config('intrahtdocs');
677 $htdocs = C4::Context->config('opachtdocs');
679 opendir D, "$htdocs";
680 my @dirlist = readdir D;
681 foreach my $directory (@dirlist) {
682 next if $directory eq 'lib';
683 -d "$htdocs/$directory/en" and push @themes, $directory;
690 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
695 tags => [ qw/ 600ab 601ab 602a 604at 605a 606ax 610a / ],
701 tags => [ qw/ 607a / ],
707 tags => [ qw/ 500a 501a 503a / ],
713 tags => [ qw/ 700ab 701ab 702ab / ],
714 sep => C4::Context->preference("UNIMARCAuthorsFacetsSeparator"),
719 tags => [ qw/ 225a / ],
725 unless ( C4::Context->preference("singleBranchMode") || GetBranchesCount() == 1 ) {
728 label => 'Libraries',
729 tags => [ qw/ 995b / ],
735 tags => [ qw/ 995c / ],
738 push( @$facets, $library_facet );
745 tags => [ qw/ 650a / ],
750 # label => 'People and Organizations',
751 # tags => [ qw/ 600a 610a 611a / ],
757 tags => [ qw/ 651a / ],
763 tags => [ qw/ 630a / ],
769 tags => [ qw/ 100a 110a 700a / ],
775 tags => [ qw/ 440a 490a / ],
780 label => 'ItemTypes',
781 tags => [ qw/ 952y 942c / ],
787 unless ( C4::Context->preference("singleBranchMode") || GetBranchesCount() == 1 ) {
790 label => 'Libraries',
791 tags => [ qw / 952b / ],
797 tags => [ qw / 952c / ],
800 push( @$facets, $library_facet );
807 Return a href where a key is associated to a href. You give a query,
808 the name of the key among the fields returned by the query. If you
809 also give as third argument the name of the value, the function
810 returns a href of scalar. The optional 4th argument is an arrayref of
811 items passed to the C<execute()> call. It is designed to bind
812 parameters to any placeholders in your SQL.
821 # generic href of any information on the item, href of href.
822 my $iteminfos_of = get_infos_of($query, 'itemnumber');
823 print $iteminfos_of->{$itemnumber}{barcode};
825 # specific information, href of scalar
826 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
827 print $barcode_of_item->{$itemnumber};
832 my ( $query, $key_name, $value_name, $bind_params ) = @_;
834 my $dbh = C4::Context->dbh;
836 my $sth = $dbh->prepare($query);
837 $sth->execute( @$bind_params );
840 while ( my $row = $sth->fetchrow_hashref ) {
841 if ( defined $value_name ) {
842 $infos_of{ $row->{$key_name} } = $row->{$value_name};
845 $infos_of{ $row->{$key_name} } = $row;
853 =head2 get_notforloan_label_of
855 my $notforloan_label_of = get_notforloan_label_of();
857 Each authorised value of notforloan (information available in items and
858 itemtypes) is link to a single label.
860 Returns a href where keys are authorised values and values are corresponding
863 foreach my $authorised_value (keys %{$notforloan_label_of}) {
865 "authorised_value: %s => %s\n",
867 $notforloan_label_of->{$authorised_value}
873 # FIXME - why not use GetAuthorisedValues ??
875 sub get_notforloan_label_of {
876 my $dbh = C4::Context->dbh;
879 SELECT authorised_value
880 FROM marc_subfield_structure
881 WHERE kohafield = \'items.notforloan\'
884 my $sth = $dbh->prepare($query);
886 my ($statuscode) = $sth->fetchrow_array();
891 FROM authorised_values
894 $sth = $dbh->prepare($query);
895 $sth->execute($statuscode);
896 my %notforloan_label_of;
897 while ( my $row = $sth->fetchrow_hashref ) {
898 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
902 return \%notforloan_label_of;
905 =head2 displayServers
907 my $servers = displayServers();
908 my $servers = displayServers( $position );
909 my $servers = displayServers( $position, $type );
911 displayServers returns a listref of hashrefs, each containing
912 information about available z3950 servers. Each hashref has a format
916 'checked' => 'checked',
917 'encoding' => 'utf8',
919 'id' => 'LIBRARY OF CONGRESS',
923 'value' => 'lx2.loc.gov:210/',
930 my ( $position, $type ) = @_;
931 my $dbh = C4::Context->dbh;
933 my $strsth = 'SELECT * FROM z3950servers';
938 push @bind_params, $position;
939 push @where_clauses, ' position = ? ';
943 push @bind_params, $type;
944 push @where_clauses, ' type = ? ';
947 # reassemble where clause from where clause pieces
948 if (@where_clauses) {
949 $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
952 my $rq = $dbh->prepare($strsth);
953 $rq->execute(@bind_params);
954 my @primaryserverloop;
956 while ( my $data = $rq->fetchrow_hashref ) {
957 push @primaryserverloop,
958 { label => $data->{description},
961 value => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
962 encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
963 checked => "checked",
964 icon => $data->{icon},
965 zed => $data->{type} eq 'zed',
966 opensearch => $data->{type} eq 'opensearch'
969 return \@primaryserverloop;
973 =head2 GetKohaImageurlFromAuthorisedValues
975 $authhorised_value = GetKohaImageurlFromAuthorisedValues( $category, $authvalcode );
977 Return the first url of the authorised value image represented by $lib.
981 sub GetKohaImageurlFromAuthorisedValues {
982 my ( $category, $lib ) = @_;
983 my $dbh = C4::Context->dbh;
984 my $sth = $dbh->prepare("SELECT imageurl FROM authorised_values WHERE category=? AND lib =?");
985 $sth->execute( $category, $lib );
986 while ( my $data = $sth->fetchrow_hashref ) {
987 return $data->{'imageurl'};
991 =head2 GetAuthValCode
993 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
998 my ($kohafield,$fwcode) = @_;
999 my $dbh = C4::Context->dbh;
1000 $fwcode='' unless $fwcode;
1001 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
1002 $sth->execute($kohafield,$fwcode);
1003 my ($authvalcode) = $sth->fetchrow_array;
1004 return $authvalcode;
1007 =head2 GetAuthValCodeFromField
1009 $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
1011 C<$subfield> can be undefined
1015 sub GetAuthValCodeFromField {
1016 my ($field,$subfield,$fwcode) = @_;
1017 my $dbh = C4::Context->dbh;
1018 $fwcode='' unless $fwcode;
1020 if (defined $subfield) {
1021 $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
1022 $sth->execute($field,$subfield,$fwcode);
1024 $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
1025 $sth->execute($field,$fwcode);
1027 my ($authvalcode) = $sth->fetchrow_array;
1028 return $authvalcode;
1031 =head2 GetAuthorisedValues
1033 $authvalues = GetAuthorisedValues([$category], [$selected]);
1035 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
1037 C<$category> returns authorised values for just one category (optional).
1039 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1043 sub GetAuthorisedValues {
1044 my ( $category, $selected, $opac ) = @_;
1045 my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1047 my $dbh = C4::Context->dbh;
1050 FROM authorised_values
1053 LEFT JOIN authorised_values_branches ON ( id = av_id )
1058 push @where_strings, "category = ?";
1059 push @where_args, $category;
1062 push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
1063 push @where_args, $branch_limit;
1065 if(@where_strings > 0) {
1066 $query .= " WHERE " . join(" AND ", @where_strings);
1068 $query .= " GROUP BY lib";
1069 $query .= ' ORDER BY category, ' . (
1070 $opac ? 'COALESCE(lib_opac, lib)'
1074 my $sth = $dbh->prepare($query);
1076 $sth->execute( @where_args );
1077 while (my $data=$sth->fetchrow_hashref) {
1078 if ( defined $selected and $selected eq $data->{authorised_value} ) {
1079 $data->{selected} = 1;
1082 $data->{selected} = 0;
1085 if ($opac && $data->{lib_opac}) {
1086 $data->{lib} = $data->{lib_opac};
1088 push @results, $data;
1094 =head2 GetAuthorisedValueCategories
1096 $auth_categories = GetAuthorisedValueCategories();
1098 Return an arrayref of all of the available authorised
1103 sub GetAuthorisedValueCategories {
1104 my $dbh = C4::Context->dbh;
1105 my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1108 while (defined (my $category = $sth->fetchrow_array) ) {
1109 push @results, $category;
1114 =head2 IsAuthorisedValueCategory
1116 $is_auth_val_category = IsAuthorisedValueCategory($category);
1118 Returns whether a given category name is a valid one
1122 sub IsAuthorisedValueCategory {
1123 my $category = shift;
1126 FROM authorised_values
1127 WHERE BINARY category=?
1130 my $sth = C4::Context->dbh->prepare($query);
1131 $sth->execute($category);
1132 $sth->fetchrow ? return 1
1136 =head2 GetAuthorisedValueByCode
1138 $authhorised_value = GetAuthorisedValueByCode( $category, $authvalcode );
1140 Return the lib attribute from authorised_values from the row identified
1141 by the passed category and code
1145 sub GetAuthorisedValueByCode {
1146 my ( $category, $authvalcode, $opac ) = @_;
1148 my $field = $opac ? 'lib_opac' : 'lib';
1149 my $dbh = C4::Context->dbh;
1150 my $sth = $dbh->prepare("SELECT $field FROM authorised_values WHERE category=? AND authorised_value =?");
1151 $sth->execute( $category, $authvalcode );
1152 while ( my $data = $sth->fetchrow_hashref ) {
1153 return $data->{ $field };
1157 =head2 GetKohaAuthorisedValues
1159 Takes $kohafield, $fwcode as parameters.
1161 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1163 Returns hashref of Code => description
1165 Returns undef if no authorised value category is defined for the kohafield.
1169 sub GetKohaAuthorisedValues {
1170 my ($kohafield,$fwcode,$opac) = @_;
1171 $fwcode='' unless $fwcode;
1173 my $dbh = C4::Context->dbh;
1174 my $avcode = GetAuthValCode($kohafield,$fwcode);
1176 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1177 $sth->execute($avcode);
1178 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1179 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1187 =head2 GetKohaAuthorisedValuesFromField
1189 Takes $field, $subfield, $fwcode as parameters.
1191 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1192 $subfield can be undefined
1194 Returns hashref of Code => description
1196 Returns undef if no authorised value category is defined for the given field and subfield
1200 sub GetKohaAuthorisedValuesFromField {
1201 my ($field, $subfield, $fwcode,$opac) = @_;
1202 $fwcode='' unless $fwcode;
1204 my $dbh = C4::Context->dbh;
1205 my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1207 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1208 $sth->execute($avcode);
1209 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1210 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1220 my $escaped_string = C4::Koha::xml_escape($string);
1222 Convert &, <, >, ', and " in a string to XML entities
1228 return '' unless defined $str;
1229 $str =~ s/&/&/g;
1232 $str =~ s/'/'/g;
1233 $str =~ s/"/"/g;
1237 =head2 GetKohaAuthorisedValueLib
1239 Takes $category, $authorised_value as parameters.
1241 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1243 Returns authorised value description
1247 sub GetKohaAuthorisedValueLib {
1248 my ($category,$authorised_value,$opac) = @_;
1250 my $dbh = C4::Context->dbh;
1251 my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1252 $sth->execute($category,$authorised_value);
1253 my $data = $sth->fetchrow_hashref;
1254 $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1258 =head2 AddAuthorisedValue
1260 AddAuthorisedValue($category, $authorised_value, $lib, $lib_opac, $imageurl);
1262 Create a new authorised value.
1266 sub AddAuthorisedValue {
1267 my ($category, $authorised_value, $lib, $lib_opac, $imageurl) = @_;
1269 my $dbh = C4::Context->dbh;
1271 INSERT INTO authorised_values (category, authorised_value, lib, lib_opac, imageurl)
1274 my $sth = $dbh->prepare($query);
1275 $sth->execute($category, $authorised_value, $lib, $lib_opac, $imageurl);
1278 =head2 display_marc_indicators
1280 my $display_form = C4::Koha::display_marc_indicators($field);
1282 C<$field> is a MARC::Field object
1284 Generate a display form of the indicators of a variable
1285 MARC field, replacing any blanks with '#'.
1289 sub display_marc_indicators {
1291 my $indicators = '';
1292 if ($field->tag() >= 10) {
1293 $indicators = $field->indicator(1) . $field->indicator(2);
1294 $indicators =~ s/ /#/g;
1299 sub GetNormalizedUPC {
1300 my ($record,$marcflavour) = @_;
1303 if ($marcflavour eq 'UNIMARC') {
1304 @fields = $record->field('072');
1305 foreach my $field (@fields) {
1306 my $upc = _normalize_match_point($field->subfield('a'));
1313 else { # assume marc21 if not unimarc
1314 @fields = $record->field('024');
1315 foreach my $field (@fields) {
1316 my $indicator = $field->indicator(1);
1317 my $upc = _normalize_match_point($field->subfield('a'));
1318 if ($indicator == 1 and $upc ne '') {
1325 # Normalizes and returns the first valid ISBN found in the record
1326 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
1327 sub GetNormalizedISBN {
1328 my ($isbn,$record,$marcflavour) = @_;
1331 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1332 # anything after " | " should be removed, along with the delimiter
1333 $isbn =~ s/(.*)( \| )(.*)/$1/;
1334 return _isbn_cleanup($isbn);
1336 return unless $record;
1338 if ($marcflavour eq 'UNIMARC') {
1339 @fields = $record->field('010');
1340 foreach my $field (@fields) {
1341 my $isbn = $field->subfield('a');
1343 return _isbn_cleanup($isbn);
1349 else { # assume marc21 if not unimarc
1350 @fields = $record->field('020');
1351 foreach my $field (@fields) {
1352 $isbn = $field->subfield('a');
1354 return _isbn_cleanup($isbn);
1362 sub GetNormalizedEAN {
1363 my ($record,$marcflavour) = @_;
1366 if ($marcflavour eq 'UNIMARC') {
1367 @fields = $record->field('073');
1368 foreach my $field (@fields) {
1369 $ean = _normalize_match_point($field->subfield('a'));
1375 else { # assume marc21 if not unimarc
1376 @fields = $record->field('024');
1377 foreach my $field (@fields) {
1378 my $indicator = $field->indicator(1);
1379 $ean = _normalize_match_point($field->subfield('a'));
1380 if ($indicator == 3 and $ean ne '') {
1386 sub GetNormalizedOCLCNumber {
1387 my ($record,$marcflavour) = @_;
1390 if ($marcflavour eq 'UNIMARC') {
1391 # TODO: add UNIMARC fields
1393 else { # assume marc21 if not unimarc
1394 @fields = $record->field('035');
1395 foreach my $field (@fields) {
1396 $oclc = $field->subfield('a');
1397 if ($oclc =~ /OCoLC/) {
1398 $oclc =~ s/\(OCoLC\)//;
1407 =head2 GetDailyQuote($opts)
1409 Takes a hashref of options
1411 Currently supported options are:
1413 'id' An exact quote id
1414 'random' Select a random quote
1415 noop When no option is passed in, this sub will return the quote timestamped for the current day
1417 The function returns an anonymous hash following this format:
1420 'source' => 'source-of-quote',
1421 'timestamp' => 'timestamp-value',
1422 'text' => 'text-of-quote',
1428 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1429 # at least for default option
1433 my $dbh = C4::Context->dbh;
1438 $query = 'SELECT * FROM quotes WHERE id = ?';
1439 $sth = $dbh->prepare($query);
1440 $sth->execute($opts{'id'});
1441 $quote = $sth->fetchrow_hashref();
1443 elsif ($opts{'random'}) {
1444 # Fall through... we also return a random quote as a catch-all if all else fails
1447 $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1448 $sth = $dbh->prepare($query);
1450 $quote = $sth->fetchrow_hashref();
1452 unless ($quote) { # if there are not matches, choose a random quote
1453 # get a list of all available quote ids
1454 $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1456 my $range = ($sth->fetchrow_array)[0];
1458 # chose a random id within that range if there is more than one quote
1459 my $offset = int(rand($range));
1461 $query = 'SELECT * FROM quotes ORDER BY id LIMIT 1 OFFSET ?';
1462 $sth = C4::Context->dbh->prepare($query);
1463 # see http://www.perlmonks.org/?node_id=837422 for why
1464 # we're being verbose and using bind_param
1465 $sth->bind_param(1, $offset, SQL_INTEGER);
1469 $query = 'SELECT * FROM quotes;';
1470 $sth = C4::Context->dbh->prepare($query);
1473 $quote = $sth->fetchrow_hashref();
1474 # update the timestamp for that quote
1475 $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1476 $sth = C4::Context->dbh->prepare($query);
1478 DateTime::Format::MySQL->format_datetime( dt_from_string() ),
1485 sub _normalize_match_point {
1486 my $match_point = shift;
1487 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1488 $normalized_match_point =~ s/-//g;
1490 return $normalized_match_point;
1494 require Business::ISBN;
1495 my $isbn = Business::ISBN->new( $_[0] );
1497 $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13';
1498 if (defined $isbn) {
1499 return $isbn->as_string([]);