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 &GetKohaAuthorisedValues
61 &GetKohaAuthorisedValuesFromField
62 &GetKohaAuthorisedValueLib
63 &GetAuthorisedValueByCode
64 &GetKohaImageurlFromAuthorisedValues
69 &GetNormalizedOCLCNumber
75 @EXPORT_OK = qw( GetDailyQuote );
79 memoize
('GetAuthorisedValues');
83 C4::Koha - Perl Module containing convenience functions for Koha scripts
91 Koha.pm provides many functions for Koha scripts.
99 $slash_date = &slashifyDate($dash_date);
101 Takes a string of the form "DD-MM-YYYY" (or anything separated by
102 dashes), converts it to the form "YYYY/MM/DD", and returns the result.
108 # accepts a date of the form xx-xx-xx[xx] and returns it in the
110 my @dateOut = split( '-', shift );
111 return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
114 # FIXME.. this should be moved to a MARC-specific module
115 sub subfield_is_koha_internal_p
{
118 # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
119 # But real MARC subfields are always single-character
120 # so it really is safer just to check the length
122 return length $subfield != 1;
125 =head2 GetSupportName
127 $itemtypename = &GetSupportName($codestring);
129 Returns a string with the name of the itemtype.
135 return if (! $codestring);
137 my $advanced_search_types = C4
::Context
->preference("AdvancedSearchTypes");
138 if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
145 my $sth = C4
::Context
->dbh->prepare($query);
146 $sth->execute($codestring);
147 ($resultstring)=$sth->fetchrow;
148 return $resultstring;
151 C4
::Context
->dbh->prepare(
152 "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
154 $sth->execute( $advanced_search_types, $codestring );
155 my $data = $sth->fetchrow_hashref;
156 return $$data{'lib'};
160 =head2 GetSupportList
162 $itemtypes = &GetSupportList();
164 Returns an array ref containing informations about Support (since itemtype is rather a circulation code when item-level-itypes is used).
166 build a HTML select with the following code :
168 =head3 in PERL SCRIPT
170 my $itemtypes = GetSupportList();
171 $template->param(itemtypeloop => $itemtypes);
175 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
176 <select name="itemtype">
177 <option value="">Default</option>
178 <!-- TMPL_LOOP name="itemtypeloop" -->
179 <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>
182 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
183 <input type="submit" value="OK" class="button">
189 my $advanced_search_types = C4
::Context
->preference("AdvancedSearchTypes");
190 if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
196 my $sth = C4
::Context
->dbh->prepare($query);
198 return $sth->fetchall_arrayref({});
200 my $advsearchtypes = GetAuthorisedValues
($advanced_search_types);
201 my @results= map {{itemtype
=>$$_{authorised_value
},description
=>$$_{lib
},imageurl
=>$$_{imageurl
}}} @
$advsearchtypes;
207 $itemtypes = &GetItemTypes();
209 Returns information about existing itemtypes.
211 build a HTML select with the following code :
213 =head3 in PERL SCRIPT
215 my $itemtypes = GetItemTypes;
217 foreach my $thisitemtype (sort keys %$itemtypes) {
218 my $selected = 1 if $thisitemtype eq $itemtype;
219 my %row =(value => $thisitemtype,
220 selected => $selected,
221 description => $itemtypes->{$thisitemtype}->{'description'},
223 push @itemtypesloop, \%row;
225 $template->param(itemtypeloop => \@itemtypesloop);
229 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
230 <select name="itemtype">
231 <option value="">Default</option>
232 <!-- TMPL_LOOP name="itemtypeloop" -->
233 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
236 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
237 <input type="submit" value="OK" class="button">
244 # returns a reference to a hash of references to itemtypes...
246 my $dbh = C4
::Context
->dbh;
251 my $sth = $dbh->prepare($query);
253 while ( my $IT = $sth->fetchrow_hashref ) {
254 $itemtypes{ $IT->{'itemtype'} } = $IT;
256 return ( \
%itemtypes );
259 sub get_itemtypeinfos_of
{
262 my $placeholders = join( ', ', map { '?' } @itemtypes );
263 my $query = <<"END_SQL";
269 WHERE itemtype IN ( $placeholders )
272 return get_infos_of( $query, 'itemtype', undef, \@itemtypes );
275 # this is temporary until we separate collection codes and item types
279 my $dbh = C4::Context->dbh;
282 "SELECT * FROM authorised_values ORDER BY authorised_value");
284 while ( my $data = $sth->fetchrow_hashref ) {
285 if ( $data->{category} eq "CCODE" ) {
287 $results[$count] = $data;
293 return ( $count, @results );
298 $authtypes = &getauthtypes();
300 Returns information about existing authtypes.
302 build a HTML select with the following code :
304 =head3 in PERL SCRIPT
306 my $authtypes = getauthtypes;
308 foreach my $thisauthtype (keys %$authtypes) {
309 my $selected = 1 if $thisauthtype eq $authtype;
310 my %row =(value => $thisauthtype,
311 selected => $selected,
312 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
314 push @authtypesloop, \%row;
316 $template->param(itemtypeloop => \@itemtypesloop);
320 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
321 <select name="authtype">
322 <!-- TMPL_LOOP name="authtypeloop" -->
323 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
326 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
327 <input type="submit" value="OK" class="button">
335 # returns a reference to a hash of references to authtypes...
337 my $dbh = C4::Context->dbh;
338 my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
340 while ( my $IT = $sth->fetchrow_hashref ) {
341 $authtypes{ $IT->{'authtypecode'} } = $IT;
343 return ( \%authtypes );
347 my ($authtypecode) = @_;
349 # returns a reference to a hash of references to authtypes...
351 my $dbh = C4::Context->dbh;
352 my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
353 $sth->execute($authtypecode);
354 my $res = $sth->fetchrow_hashref;
360 $frameworks = &getframework();
362 Returns information about existing frameworks
364 build a HTML select with the following code :
366 =head3 in PERL SCRIPT
368 my $frameworks = frameworks();
370 foreach my $thisframework (keys %$frameworks) {
371 my $selected = 1 if $thisframework eq $frameworkcode;
372 my %row =(value => $thisframework,
373 selected => $selected,
374 description => $frameworks->{$thisframework}->{'frameworktext'},
376 push @frameworksloop, \%row;
378 $template->param(frameworkloop => \@frameworksloop);
382 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
383 <select name="frameworkcode">
384 <option value="">Default</option>
385 <!-- TMPL_LOOP name="frameworkloop" -->
386 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
389 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
390 <input type="submit" value="OK" class="button">
397 # returns a reference to a hash of references to branches...
399 my $dbh = C4::Context->dbh;
400 my $sth = $dbh->prepare("select * from biblio_framework");
402 while ( my $IT = $sth->fetchrow_hashref ) {
403 $itemtypes{ $IT->{'frameworkcode'} } = $IT;
405 return ( \%itemtypes );
408 =head2 getframeworkinfo
410 $frameworkinfo = &getframeworkinfo($frameworkcode);
412 Returns information about an frameworkcode.
416 sub getframeworkinfo {
417 my ($frameworkcode) = @_;
418 my $dbh = C4::Context->dbh;
420 $dbh->prepare("select * from biblio_framework where frameworkcode=?");
421 $sth->execute($frameworkcode);
422 my $res = $sth->fetchrow_hashref;
426 =head2 getitemtypeinfo
428 $itemtype = &getitemtype($itemtype, [$interface]);
430 Returns information about an itemtype. The optional $interface argument
431 sets which interface ('opac' or 'intranet') to return the imageurl for.
432 Defaults to intranet.
436 sub getitemtypeinfo {
437 my ($itemtype, $interface) = @_;
438 my $dbh = C4::Context->dbh;
439 my $sth = $dbh->prepare("select * from itemtypes where itemtype=?");
440 $sth->execute($itemtype);
441 my $res = $sth->fetchrow_hashref;
443 $res->{imageurl} = getitemtypeimagelocation( ( $interface eq 'opac' ? 'opac' : 'intranet' ), $res->{imageurl} );
448 =head2 getitemtypeimagedir
450 my $directory = getitemtypeimagedir( 'opac' );
452 pass in 'opac' or 'intranet'. Defaults to 'opac'.
454 returns the full path to the appropriate directory containing images.
458 sub getitemtypeimagedir {
459 my $src = shift || 'opac';
460 if ($src eq 'intranet') {
461 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
463 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
467 sub getitemtypeimagesrc {
468 my $src = shift || 'opac';
469 if ($src eq 'intranet') {
470 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
472 return '/opac-tmpl' . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
476 sub getitemtypeimagelocation {
477 my ( $src, $image ) = @_;
479 return '' if ( !$image );
482 my $scheme = ( URI::Split::uri_split( $image ) )[0];
484 return $image if ( $scheme );
486 return getitemtypeimagesrc( $src ) . '/' . $image;
489 =head3 _getImagesFromDirectory
491 Find all of the image files in a directory in the filesystem
493 parameters: a directory name
495 returns: a list of images in that directory.
497 Notes: this does not traverse into subdirectories. See
498 _getSubdirectoryNames for help with that.
499 Images are assumed to be files with .gif or .png file extensions.
500 The image names returned do not have the directory name on them.
504 sub _getImagesFromDirectory {
505 my $directoryname = shift;
506 return unless defined $directoryname;
507 return unless -d $directoryname;
509 if ( opendir ( my $dh, $directoryname ) ) {
510 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
512 @images = sort(@images);
515 warn "unable to opendir $directoryname: $!";
520 =head3 _getSubdirectoryNames
522 Find all of the directories in a directory in the filesystem
524 parameters: a directory name
526 returns: a list of subdirectories in that directory.
528 Notes: this does not traverse into subdirectories. Only the first
529 level of subdirectories are returned.
530 The directory names returned don't have the parent directory name on them.
534 sub _getSubdirectoryNames {
535 my $directoryname = shift;
536 return unless defined $directoryname;
537 return unless -d $directoryname;
539 if ( opendir ( my $dh, $directoryname ) ) {
540 my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
544 warn "unable to opendir $directoryname: $!";
551 returns: a listref of hashrefs. Each hash represents another collection of images.
553 { imagesetname => 'npl', # the name of the image set (npl is the original one)
554 images => listref of image hashrefs
557 each image is represented by a hashref like this:
559 { KohaImage => 'npl/image.gif',
560 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
561 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
562 checked => 0 or 1: was this the image passed to this method?
563 Note: I'd like to remove this somehow.
570 my $checked = $params{'checked'} || '';
572 my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
573 url => getitemtypeimagesrc('intranet'),
575 opac => { filesystem => getitemtypeimagedir('opac'),
576 url => getitemtypeimagesrc('opac'),
580 my @imagesets = (); # list of hasrefs of image set data to pass to template
581 my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
582 foreach my $imagesubdir ( @subdirectories ) {
583 warn $imagesubdir if $DEBUG;
584 my @imagelist = (); # hashrefs of image info
585 my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
586 my $imagesetactive = 0;
587 foreach my $thisimage ( @imagenames ) {
589 { KohaImage => "$imagesubdir/$thisimage",
590 StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
591 OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
592 checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
595 $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
597 push @imagesets, { imagesetname => $imagesubdir,
598 imagesetactive => $imagesetactive,
599 images => \@imagelist };
607 $printers = &GetPrinters();
608 @queues = keys %$printers;
610 Returns information about existing printer queues.
612 C<$printers> is a reference-to-hash whose keys are the print queues
613 defined in the printers table of the Koha database. The values are
614 references-to-hash, whose keys are the fields in the printers table.
620 my $dbh = C4::Context->dbh;
621 my $sth = $dbh->prepare("select * from printers");
623 while ( my $printer = $sth->fetchrow_hashref ) {
624 $printers{ $printer->{'printqueue'} } = $printer;
626 return ( \%printers );
631 $printer = GetPrinter( $query, $printers );
636 my ( $query, $printers ) = @_; # get printer for this query from printers
637 my $printer = $query->param('printer');
638 my %cookie = $query->cookie('userenv');
639 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
640 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
646 Returns the number of pages to display in a pagination bar, given the number
647 of items and the number of items per page.
652 my ( $nb_items, $nb_items_per_page ) = @_;
654 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
659 (@themes) = &getallthemes('opac');
660 (@themes) = &getallthemes('intranet');
662 Returns an array of all available themes.
670 if ( $type eq 'intranet' ) {
671 $htdocs = C4::Context->config('intrahtdocs');
674 $htdocs = C4::Context->config('opachtdocs');
676 opendir D, "$htdocs";
677 my @dirlist = readdir D;
678 foreach my $directory (@dirlist) {
679 next if $directory eq 'lib';
680 -d "$htdocs/$directory/en" and push @themes, $directory;
687 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
692 tags => [ qw/ 600ab 601ab 602a 604at 605a 606ax 610a / ],
698 tags => [ qw/ 607a / ],
704 tags => [ qw/ 500a 501a 503a / ],
710 tags => [ qw/ 700ab 701ab 702ab / ],
716 tags => [ qw/ 225a / ],
722 unless ( C4::Context->preference("singleBranchMode") || GetBranchesCount() == 1 ) {
725 label => 'Libraries',
726 tags => [ qw/ 995b / ],
732 tags => [ qw/ 995c / ],
735 push( @$facets, $library_facet );
742 tags => [ qw/ 650a / ],
747 # label => 'People and Organizations',
748 # tags => [ qw/ 600a 610a 611a / ],
754 tags => [ qw/ 651a / ],
760 tags => [ qw/ 630a / ],
766 tags => [ qw/ 100a 110a 700a / ],
772 tags => [ qw/ 440a 490a / ],
777 label => 'ItemTypes',
778 tags => [ qw/ 952y 942c / ],
784 unless ( C4::Context->preference("singleBranchMode") || GetBranchesCount() == 1 ) {
787 label => 'Libraries',
788 tags => [ qw / 952b / ],
794 tags => [ qw / 952c / ],
797 push( @$facets, $library_facet );
804 Return a href where a key is associated to a href. You give a query,
805 the name of the key among the fields returned by the query. If you
806 also give as third argument the name of the value, the function
807 returns a href of scalar. The optional 4th argument is an arrayref of
808 items passed to the C<execute()> call. It is designed to bind
809 parameters to any placeholders in your SQL.
818 # generic href of any information on the item, href of href.
819 my $iteminfos_of = get_infos_of($query, 'itemnumber');
820 print $iteminfos_of->{$itemnumber}{barcode};
822 # specific information, href of scalar
823 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
824 print $barcode_of_item->{$itemnumber};
829 my ( $query, $key_name, $value_name, $bind_params ) = @_;
831 my $dbh = C4::Context->dbh;
833 my $sth = $dbh->prepare($query);
834 $sth->execute( @$bind_params );
837 while ( my $row = $sth->fetchrow_hashref ) {
838 if ( defined $value_name ) {
839 $infos_of{ $row->{$key_name} } = $row->{$value_name};
842 $infos_of{ $row->{$key_name} } = $row;
850 =head2 get_notforloan_label_of
852 my $notforloan_label_of = get_notforloan_label_of();
854 Each authorised value of notforloan (information available in items and
855 itemtypes) is link to a single label.
857 Returns a href where keys are authorised values and values are corresponding
860 foreach my $authorised_value (keys %{$notforloan_label_of}) {
862 "authorised_value: %s => %s\n",
864 $notforloan_label_of->{$authorised_value}
870 # FIXME - why not use GetAuthorisedValues ??
872 sub get_notforloan_label_of {
873 my $dbh = C4::Context->dbh;
876 SELECT authorised_value
877 FROM marc_subfield_structure
878 WHERE kohafield = \'items.notforloan\'
881 my $sth = $dbh->prepare($query);
883 my ($statuscode) = $sth->fetchrow_array();
888 FROM authorised_values
891 $sth = $dbh->prepare($query);
892 $sth->execute($statuscode);
893 my %notforloan_label_of;
894 while ( my $row = $sth->fetchrow_hashref ) {
895 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
899 return \%notforloan_label_of;
902 =head2 displayServers
904 my $servers = displayServers();
905 my $servers = displayServers( $position );
906 my $servers = displayServers( $position, $type );
908 displayServers returns a listref of hashrefs, each containing
909 information about available z3950 servers. Each hashref has a format
913 'checked' => 'checked',
914 'encoding' => 'MARC-8'
916 'id' => 'LIBRARY OF CONGRESS',
920 'value' => 'z3950.loc.gov:7090/',
927 my ( $position, $type ) = @_;
928 my $dbh = C4::Context->dbh;
930 my $strsth = 'SELECT * FROM z3950servers';
935 push @bind_params, $position;
936 push @where_clauses, ' position = ? ';
940 push @bind_params, $type;
941 push @where_clauses, ' type = ? ';
944 # reassemble where clause from where clause pieces
945 if (@where_clauses) {
946 $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
949 my $rq = $dbh->prepare($strsth);
950 $rq->execute(@bind_params);
951 my @primaryserverloop;
953 while ( my $data = $rq->fetchrow_hashref ) {
954 push @primaryserverloop,
955 { label => $data->{description},
958 value => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
959 encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
960 checked => "checked",
961 icon => $data->{icon},
962 zed => $data->{type} eq 'zed',
963 opensearch => $data->{type} eq 'opensearch'
966 return \@primaryserverloop;
970 =head2 GetKohaImageurlFromAuthorisedValues
972 $authhorised_value = GetKohaImageurlFromAuthorisedValues( $category, $authvalcode );
974 Return the first url of the authorised value image represented by $lib.
978 sub GetKohaImageurlFromAuthorisedValues {
979 my ( $category, $lib ) = @_;
980 my $dbh = C4::Context->dbh;
981 my $sth = $dbh->prepare("SELECT imageurl FROM authorised_values WHERE category=? AND lib =?");
982 $sth->execute( $category, $lib );
983 while ( my $data = $sth->fetchrow_hashref ) {
984 return $data->{'imageurl'};
988 =head2 GetAuthValCode
990 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
995 my ($kohafield,$fwcode) = @_;
996 my $dbh = C4::Context->dbh;
997 $fwcode='' unless $fwcode;
998 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
999 $sth->execute($kohafield,$fwcode);
1000 my ($authvalcode) = $sth->fetchrow_array;
1001 return $authvalcode;
1004 =head2 GetAuthValCodeFromField
1006 $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
1008 C<$subfield> can be undefined
1012 sub GetAuthValCodeFromField {
1013 my ($field,$subfield,$fwcode) = @_;
1014 my $dbh = C4::Context->dbh;
1015 $fwcode='' unless $fwcode;
1017 if (defined $subfield) {
1018 $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
1019 $sth->execute($field,$subfield,$fwcode);
1021 $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
1022 $sth->execute($field,$fwcode);
1024 my ($authvalcode) = $sth->fetchrow_array;
1025 return $authvalcode;
1028 =head2 GetAuthorisedValues
1030 $authvalues = GetAuthorisedValues([$category], [$selected]);
1032 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
1034 C<$category> returns authorised values for just one category (optional).
1036 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1040 sub GetAuthorisedValues {
1041 my ( $category, $selected, $opac ) = @_;
1042 my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1044 my $dbh = C4::Context->dbh;
1047 FROM authorised_values
1050 LEFT JOIN authorised_values_branches ON ( id = av_id )
1055 push @where_strings, "category = ?";
1056 push @where_args, $category;
1059 push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
1060 push @where_args, $branch_limit;
1062 if(@where_strings > 0) {
1063 $query .= " WHERE " . join(" AND ", @where_strings);
1065 $query .= " GROUP BY lib ORDER BY category, lib, lib_opac";
1067 my $sth = $dbh->prepare($query);
1069 $sth->execute( @where_args );
1070 while (my $data=$sth->fetchrow_hashref) {
1071 if ( defined $selected and $selected eq $data->{authorised_value} ) {
1072 $data->{selected} = 1;
1075 $data->{selected} = 0;
1078 if ($opac && $data->{lib_opac}) {
1079 $data->{lib} = $data->{lib_opac};
1081 push @results, $data;
1087 =head2 GetAuthorisedValueCategories
1089 $auth_categories = GetAuthorisedValueCategories();
1091 Return an arrayref of all of the available authorised
1096 sub GetAuthorisedValueCategories {
1097 my $dbh = C4::Context->dbh;
1098 my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1101 while (defined (my $category = $sth->fetchrow_array) ) {
1102 push @results, $category;
1107 =head2 GetAuthorisedValueByCode
1109 $authhorised_value = GetAuthorisedValueByCode( $category, $authvalcode );
1111 Return the lib attribute from authorised_values from the row identified
1112 by the passed category and code
1116 sub GetAuthorisedValueByCode {
1117 my ( $category, $authvalcode, $opac ) = @_;
1119 my $field = $opac ? 'lib_opac' : 'lib';
1120 my $dbh = C4::Context->dbh;
1121 my $sth = $dbh->prepare("SELECT $field FROM authorised_values WHERE category=? AND authorised_value =?");
1122 $sth->execute( $category, $authvalcode );
1123 while ( my $data = $sth->fetchrow_hashref ) {
1124 return $data->{ $field };
1128 =head2 GetKohaAuthorisedValues
1130 Takes $kohafield, $fwcode as parameters.
1132 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1134 Returns hashref of Code => description
1136 Returns undef if no authorised value category is defined for the kohafield.
1140 sub GetKohaAuthorisedValues {
1141 my ($kohafield,$fwcode,$opac) = @_;
1142 $fwcode='' unless $fwcode;
1144 my $dbh = C4::Context->dbh;
1145 my $avcode = GetAuthValCode($kohafield,$fwcode);
1147 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1148 $sth->execute($avcode);
1149 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1150 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1158 =head2 GetKohaAuthorisedValuesFromField
1160 Takes $field, $subfield, $fwcode as parameters.
1162 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1163 $subfield can be undefined
1165 Returns hashref of Code => description
1167 Returns undef if no authorised value category is defined for the given field and subfield
1171 sub GetKohaAuthorisedValuesFromField {
1172 my ($field, $subfield, $fwcode,$opac) = @_;
1173 $fwcode='' unless $fwcode;
1175 my $dbh = C4::Context->dbh;
1176 my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1178 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1179 $sth->execute($avcode);
1180 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1181 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1191 my $escaped_string = C4::Koha::xml_escape($string);
1193 Convert &, <, >, ', and " in a string to XML entities
1199 return '' unless defined $str;
1200 $str =~ s/&/&/g;
1203 $str =~ s/'/'/g;
1204 $str =~ s/"/"/g;
1208 =head2 GetKohaAuthorisedValueLib
1210 Takes $category, $authorised_value as parameters.
1212 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1214 Returns authorised value description
1218 sub GetKohaAuthorisedValueLib {
1219 my ($category,$authorised_value,$opac) = @_;
1221 my $dbh = C4::Context->dbh;
1222 my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1223 $sth->execute($category,$authorised_value);
1224 my $data = $sth->fetchrow_hashref;
1225 $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1229 =head2 display_marc_indicators
1231 my $display_form = C4::Koha::display_marc_indicators($field);
1233 C<$field> is a MARC::Field object
1235 Generate a display form of the indicators of a variable
1236 MARC field, replacing any blanks with '#'.
1240 sub display_marc_indicators {
1242 my $indicators = '';
1243 if ($field->tag() >= 10) {
1244 $indicators = $field->indicator(1) . $field->indicator(2);
1245 $indicators =~ s/ /#/g;
1250 sub GetNormalizedUPC {
1251 my ($record,$marcflavour) = @_;
1254 if ($marcflavour eq 'UNIMARC') {
1255 @fields = $record->field('072');
1256 foreach my $field (@fields) {
1257 my $upc = _normalize_match_point($field->subfield('a'));
1264 else { # assume marc21 if not unimarc
1265 @fields = $record->field('024');
1266 foreach my $field (@fields) {
1267 my $indicator = $field->indicator(1);
1268 my $upc = _normalize_match_point($field->subfield('a'));
1269 if ($indicator == 1 and $upc ne '') {
1276 # Normalizes and returns the first valid ISBN found in the record
1277 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
1278 sub GetNormalizedISBN {
1279 my ($isbn,$record,$marcflavour) = @_;
1282 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1283 # anything after " | " should be removed, along with the delimiter
1284 $isbn =~ s/(.*)( \| )(.*)/$1/;
1285 return _isbn_cleanup($isbn);
1287 return unless $record;
1289 if ($marcflavour eq 'UNIMARC') {
1290 @fields = $record->field('010');
1291 foreach my $field (@fields) {
1292 my $isbn = $field->subfield('a');
1294 return _isbn_cleanup($isbn);
1300 else { # assume marc21 if not unimarc
1301 @fields = $record->field('020');
1302 foreach my $field (@fields) {
1303 $isbn = $field->subfield('a');
1305 return _isbn_cleanup($isbn);
1313 sub GetNormalizedEAN {
1314 my ($record,$marcflavour) = @_;
1317 if ($marcflavour eq 'UNIMARC') {
1318 @fields = $record->field('073');
1319 foreach my $field (@fields) {
1320 $ean = _normalize_match_point($field->subfield('a'));
1326 else { # assume marc21 if not unimarc
1327 @fields = $record->field('024');
1328 foreach my $field (@fields) {
1329 my $indicator = $field->indicator(1);
1330 $ean = _normalize_match_point($field->subfield('a'));
1331 if ($indicator == 3 and $ean ne '') {
1337 sub GetNormalizedOCLCNumber {
1338 my ($record,$marcflavour) = @_;
1341 if ($marcflavour eq 'UNIMARC') {
1342 # TODO: add UNIMARC fields
1344 else { # assume marc21 if not unimarc
1345 @fields = $record->field('035');
1346 foreach my $field (@fields) {
1347 $oclc = $field->subfield('a');
1348 if ($oclc =~ /OCoLC/) {
1349 $oclc =~ s/\(OCoLC\)//;
1358 =head2 GetDailyQuote($opts)
1360 Takes a hashref of options
1362 Currently supported options are:
1364 'id' An exact quote id
1365 'random' Select a random quote
1366 noop When no option is passed in, this sub will return the quote timestamped for the current day
1368 The function returns an anonymous hash following this format:
1371 'source' => 'source-of-quote',
1372 'timestamp' => 'timestamp-value',
1373 'text' => 'text-of-quote',
1379 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1380 # at least for default option
1384 my $dbh = C4::Context->dbh;
1389 $query = 'SELECT * FROM quotes WHERE id = ?';
1390 $sth = $dbh->prepare($query);
1391 $sth->execute($opts{'id'});
1392 $quote = $sth->fetchrow_hashref();
1394 elsif ($opts{'random'}) {
1395 # Fall through... we also return a random quote as a catch-all if all else fails
1398 $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1399 $sth = $dbh->prepare($query);
1401 $quote = $sth->fetchrow_hashref();
1403 unless ($quote) { # if there are not matches, choose a random quote
1404 # get a list of all available quote ids
1405 $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1407 my $range = ($sth->fetchrow_array)[0];
1409 # chose a random id within that range if there is more than one quote
1410 my $id = int(rand($range));
1412 $query = 'SELECT * FROM quotes WHERE id = ?;';
1413 $sth = C4::Context->dbh->prepare($query);
1417 $query = 'SELECT * FROM quotes;';
1418 $sth = C4::Context->dbh->prepare($query);
1421 $quote = $sth->fetchrow_hashref();
1422 # update the timestamp for that quote
1423 $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1424 $sth = C4::Context->dbh->prepare($query);
1425 $sth->execute(DateTime::Format::MySQL->format_datetime(DateTime->now), $quote->{'id'});
1430 sub _normalize_match_point {
1431 my $match_point = shift;
1432 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1433 $normalized_match_point =~ s/-//g;
1435 return $normalized_match_point;
1439 require Business::ISBN;
1440 my $isbn = Business::ISBN->new( $_[0] );
1442 $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13';
1443 if (defined $isbn) {
1444 return $isbn->as_string([]);