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);
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
45 &GetSupportName &GetSupportList
47 &getframeworks &getframeworkinfo
48 &getauthtypes &getauthtype
54 &get_notforloan_label_of
57 &getitemtypeimagelocation
59 &GetAuthorisedValueCategories
60 &IsAuthorisedValueCategory
61 &GetKohaAuthorisedValues
62 &GetKohaAuthorisedValuesFromField
63 &GetKohaAuthorisedValueLib
64 &GetAuthorisedValueByCode
65 &GetKohaImageurlFromAuthorisedValues
71 &GetNormalizedOCLCNumber
77 @EXPORT_OK = qw( GetDailyQuote );
81 memoize('GetAuthorisedValues');
85 C4::Koha - Perl Module containing convenience functions for Koha scripts
93 Koha.pm provides many functions for Koha scripts.
101 $slash_date = &slashifyDate($dash_date);
103 Takes a string of the form "DD-MM-YYYY" (or anything separated by
104 dashes), converts it to the form "YYYY/MM/DD", and returns the result.
110 # accepts a date of the form xx-xx-xx[xx] and returns it in the
112 my @dateOut = split( '-', shift );
113 return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
116 # FIXME.. this should be moved to a MARC-specific module
117 sub subfield_is_koha_internal_p {
120 # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
121 # But real MARC subfields are always single-character
122 # so it really is safer just to check the length
124 return length $subfield != 1;
127 =head2 GetSupportName
129 $itemtypename = &GetSupportName($codestring);
131 Returns a string with the name of the itemtype.
137 return if (! $codestring);
139 my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
140 if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
147 my $sth = C4::Context->dbh->prepare($query);
148 $sth->execute($codestring);
149 ($resultstring)=$sth->fetchrow;
150 return $resultstring;
153 C4::Context->dbh->prepare(
154 "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
156 $sth->execute( $advanced_search_types, $codestring );
157 my $data = $sth->fetchrow_hashref;
158 return $$data{'lib'};
162 =head2 GetSupportList
164 $itemtypes = &GetSupportList();
166 Returns an array ref containing informations about Support (since itemtype is rather a circulation code when item-level-itypes is used).
168 build a HTML select with the following code :
170 =head3 in PERL SCRIPT
172 my $itemtypes = GetSupportList();
173 $template->param(itemtypeloop => $itemtypes);
177 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
178 <select name="itemtype">
179 <option value="">Default</option>
180 <!-- TMPL_LOOP name="itemtypeloop" -->
181 <option value="<!-- TMPL_VAR name="itemtype" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->> <!--TMPL_IF Name="imageurl"--><img alt="<!-- TMPL_VAR name="description" -->" src="<!--TMPL_VAR Name="imageurl"-->><!--TMPL_ELSE-->"<!-- TMPL_VAR name="description" --><!--/TMPL_IF--></option>
184 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
185 <input type="submit" value="OK" class="button">
191 my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
192 if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
198 my $sth = C4::Context->dbh->prepare($query);
200 return $sth->fetchall_arrayref({});
202 my $advsearchtypes = GetAuthorisedValues($advanced_search_types);
203 my @results= map {{itemtype=>$$_{authorised_value},description=>$$_{lib},imageurl=>$$_{imageurl}}} @$advsearchtypes;
209 $itemtypes = &GetItemTypes();
211 Returns information about existing itemtypes.
213 build a HTML select with the following code :
215 =head3 in PERL SCRIPT
217 my $itemtypes = GetItemTypes;
219 foreach my $thisitemtype (sort keys %$itemtypes) {
220 my $selected = 1 if $thisitemtype eq $itemtype;
221 my %row =(value => $thisitemtype,
222 selected => $selected,
223 description => $itemtypes->{$thisitemtype}->{'description'},
225 push @itemtypesloop, \%row;
227 $template->param(itemtypeloop => \@itemtypesloop);
231 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
232 <select name="itemtype">
233 <option value="">Default</option>
234 <!-- TMPL_LOOP name="itemtypeloop" -->
235 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
238 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
239 <input type="submit" value="OK" class="button">
246 # returns a reference to a hash of references to itemtypes...
248 my $dbh = C4::Context->dbh;
253 my $sth = $dbh->prepare($query);
255 while ( my $IT = $sth->fetchrow_hashref ) {
256 $itemtypes{ $IT->{'itemtype'} } = $IT;
258 return ( \%itemtypes );
261 sub get_itemtypeinfos_of {
264 my $placeholders = join( ', ', map { '?' } @itemtypes );
265 my $query = <<"END_SQL";
271 WHERE itemtype IN ( $placeholders )
274 return get_infos_of( $query, 'itemtype', undef, \@itemtypes );
277 # this is temporary until we separate collection codes and item types
281 my $dbh = C4::Context->dbh;
284 "SELECT * FROM authorised_values ORDER BY authorised_value");
286 while ( my $data = $sth->fetchrow_hashref ) {
287 if ( $data->{category} eq "CCODE" ) {
289 $results[$count] = $data;
295 return ( $count, @results );
300 $authtypes = &getauthtypes();
302 Returns information about existing authtypes.
304 build a HTML select with the following code :
306 =head3 in PERL SCRIPT
308 my $authtypes = getauthtypes;
310 foreach my $thisauthtype (keys %$authtypes) {
311 my $selected = 1 if $thisauthtype eq $authtype;
312 my %row =(value => $thisauthtype,
313 selected => $selected,
314 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
316 push @authtypesloop, \%row;
318 $template->param(itemtypeloop => \@itemtypesloop);
322 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
323 <select name="authtype">
324 <!-- TMPL_LOOP name="authtypeloop" -->
325 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
328 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
329 <input type="submit" value="OK" class="button">
337 # returns a reference to a hash of references to authtypes...
339 my $dbh = C4::Context->dbh;
340 my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
342 while ( my $IT = $sth->fetchrow_hashref ) {
343 $authtypes{ $IT->{'authtypecode'} } = $IT;
345 return ( \%authtypes );
349 my ($authtypecode) = @_;
351 # returns a reference to a hash of references to authtypes...
353 my $dbh = C4::Context->dbh;
354 my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
355 $sth->execute($authtypecode);
356 my $res = $sth->fetchrow_hashref;
362 $frameworks = &getframework();
364 Returns information about existing frameworks
366 build a HTML select with the following code :
368 =head3 in PERL SCRIPT
370 my $frameworks = frameworks();
372 foreach my $thisframework (keys %$frameworks) {
373 my $selected = 1 if $thisframework eq $frameworkcode;
374 my %row =(value => $thisframework,
375 selected => $selected,
376 description => $frameworks->{$thisframework}->{'frameworktext'},
378 push @frameworksloop, \%row;
380 $template->param(frameworkloop => \@frameworksloop);
384 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
385 <select name="frameworkcode">
386 <option value="">Default</option>
387 <!-- TMPL_LOOP name="frameworkloop" -->
388 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
391 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
392 <input type="submit" value="OK" class="button">
399 # returns a reference to a hash of references to branches...
401 my $dbh = C4::Context->dbh;
402 my $sth = $dbh->prepare("select * from biblio_framework");
404 while ( my $IT = $sth->fetchrow_hashref ) {
405 $itemtypes{ $IT->{'frameworkcode'} } = $IT;
407 return ( \%itemtypes );
410 =head2 getframeworkinfo
412 $frameworkinfo = &getframeworkinfo($frameworkcode);
414 Returns information about an frameworkcode.
418 sub getframeworkinfo {
419 my ($frameworkcode) = @_;
420 my $dbh = C4::Context->dbh;
422 $dbh->prepare("select * from biblio_framework where frameworkcode=?");
423 $sth->execute($frameworkcode);
424 my $res = $sth->fetchrow_hashref;
428 =head2 getitemtypeinfo
430 $itemtype = &getitemtypeinfo($itemtype, [$interface]);
432 Returns information about an itemtype. The optional $interface argument
433 sets which interface ('opac' or 'intranet') to return the imageurl for.
434 Defaults to intranet.
438 sub getitemtypeinfo {
439 my ($itemtype, $interface) = @_;
440 my $dbh = C4::Context->dbh;
441 my $sth = $dbh->prepare("select * from itemtypes where itemtype=?");
442 $sth->execute($itemtype);
443 my $res = $sth->fetchrow_hashref;
445 $res->{imageurl} = getitemtypeimagelocation( ( ( defined $interface && $interface eq 'opac' ) ? 'opac' : 'intranet' ), $res->{imageurl} );
450 =head2 getitemtypeimagedir
452 my $directory = getitemtypeimagedir( 'opac' );
454 pass in 'opac' or 'intranet'. Defaults to 'opac'.
456 returns the full path to the appropriate directory containing images.
460 sub getitemtypeimagedir {
461 my $src = shift || 'opac';
462 if ($src eq 'intranet') {
463 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
465 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
469 sub getitemtypeimagesrc {
470 my $src = shift || 'opac';
471 if ($src eq 'intranet') {
472 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
474 return '/opac-tmpl' . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
478 sub getitemtypeimagelocation {
479 my ( $src, $image ) = @_;
481 return '' if ( !$image );
484 my $scheme = ( URI::Split::uri_split( $image ) )[0];
486 return $image if ( $scheme );
488 return getitemtypeimagesrc( $src ) . '/' . $image;
491 =head3 _getImagesFromDirectory
493 Find all of the image files in a directory in the filesystem
495 parameters: a directory name
497 returns: a list of images in that directory.
499 Notes: this does not traverse into subdirectories. See
500 _getSubdirectoryNames for help with that.
501 Images are assumed to be files with .gif or .png file extensions.
502 The image names returned do not have the directory name on them.
506 sub _getImagesFromDirectory {
507 my $directoryname = shift;
508 return unless defined $directoryname;
509 return unless -d $directoryname;
511 if ( opendir ( my $dh, $directoryname ) ) {
512 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
514 @images = sort(@images);
517 warn "unable to opendir $directoryname: $!";
522 =head3 _getSubdirectoryNames
524 Find all of the directories in a directory in the filesystem
526 parameters: a directory name
528 returns: a list of subdirectories in that directory.
530 Notes: this does not traverse into subdirectories. Only the first
531 level of subdirectories are returned.
532 The directory names returned don't have the parent directory name on them.
536 sub _getSubdirectoryNames {
537 my $directoryname = shift;
538 return unless defined $directoryname;
539 return unless -d $directoryname;
541 if ( opendir ( my $dh, $directoryname ) ) {
542 my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
546 warn "unable to opendir $directoryname: $!";
553 returns: a listref of hashrefs. Each hash represents another collection of images.
555 { imagesetname => 'npl', # the name of the image set (npl is the original one)
556 images => listref of image hashrefs
559 each image is represented by a hashref like this:
561 { KohaImage => 'npl/image.gif',
562 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
563 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
564 checked => 0 or 1: was this the image passed to this method?
565 Note: I'd like to remove this somehow.
572 my $checked = $params{'checked'} || '';
574 my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
575 url => getitemtypeimagesrc('intranet'),
577 opac => { filesystem => getitemtypeimagedir('opac'),
578 url => getitemtypeimagesrc('opac'),
582 my @imagesets = (); # list of hasrefs of image set data to pass to template
583 my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
584 foreach my $imagesubdir ( @subdirectories ) {
585 warn $imagesubdir if $DEBUG;
586 my @imagelist = (); # hashrefs of image info
587 my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
588 my $imagesetactive = 0;
589 foreach my $thisimage ( @imagenames ) {
591 { KohaImage => "$imagesubdir/$thisimage",
592 StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
593 OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
594 checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
597 $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
599 push @imagesets, { imagesetname => $imagesubdir,
600 imagesetactive => $imagesetactive,
601 images => \@imagelist };
609 $printers = &GetPrinters();
610 @queues = keys %$printers;
612 Returns information about existing printer queues.
614 C<$printers> is a reference-to-hash whose keys are the print queues
615 defined in the printers table of the Koha database. The values are
616 references-to-hash, whose keys are the fields in the printers table.
622 my $dbh = C4::Context->dbh;
623 my $sth = $dbh->prepare("select * from printers");
625 while ( my $printer = $sth->fetchrow_hashref ) {
626 $printers{ $printer->{'printqueue'} } = $printer;
628 return ( \%printers );
633 $printer = GetPrinter( $query, $printers );
638 my ( $query, $printers ) = @_; # get printer for this query from printers
639 my $printer = $query->param('printer');
640 my %cookie = $query->cookie('userenv');
641 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
642 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
648 Returns the number of pages to display in a pagination bar, given the number
649 of items and the number of items per page.
654 my ( $nb_items, $nb_items_per_page ) = @_;
656 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
661 (@themes) = &getallthemes('opac');
662 (@themes) = &getallthemes('intranet');
664 Returns an array of all available themes.
672 if ( $type eq 'intranet' ) {
673 $htdocs = C4::Context->config('intrahtdocs');
676 $htdocs = C4::Context->config('opachtdocs');
678 opendir D, "$htdocs";
679 my @dirlist = readdir D;
680 foreach my $directory (@dirlist) {
681 next if $directory eq 'lib';
682 -d "$htdocs/$directory/en" and push @themes, $directory;
689 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
694 tags => [ qw/ 600ab 601ab 602a 604at 605a 606ax 610a / ],
700 tags => [ qw/ 607a / ],
706 tags => [ qw/ 500a 501a 503a / ],
712 tags => [ qw/ 700ab 701ab 702ab / ],
713 sep => C4::Context->preference("UNIMARCAuthorsFacetsSeparator"),
718 tags => [ qw/ 225a / ],
724 unless ( C4::Context->preference("singleBranchMode") || GetBranchesCount() == 1 ) {
727 label => 'Libraries',
728 tags => [ qw/ 995b / ],
734 tags => [ qw/ 995c / ],
737 push( @$facets, $library_facet );
744 tags => [ qw/ 650a / ],
749 # label => 'People and Organizations',
750 # tags => [ qw/ 600a 610a 611a / ],
756 tags => [ qw/ 651a / ],
762 tags => [ qw/ 630a / ],
768 tags => [ qw/ 100a 110a 700a / ],
774 tags => [ qw/ 440a 490a / ],
779 label => 'ItemTypes',
780 tags => [ qw/ 952y 942c / ],
786 unless ( C4::Context->preference("singleBranchMode") || GetBranchesCount() == 1 ) {
789 label => 'Libraries',
790 tags => [ qw / 952b / ],
796 tags => [ qw / 952c / ],
799 push( @$facets, $library_facet );
806 Return a href where a key is associated to a href. You give a query,
807 the name of the key among the fields returned by the query. If you
808 also give as third argument the name of the value, the function
809 returns a href of scalar. The optional 4th argument is an arrayref of
810 items passed to the C<execute()> call. It is designed to bind
811 parameters to any placeholders in your SQL.
820 # generic href of any information on the item, href of href.
821 my $iteminfos_of = get_infos_of($query, 'itemnumber');
822 print $iteminfos_of->{$itemnumber}{barcode};
824 # specific information, href of scalar
825 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
826 print $barcode_of_item->{$itemnumber};
831 my ( $query, $key_name, $value_name, $bind_params ) = @_;
833 my $dbh = C4::Context->dbh;
835 my $sth = $dbh->prepare($query);
836 $sth->execute( @$bind_params );
839 while ( my $row = $sth->fetchrow_hashref ) {
840 if ( defined $value_name ) {
841 $infos_of{ $row->{$key_name} } = $row->{$value_name};
844 $infos_of{ $row->{$key_name} } = $row;
852 =head2 get_notforloan_label_of
854 my $notforloan_label_of = get_notforloan_label_of();
856 Each authorised value of notforloan (information available in items and
857 itemtypes) is link to a single label.
859 Returns a href where keys are authorised values and values are corresponding
862 foreach my $authorised_value (keys %{$notforloan_label_of}) {
864 "authorised_value: %s => %s\n",
866 $notforloan_label_of->{$authorised_value}
872 # FIXME - why not use GetAuthorisedValues ??
874 sub get_notforloan_label_of {
875 my $dbh = C4::Context->dbh;
878 SELECT authorised_value
879 FROM marc_subfield_structure
880 WHERE kohafield = \'items.notforloan\'
883 my $sth = $dbh->prepare($query);
885 my ($statuscode) = $sth->fetchrow_array();
890 FROM authorised_values
893 $sth = $dbh->prepare($query);
894 $sth->execute($statuscode);
895 my %notforloan_label_of;
896 while ( my $row = $sth->fetchrow_hashref ) {
897 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
901 return \%notforloan_label_of;
904 =head2 displayServers
906 my $servers = displayServers();
907 my $servers = displayServers( $position );
908 my $servers = displayServers( $position, $type );
910 displayServers returns a listref of hashrefs, each containing
911 information about available z3950 servers. Each hashref has a format
915 'checked' => 'checked',
916 'encoding' => 'utf8',
918 'id' => 'LIBRARY OF CONGRESS',
922 'value' => 'lx2.loc.gov:210/',
929 my ( $position, $type ) = @_;
930 my $dbh = C4::Context->dbh;
932 my $strsth = 'SELECT * FROM z3950servers';
937 push @bind_params, $position;
938 push @where_clauses, ' position = ? ';
942 push @bind_params, $type;
943 push @where_clauses, ' type = ? ';
946 # reassemble where clause from where clause pieces
947 if (@where_clauses) {
948 $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
951 my $rq = $dbh->prepare($strsth);
952 $rq->execute(@bind_params);
953 my @primaryserverloop;
955 while ( my $data = $rq->fetchrow_hashref ) {
956 push @primaryserverloop,
957 { label => $data->{description},
960 value => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
961 encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
962 checked => "checked",
963 icon => $data->{icon},
964 zed => $data->{type} eq 'zed',
965 opensearch => $data->{type} eq 'opensearch'
968 return \@primaryserverloop;
972 =head2 GetKohaImageurlFromAuthorisedValues
974 $authhorised_value = GetKohaImageurlFromAuthorisedValues( $category, $authvalcode );
976 Return the first url of the authorised value image represented by $lib.
980 sub GetKohaImageurlFromAuthorisedValues {
981 my ( $category, $lib ) = @_;
982 my $dbh = C4::Context->dbh;
983 my $sth = $dbh->prepare("SELECT imageurl FROM authorised_values WHERE category=? AND lib =?");
984 $sth->execute( $category, $lib );
985 while ( my $data = $sth->fetchrow_hashref ) {
986 return $data->{'imageurl'};
990 =head2 GetAuthValCode
992 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
997 my ($kohafield,$fwcode) = @_;
998 my $dbh = C4::Context->dbh;
999 $fwcode='' unless $fwcode;
1000 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
1001 $sth->execute($kohafield,$fwcode);
1002 my ($authvalcode) = $sth->fetchrow_array;
1003 return $authvalcode;
1006 =head2 GetAuthValCodeFromField
1008 $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
1010 C<$subfield> can be undefined
1014 sub GetAuthValCodeFromField {
1015 my ($field,$subfield,$fwcode) = @_;
1016 my $dbh = C4::Context->dbh;
1017 $fwcode='' unless $fwcode;
1019 if (defined $subfield) {
1020 $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
1021 $sth->execute($field,$subfield,$fwcode);
1023 $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
1024 $sth->execute($field,$fwcode);
1026 my ($authvalcode) = $sth->fetchrow_array;
1027 return $authvalcode;
1030 =head2 GetAuthorisedValues
1032 $authvalues = GetAuthorisedValues([$category], [$selected]);
1034 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
1036 C<$category> returns authorised values for just one category (optional).
1038 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1042 sub GetAuthorisedValues {
1043 my ( $category, $selected, $opac ) = @_;
1044 my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1046 my $dbh = C4::Context->dbh;
1049 FROM authorised_values
1052 LEFT JOIN authorised_values_branches ON ( id = av_id )
1057 push @where_strings, "category = ?";
1058 push @where_args, $category;
1061 push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
1062 push @where_args, $branch_limit;
1064 if(@where_strings > 0) {
1065 $query .= " WHERE " . join(" AND ", @where_strings);
1067 $query .= " GROUP BY lib ORDER BY category, lib, lib_opac";
1069 my $sth = $dbh->prepare($query);
1071 $sth->execute( @where_args );
1072 while (my $data=$sth->fetchrow_hashref) {
1073 if ( defined $selected and $selected eq $data->{authorised_value} ) {
1074 $data->{selected} = 1;
1077 $data->{selected} = 0;
1080 if ($opac && $data->{lib_opac}) {
1081 $data->{lib} = $data->{lib_opac};
1083 push @results, $data;
1089 =head2 GetAuthorisedValueCategories
1091 $auth_categories = GetAuthorisedValueCategories();
1093 Return an arrayref of all of the available authorised
1098 sub GetAuthorisedValueCategories {
1099 my $dbh = C4::Context->dbh;
1100 my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1103 while (defined (my $category = $sth->fetchrow_array) ) {
1104 push @results, $category;
1109 =head2 IsAuthorisedValueCategory
1111 $is_auth_val_category = IsAuthorisedValueCategory($category);
1113 Returns whether a given category name is a valid one
1117 sub IsAuthorisedValueCategory {
1118 my $category = shift;
1121 FROM authorised_values
1122 WHERE BINARY category=?
1125 my $sth = C4::Context->dbh->prepare($query);
1126 $sth->execute($category);
1127 $sth->fetchrow ? return 1
1131 =head2 GetAuthorisedValueByCode
1133 $authhorised_value = GetAuthorisedValueByCode( $category, $authvalcode );
1135 Return the lib attribute from authorised_values from the row identified
1136 by the passed category and code
1140 sub GetAuthorisedValueByCode {
1141 my ( $category, $authvalcode, $opac ) = @_;
1143 my $field = $opac ? 'lib_opac' : 'lib';
1144 my $dbh = C4::Context->dbh;
1145 my $sth = $dbh->prepare("SELECT $field FROM authorised_values WHERE category=? AND authorised_value =?");
1146 $sth->execute( $category, $authvalcode );
1147 while ( my $data = $sth->fetchrow_hashref ) {
1148 return $data->{ $field };
1152 =head2 GetKohaAuthorisedValues
1154 Takes $kohafield, $fwcode as parameters.
1156 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1158 Returns hashref of Code => description
1160 Returns undef if no authorised value category is defined for the kohafield.
1164 sub GetKohaAuthorisedValues {
1165 my ($kohafield,$fwcode,$opac) = @_;
1166 $fwcode='' unless $fwcode;
1168 my $dbh = C4::Context->dbh;
1169 my $avcode = GetAuthValCode($kohafield,$fwcode);
1171 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1172 $sth->execute($avcode);
1173 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1174 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1182 =head2 GetKohaAuthorisedValuesFromField
1184 Takes $field, $subfield, $fwcode as parameters.
1186 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1187 $subfield can be undefined
1189 Returns hashref of Code => description
1191 Returns undef if no authorised value category is defined for the given field and subfield
1195 sub GetKohaAuthorisedValuesFromField {
1196 my ($field, $subfield, $fwcode,$opac) = @_;
1197 $fwcode='' unless $fwcode;
1199 my $dbh = C4::Context->dbh;
1200 my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1202 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1203 $sth->execute($avcode);
1204 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1205 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1215 my $escaped_string = C4::Koha::xml_escape($string);
1217 Convert &, <, >, ', and " in a string to XML entities
1223 return '' unless defined $str;
1224 $str =~ s/&/&/g;
1227 $str =~ s/'/'/g;
1228 $str =~ s/"/"/g;
1232 =head2 GetKohaAuthorisedValueLib
1234 Takes $category, $authorised_value as parameters.
1236 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1238 Returns authorised value description
1242 sub GetKohaAuthorisedValueLib {
1243 my ($category,$authorised_value,$opac) = @_;
1245 my $dbh = C4::Context->dbh;
1246 my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1247 $sth->execute($category,$authorised_value);
1248 my $data = $sth->fetchrow_hashref;
1249 $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1253 =head2 AddAuthorisedValue
1255 AddAuthorisedValue($category, $authorised_value, $lib, $lib_opac, $imageurl);
1257 Create a new authorised value.
1261 sub AddAuthorisedValue {
1262 my ($category, $authorised_value, $lib, $lib_opac, $imageurl) = @_;
1264 my $dbh = C4::Context->dbh;
1266 INSERT INTO authorised_values (category, authorised_value, lib, lib_opac, imageurl)
1269 my $sth = $dbh->prepare($query);
1270 $sth->execute($category, $authorised_value, $lib, $lib_opac, $imageurl);
1273 =head2 display_marc_indicators
1275 my $display_form = C4::Koha::display_marc_indicators($field);
1277 C<$field> is a MARC::Field object
1279 Generate a display form of the indicators of a variable
1280 MARC field, replacing any blanks with '#'.
1284 sub display_marc_indicators {
1286 my $indicators = '';
1287 if ($field->tag() >= 10) {
1288 $indicators = $field->indicator(1) . $field->indicator(2);
1289 $indicators =~ s/ /#/g;
1294 sub GetNormalizedUPC {
1295 my ($record,$marcflavour) = @_;
1298 if ($marcflavour eq 'UNIMARC') {
1299 @fields = $record->field('072');
1300 foreach my $field (@fields) {
1301 my $upc = _normalize_match_point($field->subfield('a'));
1308 else { # assume marc21 if not unimarc
1309 @fields = $record->field('024');
1310 foreach my $field (@fields) {
1311 my $indicator = $field->indicator(1);
1312 my $upc = _normalize_match_point($field->subfield('a'));
1313 if ($indicator == 1 and $upc ne '') {
1320 # Normalizes and returns the first valid ISBN found in the record
1321 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
1322 sub GetNormalizedISBN {
1323 my ($isbn,$record,$marcflavour) = @_;
1326 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1327 # anything after " | " should be removed, along with the delimiter
1328 $isbn =~ s/(.*)( \| )(.*)/$1/;
1329 return _isbn_cleanup($isbn);
1331 return unless $record;
1333 if ($marcflavour eq 'UNIMARC') {
1334 @fields = $record->field('010');
1335 foreach my $field (@fields) {
1336 my $isbn = $field->subfield('a');
1338 return _isbn_cleanup($isbn);
1344 else { # assume marc21 if not unimarc
1345 @fields = $record->field('020');
1346 foreach my $field (@fields) {
1347 $isbn = $field->subfield('a');
1349 return _isbn_cleanup($isbn);
1357 sub GetNormalizedEAN {
1358 my ($record,$marcflavour) = @_;
1361 if ($marcflavour eq 'UNIMARC') {
1362 @fields = $record->field('073');
1363 foreach my $field (@fields) {
1364 $ean = _normalize_match_point($field->subfield('a'));
1370 else { # assume marc21 if not unimarc
1371 @fields = $record->field('024');
1372 foreach my $field (@fields) {
1373 my $indicator = $field->indicator(1);
1374 $ean = _normalize_match_point($field->subfield('a'));
1375 if ($indicator == 3 and $ean ne '') {
1381 sub GetNormalizedOCLCNumber {
1382 my ($record,$marcflavour) = @_;
1385 if ($marcflavour eq 'UNIMARC') {
1386 # TODO: add UNIMARC fields
1388 else { # assume marc21 if not unimarc
1389 @fields = $record->field('035');
1390 foreach my $field (@fields) {
1391 $oclc = $field->subfield('a');
1392 if ($oclc =~ /OCoLC/) {
1393 $oclc =~ s/\(OCoLC\)//;
1402 =head2 GetDailyQuote($opts)
1404 Takes a hashref of options
1406 Currently supported options are:
1408 'id' An exact quote id
1409 'random' Select a random quote
1410 noop When no option is passed in, this sub will return the quote timestamped for the current day
1412 The function returns an anonymous hash following this format:
1415 'source' => 'source-of-quote',
1416 'timestamp' => 'timestamp-value',
1417 'text' => 'text-of-quote',
1423 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1424 # at least for default option
1428 my $dbh = C4::Context->dbh;
1433 $query = 'SELECT * FROM quotes WHERE id = ?';
1434 $sth = $dbh->prepare($query);
1435 $sth->execute($opts{'id'});
1436 $quote = $sth->fetchrow_hashref();
1438 elsif ($opts{'random'}) {
1439 # Fall through... we also return a random quote as a catch-all if all else fails
1442 $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1443 $sth = $dbh->prepare($query);
1445 $quote = $sth->fetchrow_hashref();
1447 unless ($quote) { # if there are not matches, choose a random quote
1448 # get a list of all available quote ids
1449 $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1451 my $range = ($sth->fetchrow_array)[0];
1453 # chose a random id within that range if there is more than one quote
1454 my $id = int(rand($range));
1456 $query = 'SELECT * FROM quotes WHERE id = ?;';
1457 $sth = C4::Context->dbh->prepare($query);
1461 $query = 'SELECT * FROM quotes;';
1462 $sth = C4::Context->dbh->prepare($query);
1465 $quote = $sth->fetchrow_hashref();
1466 # update the timestamp for that quote
1467 $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1468 $sth = C4::Context->dbh->prepare($query);
1469 $sth->execute(DateTime::Format::MySQL->format_datetime(DateTime->now), $quote->{'id'});
1474 sub _normalize_match_point {
1475 my $match_point = shift;
1476 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1477 $normalized_match_point =~ s/-//g;
1479 return $normalized_match_point;
1483 require Business::ISBN;
1484 my $isbn = Business::ISBN->new( $_[0] );
1486 $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13';
1487 if (defined $isbn) {
1488 return $isbn->as_string([]);