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);
33 use vars
qw($VERSION @ISA @EXPORT @EXPORT_OK $DEBUG);
36 $VERSION = 3.07.00.049;
41 &subfield_is_koha_internal_p
42 &GetPrinters &GetPrinter
43 &GetItemTypes &getitemtypeinfo
44 &GetSupportName &GetSupportList
46 &getframeworks &getframeworkinfo
47 &getauthtypes &getauthtype
53 &get_notforloan_label_of
56 &getitemtypeimagelocation
58 &GetAuthorisedValueCategories
59 &IsAuthorisedValueCategory
60 &GetKohaAuthorisedValues
61 &GetKohaAuthorisedValuesFromField
62 &GetKohaAuthorisedValueLib
63 &GetAuthorisedValueByCode
64 &GetKohaImageurlFromAuthorisedValues
70 &GetNormalizedOCLCNumber
76 @EXPORT_OK = qw( GetDailyQuote );
80 memoize
('GetAuthorisedValues');
84 C4::Koha - Perl Module containing convenience functions for Koha scripts
92 Koha.pm provides many functions for Koha scripts.
100 $slash_date = &slashifyDate($dash_date);
102 Takes a string of the form "DD-MM-YYYY" (or anything separated by
103 dashes), converts it to the form "YYYY/MM/DD", and returns the result.
109 # accepts a date of the form xx-xx-xx[xx] and returns it in the
111 my @dateOut = split( '-', shift );
112 return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
115 # FIXME.. this should be moved to a MARC-specific module
116 sub subfield_is_koha_internal_p
{
119 # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
120 # But real MARC subfields are always single-character
121 # so it really is safer just to check the length
123 return length $subfield != 1;
126 =head2 GetSupportName
128 $itemtypename = &GetSupportName($codestring);
130 Returns a string with the name of the itemtype.
136 return if (! $codestring);
138 my $advanced_search_types = C4
::Context
->preference("AdvancedSearchTypes");
139 if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
146 my $sth = C4
::Context
->dbh->prepare($query);
147 $sth->execute($codestring);
148 ($resultstring)=$sth->fetchrow;
149 return $resultstring;
152 C4
::Context
->dbh->prepare(
153 "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
155 $sth->execute( $advanced_search_types, $codestring );
156 my $data = $sth->fetchrow_hashref;
157 return $$data{'lib'};
161 =head2 GetSupportList
163 $itemtypes = &GetSupportList();
165 Returns an array ref containing informations about Support (since itemtype is rather a circulation code when item-level-itypes is used).
167 build a HTML select with the following code :
169 =head3 in PERL SCRIPT
171 my $itemtypes = GetSupportList();
172 $template->param(itemtypeloop => $itemtypes);
176 <select name="itemtype" id="itemtype">
177 <option value=""></option>
178 [% FOREACH itemtypeloo IN itemtypeloop %]
179 [% IF ( itemtypeloo.selected ) %]
180 <option value="[% itemtypeloo.itemtype %]" selected="selected">[% itemtypeloo.description %]</option>
182 <option value="[% itemtypeloo.itemtype %]">[% itemtypeloo.description %]</option>
190 my $advanced_search_types = C4
::Context
->preference("AdvancedSearchTypes");
191 if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
197 my $sth = C4
::Context
->dbh->prepare($query);
199 return $sth->fetchall_arrayref({});
201 my $advsearchtypes = GetAuthorisedValues
($advanced_search_types);
202 my @results= map {{itemtype
=>$$_{authorised_value
},description
=>$$_{lib
},imageurl
=>$$_{imageurl
}}} @
$advsearchtypes;
208 $itemtypes = &GetItemTypes( style => $style );
210 Returns information about existing itemtypes.
213 style: either 'array' or 'hash', defaults to 'hash'.
214 'array' returns an arrayref,
215 'hash' return a hashref with the itemtype value as the key
217 build a HTML select with the following code :
219 =head3 in PERL SCRIPT
221 my $itemtypes = GetItemTypes;
223 foreach my $thisitemtype (sort keys %$itemtypes) {
224 my $selected = 1 if $thisitemtype eq $itemtype;
225 my %row =(value => $thisitemtype,
226 selected => $selected,
227 description => $itemtypes->{$thisitemtype}->{'description'},
229 push @itemtypesloop, \%row;
231 $template->param(itemtypeloop => \@itemtypesloop);
235 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
236 <select name="itemtype">
237 <option value="">Default</option>
238 <!-- TMPL_LOOP name="itemtypeloop" -->
239 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
242 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
243 <input type="submit" value="OK" class="button">
250 my $style = defined( $params{'style'} ) ?
$params{'style'} : 'hash';
252 # returns a reference to a hash of references to itemtypes...
254 my $dbh = C4
::Context
->dbh;
259 my $sth = $dbh->prepare($query);
262 if ( $style eq 'hash' ) {
263 while ( my $IT = $sth->fetchrow_hashref ) {
264 $itemtypes{ $IT->{'itemtype'} } = $IT;
266 return ( \
%itemtypes );
268 return $sth->fetchall_arrayref({});
272 sub get_itemtypeinfos_of
{
275 my $placeholders = join( ', ', map { '?' } @itemtypes );
276 my $query = <<"END_SQL";
282 WHERE itemtype IN ( $placeholders )
285 return get_infos_of( $query, 'itemtype', undef, \@itemtypes );
290 $authtypes = &getauthtypes();
292 Returns information about existing authtypes.
294 build a HTML select with the following code :
296 =head3 in PERL SCRIPT
298 my $authtypes = getauthtypes;
300 foreach my $thisauthtype (keys %$authtypes) {
301 my $selected = 1 if $thisauthtype eq $authtype;
302 my %row =(value => $thisauthtype,
303 selected => $selected,
304 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
306 push @authtypesloop, \%row;
308 $template->param(itemtypeloop => \@itemtypesloop);
312 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
313 <select name="authtype">
314 <!-- TMPL_LOOP name="authtypeloop" -->
315 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
318 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
319 <input type="submit" value="OK" class="button">
327 # returns a reference to a hash of references to authtypes...
329 my $dbh = C4::Context->dbh;
330 my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
332 while ( my $IT = $sth->fetchrow_hashref ) {
333 $authtypes{ $IT->{'authtypecode'} } = $IT;
335 return ( \%authtypes );
339 my ($authtypecode) = @_;
341 # returns a reference to a hash of references to authtypes...
343 my $dbh = C4::Context->dbh;
344 my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
345 $sth->execute($authtypecode);
346 my $res = $sth->fetchrow_hashref;
352 $frameworks = &getframework();
354 Returns information about existing frameworks
356 build a HTML select with the following code :
358 =head3 in PERL SCRIPT
360 my $frameworks = frameworks();
362 foreach my $thisframework (keys %$frameworks) {
363 my $selected = 1 if $thisframework eq $frameworkcode;
364 my %row =(value => $thisframework,
365 selected => $selected,
366 description => $frameworks->{$thisframework}->{'frameworktext'},
368 push @frameworksloop, \%row;
370 $template->param(frameworkloop => \@frameworksloop);
374 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
375 <select name="frameworkcode">
376 <option value="">Default</option>
377 <!-- TMPL_LOOP name="frameworkloop" -->
378 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
381 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
382 <input type="submit" value="OK" class="button">
389 # returns a reference to a hash of references to branches...
391 my $dbh = C4::Context->dbh;
392 my $sth = $dbh->prepare("select * from biblio_framework");
394 while ( my $IT = $sth->fetchrow_hashref ) {
395 $itemtypes{ $IT->{'frameworkcode'} } = $IT;
397 return ( \%itemtypes );
400 =head2 getframeworkinfo
402 $frameworkinfo = &getframeworkinfo($frameworkcode);
404 Returns information about an frameworkcode.
408 sub getframeworkinfo {
409 my ($frameworkcode) = @_;
410 my $dbh = C4::Context->dbh;
412 $dbh->prepare("select * from biblio_framework where frameworkcode=?");
413 $sth->execute($frameworkcode);
414 my $res = $sth->fetchrow_hashref;
418 =head2 getitemtypeinfo
420 $itemtype = &getitemtypeinfo($itemtype, [$interface]);
422 Returns information about an itemtype. The optional $interface argument
423 sets which interface ('opac' or 'intranet') to return the imageurl for.
424 Defaults to intranet.
428 sub getitemtypeinfo {
429 my ($itemtype, $interface) = @_;
430 my $dbh = C4::Context->dbh;
431 my $sth = $dbh->prepare("select * from itemtypes where itemtype=?");
432 $sth->execute($itemtype);
433 my $res = $sth->fetchrow_hashref;
435 $res->{imageurl} = getitemtypeimagelocation( ( ( defined $interface && $interface eq 'opac' ) ? 'opac' : 'intranet' ), $res->{imageurl} );
440 =head2 getitemtypeimagedir
442 my $directory = getitemtypeimagedir( 'opac' );
444 pass in 'opac' or 'intranet'. Defaults to 'opac'.
446 returns the full path to the appropriate directory containing images.
450 sub getitemtypeimagedir {
451 my $src = shift || 'opac';
452 if ($src eq 'intranet') {
453 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
455 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
459 sub getitemtypeimagesrc {
460 my $src = shift || 'opac';
461 if ($src eq 'intranet') {
462 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
464 return '/opac-tmpl' . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
468 sub getitemtypeimagelocation {
469 my ( $src, $image ) = @_;
471 return '' if ( !$image );
474 my $scheme = ( URI::Split::uri_split( $image ) )[0];
476 return $image if ( $scheme );
478 return getitemtypeimagesrc( $src ) . '/' . $image;
481 =head3 _getImagesFromDirectory
483 Find all of the image files in a directory in the filesystem
485 parameters: a directory name
487 returns: a list of images in that directory.
489 Notes: this does not traverse into subdirectories. See
490 _getSubdirectoryNames for help with that.
491 Images are assumed to be files with .gif or .png file extensions.
492 The image names returned do not have the directory name on them.
496 sub _getImagesFromDirectory {
497 my $directoryname = shift;
498 return unless defined $directoryname;
499 return unless -d $directoryname;
501 if ( opendir ( my $dh, $directoryname ) ) {
502 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
504 @images = sort(@images);
507 warn "unable to opendir $directoryname: $!";
512 =head3 _getSubdirectoryNames
514 Find all of the directories in a directory in the filesystem
516 parameters: a directory name
518 returns: a list of subdirectories in that directory.
520 Notes: this does not traverse into subdirectories. Only the first
521 level of subdirectories are returned.
522 The directory names returned don't have the parent directory name on them.
526 sub _getSubdirectoryNames {
527 my $directoryname = shift;
528 return unless defined $directoryname;
529 return unless -d $directoryname;
531 if ( opendir ( my $dh, $directoryname ) ) {
532 my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
536 warn "unable to opendir $directoryname: $!";
543 returns: a listref of hashrefs. Each hash represents another collection of images.
545 { imagesetname => 'npl', # the name of the image set (npl is the original one)
546 images => listref of image hashrefs
549 each image is represented by a hashref like this:
551 { KohaImage => 'npl/image.gif',
552 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
553 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
554 checked => 0 or 1: was this the image passed to this method?
555 Note: I'd like to remove this somehow.
562 my $checked = $params{'checked'} || '';
564 my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
565 url => getitemtypeimagesrc('intranet'),
567 opac => { filesystem => getitemtypeimagedir('opac'),
568 url => getitemtypeimagesrc('opac'),
572 my @imagesets = (); # list of hasrefs of image set data to pass to template
573 my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
574 foreach my $imagesubdir ( @subdirectories ) {
575 warn $imagesubdir if $DEBUG;
576 my @imagelist = (); # hashrefs of image info
577 my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
578 my $imagesetactive = 0;
579 foreach my $thisimage ( @imagenames ) {
581 { KohaImage => "$imagesubdir/$thisimage",
582 StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
583 OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
584 checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
587 $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
589 push @imagesets, { imagesetname => $imagesubdir,
590 imagesetactive => $imagesetactive,
591 images => \@imagelist };
599 $printers = &GetPrinters();
600 @queues = keys %$printers;
602 Returns information about existing printer queues.
604 C<$printers> is a reference-to-hash whose keys are the print queues
605 defined in the printers table of the Koha database. The values are
606 references-to-hash, whose keys are the fields in the printers table.
612 my $dbh = C4::Context->dbh;
613 my $sth = $dbh->prepare("select * from printers");
615 while ( my $printer = $sth->fetchrow_hashref ) {
616 $printers{ $printer->{'printqueue'} } = $printer;
618 return ( \%printers );
623 $printer = GetPrinter( $query, $printers );
628 my ( $query, $printers ) = @_; # get printer for this query from printers
629 my $printer = $query->param('printer');
630 my %cookie = $query->cookie('userenv');
631 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
632 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
638 Returns the number of pages to display in a pagination bar, given the number
639 of items and the number of items per page.
644 my ( $nb_items, $nb_items_per_page ) = @_;
646 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
651 (@themes) = &getallthemes('opac');
652 (@themes) = &getallthemes('intranet');
654 Returns an array of all available themes.
662 if ( $type eq 'intranet' ) {
663 $htdocs = C4::Context->config('intrahtdocs');
666 $htdocs = C4::Context->config('opachtdocs');
668 opendir D, "$htdocs";
669 my @dirlist = readdir D;
670 foreach my $directory (@dirlist) {
671 next if $directory eq 'lib';
672 -d "$htdocs/$directory/en" and push @themes, $directory;
679 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
684 tags => [ qw/ 600ab 601ab 602a 604at 605a 606ax 610a / ],
690 tags => [ qw/ 607a / ],
696 tags => [ qw/ 500a 501a 503a / ],
702 tags => [ qw/ 700ab 701ab 702ab / ],
703 sep => C4::Context->preference("UNIMARCAuthorsFacetsSeparator"),
708 tags => [ qw/ 225a / ],
714 unless ( C4::Context->preference("singleBranchMode") || GetBranchesCount() == 1 ) {
717 label => 'Libraries',
718 tags => [ qw/ 995b / ],
724 tags => [ qw/ 995c / ],
727 push( @$facets, $library_facet );
734 tags => [ qw/ 650a / ],
739 # label => 'People and Organizations',
740 # tags => [ qw/ 600a 610a 611a / ],
746 tags => [ qw/ 651a / ],
752 tags => [ qw/ 630a / ],
758 tags => [ qw/ 100a 110a 700a / ],
764 tags => [ qw/ 440a 490a / ],
769 label => 'ItemTypes',
770 tags => [ qw/ 952y 942c / ],
776 unless ( C4::Context->preference("singleBranchMode") || GetBranchesCount() == 1 ) {
779 label => 'Libraries',
780 tags => [ qw / 952b / ],
786 tags => [ qw / 952c / ],
789 push( @$facets, $library_facet );
796 Return a href where a key is associated to a href. You give a query,
797 the name of the key among the fields returned by the query. If you
798 also give as third argument the name of the value, the function
799 returns a href of scalar. The optional 4th argument is an arrayref of
800 items passed to the C<execute()> call. It is designed to bind
801 parameters to any placeholders in your SQL.
810 # generic href of any information on the item, href of href.
811 my $iteminfos_of = get_infos_of($query, 'itemnumber');
812 print $iteminfos_of->{$itemnumber}{barcode};
814 # specific information, href of scalar
815 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
816 print $barcode_of_item->{$itemnumber};
821 my ( $query, $key_name, $value_name, $bind_params ) = @_;
823 my $dbh = C4::Context->dbh;
825 my $sth = $dbh->prepare($query);
826 $sth->execute( @$bind_params );
829 while ( my $row = $sth->fetchrow_hashref ) {
830 if ( defined $value_name ) {
831 $infos_of{ $row->{$key_name} } = $row->{$value_name};
834 $infos_of{ $row->{$key_name} } = $row;
842 =head2 get_notforloan_label_of
844 my $notforloan_label_of = get_notforloan_label_of();
846 Each authorised value of notforloan (information available in items and
847 itemtypes) is link to a single label.
849 Returns a href where keys are authorised values and values are corresponding
852 foreach my $authorised_value (keys %{$notforloan_label_of}) {
854 "authorised_value: %s => %s\n",
856 $notforloan_label_of->{$authorised_value}
862 # FIXME - why not use GetAuthorisedValues ??
864 sub get_notforloan_label_of {
865 my $dbh = C4::Context->dbh;
868 SELECT authorised_value
869 FROM marc_subfield_structure
870 WHERE kohafield = \'items.notforloan\'
873 my $sth = $dbh->prepare($query);
875 my ($statuscode) = $sth->fetchrow_array();
880 FROM authorised_values
883 $sth = $dbh->prepare($query);
884 $sth->execute($statuscode);
885 my %notforloan_label_of;
886 while ( my $row = $sth->fetchrow_hashref ) {
887 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
891 return \%notforloan_label_of;
894 =head2 displayServers
896 my $servers = displayServers();
897 my $servers = displayServers( $position );
898 my $servers = displayServers( $position, $type );
900 displayServers returns a listref of hashrefs, each containing
901 information about available z3950 servers. Each hashref has a format
905 'checked' => 'checked',
906 'encoding' => 'utf8',
908 'id' => 'LIBRARY OF CONGRESS',
912 'value' => 'lx2.loc.gov:210/',
919 my ( $position, $type ) = @_;
920 my $dbh = C4::Context->dbh;
922 my $strsth = 'SELECT * FROM z3950servers';
927 push @bind_params, $position;
928 push @where_clauses, ' position = ? ';
932 push @bind_params, $type;
933 push @where_clauses, ' type = ? ';
936 # reassemble where clause from where clause pieces
937 if (@where_clauses) {
938 $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
941 my $rq = $dbh->prepare($strsth);
942 $rq->execute(@bind_params);
943 my @primaryserverloop;
945 while ( my $data = $rq->fetchrow_hashref ) {
946 push @primaryserverloop,
947 { label => $data->{description},
950 value => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
951 encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
952 checked => "checked",
953 icon => $data->{icon},
954 zed => $data->{type} eq 'zed',
955 opensearch => $data->{type} eq 'opensearch'
958 return \@primaryserverloop;
962 =head2 GetKohaImageurlFromAuthorisedValues
964 $authhorised_value = GetKohaImageurlFromAuthorisedValues( $category, $authvalcode );
966 Return the first url of the authorised value image represented by $lib.
970 sub GetKohaImageurlFromAuthorisedValues {
971 my ( $category, $lib ) = @_;
972 my $dbh = C4::Context->dbh;
973 my $sth = $dbh->prepare("SELECT imageurl FROM authorised_values WHERE category=? AND lib =?");
974 $sth->execute( $category, $lib );
975 while ( my $data = $sth->fetchrow_hashref ) {
976 return $data->{'imageurl'};
980 =head2 GetAuthValCode
982 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
987 my ($kohafield,$fwcode) = @_;
988 my $dbh = C4::Context->dbh;
989 $fwcode='' unless $fwcode;
990 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
991 $sth->execute($kohafield,$fwcode);
992 my ($authvalcode) = $sth->fetchrow_array;
996 =head2 GetAuthValCodeFromField
998 $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
1000 C<$subfield> can be undefined
1004 sub GetAuthValCodeFromField {
1005 my ($field,$subfield,$fwcode) = @_;
1006 my $dbh = C4::Context->dbh;
1007 $fwcode='' unless $fwcode;
1009 if (defined $subfield) {
1010 $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
1011 $sth->execute($field,$subfield,$fwcode);
1013 $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
1014 $sth->execute($field,$fwcode);
1016 my ($authvalcode) = $sth->fetchrow_array;
1017 return $authvalcode;
1020 =head2 GetAuthorisedValues
1022 $authvalues = GetAuthorisedValues([$category], [$selected]);
1024 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
1026 C<$category> returns authorised values for just one category (optional).
1028 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1032 sub GetAuthorisedValues {
1033 my ( $category, $selected, $opac ) = @_;
1034 my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1036 my $dbh = C4::Context->dbh;
1039 FROM authorised_values
1042 LEFT JOIN authorised_values_branches ON ( id = av_id )
1047 push @where_strings, "category = ?";
1048 push @where_args, $category;
1051 push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
1052 push @where_args, $branch_limit;
1054 if(@where_strings > 0) {
1055 $query .= " WHERE " . join(" AND ", @where_strings);
1057 $query .= " GROUP BY lib";
1058 $query .= ' ORDER BY category, ' . (
1059 $opac ? 'COALESCE(lib_opac, lib)'
1063 my $sth = $dbh->prepare($query);
1065 $sth->execute( @where_args );
1066 while (my $data=$sth->fetchrow_hashref) {
1067 if ( defined $selected and $selected eq $data->{authorised_value} ) {
1068 $data->{selected} = 1;
1071 $data->{selected} = 0;
1074 if ($opac && $data->{lib_opac}) {
1075 $data->{lib} = $data->{lib_opac};
1077 push @results, $data;
1083 =head2 GetAuthorisedValueCategories
1085 $auth_categories = GetAuthorisedValueCategories();
1087 Return an arrayref of all of the available authorised
1092 sub GetAuthorisedValueCategories {
1093 my $dbh = C4::Context->dbh;
1094 my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1097 while (defined (my $category = $sth->fetchrow_array) ) {
1098 push @results, $category;
1103 =head2 IsAuthorisedValueCategory
1105 $is_auth_val_category = IsAuthorisedValueCategory($category);
1107 Returns whether a given category name is a valid one
1111 sub IsAuthorisedValueCategory {
1112 my $category = shift;
1115 FROM authorised_values
1116 WHERE BINARY category=?
1119 my $sth = C4::Context->dbh->prepare($query);
1120 $sth->execute($category);
1121 $sth->fetchrow ? return 1
1125 =head2 GetAuthorisedValueByCode
1127 $authorised_value = GetAuthorisedValueByCode( $category, $authvalcode, $opac );
1129 Return the lib attribute from authorised_values from the row identified
1130 by the passed category and code
1134 sub GetAuthorisedValueByCode {
1135 my ( $category, $authvalcode, $opac ) = @_;
1137 my $field = $opac ? 'lib_opac' : 'lib';
1138 my $dbh = C4::Context->dbh;
1139 my $sth = $dbh->prepare("SELECT $field FROM authorised_values WHERE category=? AND authorised_value =?");
1140 $sth->execute( $category, $authvalcode );
1141 while ( my $data = $sth->fetchrow_hashref ) {
1142 return $data->{ $field };
1146 =head2 GetKohaAuthorisedValues
1148 Takes $kohafield, $fwcode as parameters.
1150 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1152 Returns hashref of Code => description
1154 Returns undef if no authorised value category is defined for the kohafield.
1158 sub GetKohaAuthorisedValues {
1159 my ($kohafield,$fwcode,$opac) = @_;
1160 $fwcode='' unless $fwcode;
1162 my $dbh = C4::Context->dbh;
1163 my $avcode = GetAuthValCode($kohafield,$fwcode);
1165 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1166 $sth->execute($avcode);
1167 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1168 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1176 =head2 GetKohaAuthorisedValuesFromField
1178 Takes $field, $subfield, $fwcode as parameters.
1180 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1181 $subfield can be undefined
1183 Returns hashref of Code => description
1185 Returns undef if no authorised value category is defined for the given field and subfield
1189 sub GetKohaAuthorisedValuesFromField {
1190 my ($field, $subfield, $fwcode,$opac) = @_;
1191 $fwcode='' unless $fwcode;
1193 my $dbh = C4::Context->dbh;
1194 my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1196 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1197 $sth->execute($avcode);
1198 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1199 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1209 my $escaped_string = C4::Koha::xml_escape($string);
1211 Convert &, <, >, ', and " in a string to XML entities
1217 return '' unless defined $str;
1218 $str =~ s/&/&/g;
1221 $str =~ s/'/'/g;
1222 $str =~ s/"/"/g;
1226 =head2 GetKohaAuthorisedValueLib
1228 Takes $category, $authorised_value as parameters.
1230 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1232 Returns authorised value description
1236 sub GetKohaAuthorisedValueLib {
1237 my ($category,$authorised_value,$opac) = @_;
1239 my $dbh = C4::Context->dbh;
1240 my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1241 $sth->execute($category,$authorised_value);
1242 my $data = $sth->fetchrow_hashref;
1243 $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1247 =head2 AddAuthorisedValue
1249 AddAuthorisedValue($category, $authorised_value, $lib, $lib_opac, $imageurl);
1251 Create a new authorised value.
1255 sub AddAuthorisedValue {
1256 my ($category, $authorised_value, $lib, $lib_opac, $imageurl) = @_;
1258 my $dbh = C4::Context->dbh;
1260 INSERT INTO authorised_values (category, authorised_value, lib, lib_opac, imageurl)
1263 my $sth = $dbh->prepare($query);
1264 $sth->execute($category, $authorised_value, $lib, $lib_opac, $imageurl);
1267 =head2 display_marc_indicators
1269 my $display_form = C4::Koha::display_marc_indicators($field);
1271 C<$field> is a MARC::Field object
1273 Generate a display form of the indicators of a variable
1274 MARC field, replacing any blanks with '#'.
1278 sub display_marc_indicators {
1280 my $indicators = '';
1281 if ($field->tag() >= 10) {
1282 $indicators = $field->indicator(1) . $field->indicator(2);
1283 $indicators =~ s/ /#/g;
1288 sub GetNormalizedUPC {
1289 my ($record,$marcflavour) = @_;
1292 if ($marcflavour eq 'UNIMARC') {
1293 @fields = $record->field('072');
1294 foreach my $field (@fields) {
1295 my $upc = _normalize_match_point($field->subfield('a'));
1302 else { # assume marc21 if not unimarc
1303 @fields = $record->field('024');
1304 foreach my $field (@fields) {
1305 my $indicator = $field->indicator(1);
1306 my $upc = _normalize_match_point($field->subfield('a'));
1307 if ($indicator == 1 and $upc ne '') {
1314 # Normalizes and returns the first valid ISBN found in the record
1315 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
1316 sub GetNormalizedISBN {
1317 my ($isbn,$record,$marcflavour) = @_;
1320 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1321 # anything after " | " should be removed, along with the delimiter
1322 $isbn =~ s/(.*)( \| )(.*)/$1/;
1323 return _isbn_cleanup($isbn);
1325 return unless $record;
1327 if ($marcflavour eq 'UNIMARC') {
1328 @fields = $record->field('010');
1329 foreach my $field (@fields) {
1330 my $isbn = $field->subfield('a');
1332 return _isbn_cleanup($isbn);
1338 else { # assume marc21 if not unimarc
1339 @fields = $record->field('020');
1340 foreach my $field (@fields) {
1341 $isbn = $field->subfield('a');
1343 return _isbn_cleanup($isbn);
1351 sub GetNormalizedEAN {
1352 my ($record,$marcflavour) = @_;
1355 if ($marcflavour eq 'UNIMARC') {
1356 @fields = $record->field('073');
1357 foreach my $field (@fields) {
1358 $ean = _normalize_match_point($field->subfield('a'));
1364 else { # assume marc21 if not unimarc
1365 @fields = $record->field('024');
1366 foreach my $field (@fields) {
1367 my $indicator = $field->indicator(1);
1368 $ean = _normalize_match_point($field->subfield('a'));
1369 if ($indicator == 3 and $ean ne '') {
1375 sub GetNormalizedOCLCNumber {
1376 my ($record,$marcflavour) = @_;
1379 if ($marcflavour eq 'UNIMARC') {
1380 # TODO: add UNIMARC fields
1382 else { # assume marc21 if not unimarc
1383 @fields = $record->field('035');
1384 foreach my $field (@fields) {
1385 $oclc = $field->subfield('a');
1386 if ($oclc =~ /OCoLC/) {
1387 $oclc =~ s/\(OCoLC\)//;
1396 =head2 GetDailyQuote($opts)
1398 Takes a hashref of options
1400 Currently supported options are:
1402 'id' An exact quote id
1403 'random' Select a random quote
1404 noop When no option is passed in, this sub will return the quote timestamped for the current day
1406 The function returns an anonymous hash following this format:
1409 'source' => 'source-of-quote',
1410 'timestamp' => 'timestamp-value',
1411 'text' => 'text-of-quote',
1417 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1418 # at least for default option
1422 my $dbh = C4::Context->dbh;
1427 $query = 'SELECT * FROM quotes WHERE id = ?';
1428 $sth = $dbh->prepare($query);
1429 $sth->execute($opts{'id'});
1430 $quote = $sth->fetchrow_hashref();
1432 elsif ($opts{'random'}) {
1433 # Fall through... we also return a random quote as a catch-all if all else fails
1436 $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1437 $sth = $dbh->prepare($query);
1439 $quote = $sth->fetchrow_hashref();
1441 unless ($quote) { # if there are not matches, choose a random quote
1442 # get a list of all available quote ids
1443 $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1445 my $range = ($sth->fetchrow_array)[0];
1447 # chose a random id within that range if there is more than one quote
1448 my $id = int(rand($range));
1450 $query = 'SELECT * FROM quotes WHERE id = ?;';
1451 $sth = C4::Context->dbh->prepare($query);
1455 $query = 'SELECT * FROM quotes;';
1456 $sth = C4::Context->dbh->prepare($query);
1459 $quote = $sth->fetchrow_hashref();
1460 # update the timestamp for that quote
1461 $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1462 $sth = C4::Context->dbh->prepare($query);
1464 DateTime::Format::MySQL->format_datetime( dt_from_string() ),
1471 sub _normalize_match_point {
1472 my $match_point = shift;
1473 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1474 $normalized_match_point =~ s/-//g;
1476 return $normalized_match_point;
1480 require Business::ISBN;
1481 my $isbn = Business::ISBN->new( $_[0] );
1483 $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13';
1484 if (defined $isbn) {
1485 return $isbn->as_string([]);