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 tags => [ qw/ 995c / ],
719 unless ( C4::Context->preference("singleBranchMode") || GetBranchesCount() == 1 ) {
722 label => 'Libraries',
723 tags => [ qw/ 995b / ],
726 push( @$facets, $library_facet );
733 tags => [ qw/ 650a / ],
738 # label => 'People and Organizations',
739 # tags => [ qw/ 600a 610a 611a / ],
745 tags => [ qw/ 651a / ],
751 tags => [ qw/ 630a / ],
757 tags => [ qw/ 100a 110a 700a / ],
763 tags => [ qw/ 440a 490a / ],
768 label => 'ItemTypes',
769 tags => [ qw/ 952y 942c / ],
775 tags => [ qw / 952c / ],
780 unless ( C4::Context->preference("singleBranchMode") || GetBranchesCount() == 1 ) {
783 label => 'Libraries',
784 tags => [ qw / 952b / ],
787 push( @$facets, $library_facet );
794 Return a href where a key is associated to a href. You give a query,
795 the name of the key among the fields returned by the query. If you
796 also give as third argument the name of the value, the function
797 returns a href of scalar. The optional 4th argument is an arrayref of
798 items passed to the C<execute()> call. It is designed to bind
799 parameters to any placeholders in your SQL.
808 # generic href of any information on the item, href of href.
809 my $iteminfos_of = get_infos_of($query, 'itemnumber');
810 print $iteminfos_of->{$itemnumber}{barcode};
812 # specific information, href of scalar
813 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
814 print $barcode_of_item->{$itemnumber};
819 my ( $query, $key_name, $value_name, $bind_params ) = @_;
821 my $dbh = C4::Context->dbh;
823 my $sth = $dbh->prepare($query);
824 $sth->execute( @$bind_params );
827 while ( my $row = $sth->fetchrow_hashref ) {
828 if ( defined $value_name ) {
829 $infos_of{ $row->{$key_name} } = $row->{$value_name};
832 $infos_of{ $row->{$key_name} } = $row;
840 =head2 get_notforloan_label_of
842 my $notforloan_label_of = get_notforloan_label_of();
844 Each authorised value of notforloan (information available in items and
845 itemtypes) is link to a single label.
847 Returns a href where keys are authorised values and values are corresponding
850 foreach my $authorised_value (keys %{$notforloan_label_of}) {
852 "authorised_value: %s => %s\n",
854 $notforloan_label_of->{$authorised_value}
860 # FIXME - why not use GetAuthorisedValues ??
862 sub get_notforloan_label_of {
863 my $dbh = C4::Context->dbh;
866 SELECT authorised_value
867 FROM marc_subfield_structure
868 WHERE kohafield = \'items.notforloan\'
871 my $sth = $dbh->prepare($query);
873 my ($statuscode) = $sth->fetchrow_array();
878 FROM authorised_values
881 $sth = $dbh->prepare($query);
882 $sth->execute($statuscode);
883 my %notforloan_label_of;
884 while ( my $row = $sth->fetchrow_hashref ) {
885 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
889 return \%notforloan_label_of;
892 =head2 displayServers
894 my $servers = displayServers();
895 my $servers = displayServers( $position );
896 my $servers = displayServers( $position, $type );
898 displayServers returns a listref of hashrefs, each containing
899 information about available z3950 servers. Each hashref has a format
903 'checked' => 'checked',
904 'encoding' => 'utf8',
906 'id' => 'LIBRARY OF CONGRESS',
910 'value' => 'lx2.loc.gov:210/',
917 my ( $position, $type ) = @_;
918 my $dbh = C4::Context->dbh;
920 my $strsth = 'SELECT * FROM z3950servers';
925 push @bind_params, $position;
926 push @where_clauses, ' position = ? ';
930 push @bind_params, $type;
931 push @where_clauses, ' type = ? ';
934 # reassemble where clause from where clause pieces
935 if (@where_clauses) {
936 $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
939 my $rq = $dbh->prepare($strsth);
940 $rq->execute(@bind_params);
941 my @primaryserverloop;
943 while ( my $data = $rq->fetchrow_hashref ) {
944 push @primaryserverloop,
945 { label => $data->{description},
948 value => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
949 encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
950 checked => "checked",
951 icon => $data->{icon},
952 zed => $data->{type} eq 'zed',
953 opensearch => $data->{type} eq 'opensearch'
956 return \@primaryserverloop;
960 =head2 GetKohaImageurlFromAuthorisedValues
962 $authhorised_value = GetKohaImageurlFromAuthorisedValues( $category, $authvalcode );
964 Return the first url of the authorised value image represented by $lib.
968 sub GetKohaImageurlFromAuthorisedValues {
969 my ( $category, $lib ) = @_;
970 my $dbh = C4::Context->dbh;
971 my $sth = $dbh->prepare("SELECT imageurl FROM authorised_values WHERE category=? AND lib =?");
972 $sth->execute( $category, $lib );
973 while ( my $data = $sth->fetchrow_hashref ) {
974 return $data->{'imageurl'};
978 =head2 GetAuthValCode
980 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
985 my ($kohafield,$fwcode) = @_;
986 my $dbh = C4::Context->dbh;
987 $fwcode='' unless $fwcode;
988 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
989 $sth->execute($kohafield,$fwcode);
990 my ($authvalcode) = $sth->fetchrow_array;
994 =head2 GetAuthValCodeFromField
996 $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
998 C<$subfield> can be undefined
1002 sub GetAuthValCodeFromField {
1003 my ($field,$subfield,$fwcode) = @_;
1004 my $dbh = C4::Context->dbh;
1005 $fwcode='' unless $fwcode;
1007 if (defined $subfield) {
1008 $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
1009 $sth->execute($field,$subfield,$fwcode);
1011 $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
1012 $sth->execute($field,$fwcode);
1014 my ($authvalcode) = $sth->fetchrow_array;
1015 return $authvalcode;
1018 =head2 GetAuthorisedValues
1020 $authvalues = GetAuthorisedValues([$category], [$selected]);
1022 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
1024 C<$category> returns authorised values for just one category (optional).
1026 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1030 sub GetAuthorisedValues {
1031 my ( $category, $selected, $opac ) = @_;
1032 my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1034 my $dbh = C4::Context->dbh;
1037 FROM authorised_values
1040 LEFT JOIN authorised_values_branches ON ( id = av_id )
1045 push @where_strings, "category = ?";
1046 push @where_args, $category;
1049 push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
1050 push @where_args, $branch_limit;
1052 if(@where_strings > 0) {
1053 $query .= " WHERE " . join(" AND ", @where_strings);
1055 $query .= " GROUP BY lib";
1056 $query .= ' ORDER BY category, ' . (
1057 $opac ? 'COALESCE(lib_opac, lib)'
1061 my $sth = $dbh->prepare($query);
1063 $sth->execute( @where_args );
1064 while (my $data=$sth->fetchrow_hashref) {
1065 if ( defined $selected and $selected eq $data->{authorised_value} ) {
1066 $data->{selected} = 1;
1069 $data->{selected} = 0;
1072 if ($opac && $data->{lib_opac}) {
1073 $data->{lib} = $data->{lib_opac};
1075 push @results, $data;
1081 =head2 GetAuthorisedValueCategories
1083 $auth_categories = GetAuthorisedValueCategories();
1085 Return an arrayref of all of the available authorised
1090 sub GetAuthorisedValueCategories {
1091 my $dbh = C4::Context->dbh;
1092 my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1095 while (defined (my $category = $sth->fetchrow_array) ) {
1096 push @results, $category;
1101 =head2 IsAuthorisedValueCategory
1103 $is_auth_val_category = IsAuthorisedValueCategory($category);
1105 Returns whether a given category name is a valid one
1109 sub IsAuthorisedValueCategory {
1110 my $category = shift;
1113 FROM authorised_values
1114 WHERE BINARY category=?
1117 my $sth = C4::Context->dbh->prepare($query);
1118 $sth->execute($category);
1119 $sth->fetchrow ? return 1
1123 =head2 GetAuthorisedValueByCode
1125 $authorised_value = GetAuthorisedValueByCode( $category, $authvalcode, $opac );
1127 Return the lib attribute from authorised_values from the row identified
1128 by the passed category and code
1132 sub GetAuthorisedValueByCode {
1133 my ( $category, $authvalcode, $opac ) = @_;
1135 my $field = $opac ? 'lib_opac' : 'lib';
1136 my $dbh = C4::Context->dbh;
1137 my $sth = $dbh->prepare("SELECT $field FROM authorised_values WHERE category=? AND authorised_value =?");
1138 $sth->execute( $category, $authvalcode );
1139 while ( my $data = $sth->fetchrow_hashref ) {
1140 return $data->{ $field };
1144 =head2 GetKohaAuthorisedValues
1146 Takes $kohafield, $fwcode as parameters.
1148 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1150 Returns hashref of Code => description
1152 Returns undef if no authorised value category is defined for the kohafield.
1156 sub GetKohaAuthorisedValues {
1157 my ($kohafield,$fwcode,$opac) = @_;
1158 $fwcode='' unless $fwcode;
1160 my $dbh = C4::Context->dbh;
1161 my $avcode = GetAuthValCode($kohafield,$fwcode);
1163 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1164 $sth->execute($avcode);
1165 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1166 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1174 =head2 GetKohaAuthorisedValuesFromField
1176 Takes $field, $subfield, $fwcode as parameters.
1178 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1179 $subfield can be undefined
1181 Returns hashref of Code => description
1183 Returns undef if no authorised value category is defined for the given field and subfield
1187 sub GetKohaAuthorisedValuesFromField {
1188 my ($field, $subfield, $fwcode,$opac) = @_;
1189 $fwcode='' unless $fwcode;
1191 my $dbh = C4::Context->dbh;
1192 my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1194 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1195 $sth->execute($avcode);
1196 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1197 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1207 my $escaped_string = C4::Koha::xml_escape($string);
1209 Convert &, <, >, ', and " in a string to XML entities
1215 return '' unless defined $str;
1216 $str =~ s/&/&/g;
1219 $str =~ s/'/'/g;
1220 $str =~ s/"/"/g;
1224 =head2 GetKohaAuthorisedValueLib
1226 Takes $category, $authorised_value as parameters.
1228 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1230 Returns authorised value description
1234 sub GetKohaAuthorisedValueLib {
1235 my ($category,$authorised_value,$opac) = @_;
1237 my $dbh = C4::Context->dbh;
1238 my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1239 $sth->execute($category,$authorised_value);
1240 my $data = $sth->fetchrow_hashref;
1241 $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1245 =head2 AddAuthorisedValue
1247 AddAuthorisedValue($category, $authorised_value, $lib, $lib_opac, $imageurl);
1249 Create a new authorised value.
1253 sub AddAuthorisedValue {
1254 my ($category, $authorised_value, $lib, $lib_opac, $imageurl) = @_;
1256 my $dbh = C4::Context->dbh;
1258 INSERT INTO authorised_values (category, authorised_value, lib, lib_opac, imageurl)
1261 my $sth = $dbh->prepare($query);
1262 $sth->execute($category, $authorised_value, $lib, $lib_opac, $imageurl);
1265 =head2 display_marc_indicators
1267 my $display_form = C4::Koha::display_marc_indicators($field);
1269 C<$field> is a MARC::Field object
1271 Generate a display form of the indicators of a variable
1272 MARC field, replacing any blanks with '#'.
1276 sub display_marc_indicators {
1278 my $indicators = '';
1279 if ($field->tag() >= 10) {
1280 $indicators = $field->indicator(1) . $field->indicator(2);
1281 $indicators =~ s/ /#/g;
1286 sub GetNormalizedUPC {
1287 my ($record,$marcflavour) = @_;
1290 if ($marcflavour eq 'UNIMARC') {
1291 @fields = $record->field('072');
1292 foreach my $field (@fields) {
1293 my $upc = _normalize_match_point($field->subfield('a'));
1300 else { # assume marc21 if not unimarc
1301 @fields = $record->field('024');
1302 foreach my $field (@fields) {
1303 my $indicator = $field->indicator(1);
1304 my $upc = _normalize_match_point($field->subfield('a'));
1305 if ($indicator == 1 and $upc ne '') {
1312 # Normalizes and returns the first valid ISBN found in the record
1313 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
1314 sub GetNormalizedISBN {
1315 my ($isbn,$record,$marcflavour) = @_;
1318 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1319 # anything after " | " should be removed, along with the delimiter
1320 $isbn =~ s/(.*)( \| )(.*)/$1/;
1321 return _isbn_cleanup($isbn);
1323 return unless $record;
1325 if ($marcflavour eq 'UNIMARC') {
1326 @fields = $record->field('010');
1327 foreach my $field (@fields) {
1328 my $isbn = $field->subfield('a');
1330 return _isbn_cleanup($isbn);
1336 else { # assume marc21 if not unimarc
1337 @fields = $record->field('020');
1338 foreach my $field (@fields) {
1339 $isbn = $field->subfield('a');
1341 return _isbn_cleanup($isbn);
1349 sub GetNormalizedEAN {
1350 my ($record,$marcflavour) = @_;
1353 if ($marcflavour eq 'UNIMARC') {
1354 @fields = $record->field('073');
1355 foreach my $field (@fields) {
1356 $ean = _normalize_match_point($field->subfield('a'));
1362 else { # assume marc21 if not unimarc
1363 @fields = $record->field('024');
1364 foreach my $field (@fields) {
1365 my $indicator = $field->indicator(1);
1366 $ean = _normalize_match_point($field->subfield('a'));
1367 if ($indicator == 3 and $ean ne '') {
1373 sub GetNormalizedOCLCNumber {
1374 my ($record,$marcflavour) = @_;
1377 if ($marcflavour eq 'UNIMARC') {
1378 # TODO: add UNIMARC fields
1380 else { # assume marc21 if not unimarc
1381 @fields = $record->field('035');
1382 foreach my $field (@fields) {
1383 $oclc = $field->subfield('a');
1384 if ($oclc =~ /OCoLC/) {
1385 $oclc =~ s/\(OCoLC\)//;
1394 =head2 GetDailyQuote($opts)
1396 Takes a hashref of options
1398 Currently supported options are:
1400 'id' An exact quote id
1401 'random' Select a random quote
1402 noop When no option is passed in, this sub will return the quote timestamped for the current day
1404 The function returns an anonymous hash following this format:
1407 'source' => 'source-of-quote',
1408 'timestamp' => 'timestamp-value',
1409 'text' => 'text-of-quote',
1415 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1416 # at least for default option
1420 my $dbh = C4::Context->dbh;
1425 $query = 'SELECT * FROM quotes WHERE id = ?';
1426 $sth = $dbh->prepare($query);
1427 $sth->execute($opts{'id'});
1428 $quote = $sth->fetchrow_hashref();
1430 elsif ($opts{'random'}) {
1431 # Fall through... we also return a random quote as a catch-all if all else fails
1434 $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1435 $sth = $dbh->prepare($query);
1437 $quote = $sth->fetchrow_hashref();
1439 unless ($quote) { # if there are not matches, choose a random quote
1440 # get a list of all available quote ids
1441 $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1443 my $range = ($sth->fetchrow_array)[0];
1445 # chose a random id within that range if there is more than one quote
1446 my $id = int(rand($range));
1448 $query = 'SELECT * FROM quotes WHERE id = ?;';
1449 $sth = C4::Context->dbh->prepare($query);
1453 $query = 'SELECT * FROM quotes;';
1454 $sth = C4::Context->dbh->prepare($query);
1457 $quote = $sth->fetchrow_hashref();
1458 # update the timestamp for that quote
1459 $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1460 $sth = C4::Context->dbh->prepare($query);
1462 DateTime::Format::MySQL->format_datetime( dt_from_string() ),
1469 sub _normalize_match_point {
1470 my $match_point = shift;
1471 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1472 $normalized_match_point =~ s/-//g;
1474 return $normalized_match_point;
1478 require Business::ISBN;
1479 my $isbn = Business::ISBN->new( $_[0] );
1481 $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13';
1482 if (defined $isbn) {
1483 return $isbn->as_string([]);