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
30 use DateTime::Format::MySQL;
31 use autouse 'Data::Dumper' => qw(Dumper);
33 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $DEBUG);
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);
430 Returns information about an itemtype.
434 sub getitemtypeinfo {
436 my $dbh = C4::Context->dbh;
437 my $sth = $dbh->prepare("select * from itemtypes where itemtype=?");
438 $sth->execute($itemtype);
439 my $res = $sth->fetchrow_hashref;
441 $res->{imageurl} = getitemtypeimagelocation( 'intranet', $res->{imageurl} );
446 =head2 getitemtypeimagedir
448 my $directory = getitemtypeimagedir( 'opac' );
450 pass in 'opac' or 'intranet'. Defaults to 'opac'.
452 returns the full path to the appropriate directory containing images.
456 sub getitemtypeimagedir {
457 my $src = shift || 'opac';
458 if ($src eq 'intranet') {
459 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
461 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
465 sub getitemtypeimagesrc {
466 my $src = shift || 'opac';
467 if ($src eq 'intranet') {
468 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
470 return '/opac-tmpl' . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
474 sub getitemtypeimagelocation($$) {
475 my ( $src, $image ) = @_;
477 return '' if ( !$image );
480 my $scheme = ( URI::Split::uri_split( $image ) )[0];
482 return $image if ( $scheme );
484 return getitemtypeimagesrc( $src ) . '/' . $image;
487 =head3 _getImagesFromDirectory
489 Find all of the image files in a directory in the filesystem
491 parameters: a directory name
493 returns: a list of images in that directory.
495 Notes: this does not traverse into subdirectories. See
496 _getSubdirectoryNames for help with that.
497 Images are assumed to be files with .gif or .png file extensions.
498 The image names returned do not have the directory name on them.
502 sub _getImagesFromDirectory {
503 my $directoryname = shift;
504 return unless defined $directoryname;
505 return unless -d $directoryname;
507 if ( opendir ( my $dh, $directoryname ) ) {
508 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
510 @images = sort(@images);
513 warn "unable to opendir $directoryname: $!";
518 =head3 _getSubdirectoryNames
520 Find all of the directories in a directory in the filesystem
522 parameters: a directory name
524 returns: a list of subdirectories in that directory.
526 Notes: this does not traverse into subdirectories. Only the first
527 level of subdirectories are returned.
528 The directory names returned don't have the parent directory name on them.
532 sub _getSubdirectoryNames {
533 my $directoryname = shift;
534 return unless defined $directoryname;
535 return unless -d $directoryname;
537 if ( opendir ( my $dh, $directoryname ) ) {
538 my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
542 warn "unable to opendir $directoryname: $!";
549 returns: a listref of hashrefs. Each hash represents another collection of images.
551 { imagesetname => 'npl', # the name of the image set (npl is the original one)
552 images => listref of image hashrefs
555 each image is represented by a hashref like this:
557 { KohaImage => 'npl/image.gif',
558 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
559 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
560 checked => 0 or 1: was this the image passed to this method?
561 Note: I'd like to remove this somehow.
568 my $checked = $params{'checked'} || '';
570 my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
571 url => getitemtypeimagesrc('intranet'),
573 opac => { filesystem => getitemtypeimagedir('opac'),
574 url => getitemtypeimagesrc('opac'),
578 my @imagesets = (); # list of hasrefs of image set data to pass to template
579 my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
580 foreach my $imagesubdir ( @subdirectories ) {
581 warn $imagesubdir if $DEBUG;
582 my @imagelist = (); # hashrefs of image info
583 my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
584 my $imagesetactive = 0;
585 foreach my $thisimage ( @imagenames ) {
587 { KohaImage => "$imagesubdir/$thisimage",
588 StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
589 OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
590 checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
593 $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
595 push @imagesets, { imagesetname => $imagesubdir,
596 imagesetactive => $imagesetactive,
597 images => \@imagelist };
605 $printers = &GetPrinters();
606 @queues = keys %$printers;
608 Returns information about existing printer queues.
610 C<$printers> is a reference-to-hash whose keys are the print queues
611 defined in the printers table of the Koha database. The values are
612 references-to-hash, whose keys are the fields in the printers table.
618 my $dbh = C4::Context->dbh;
619 my $sth = $dbh->prepare("select * from printers");
621 while ( my $printer = $sth->fetchrow_hashref ) {
622 $printers{ $printer->{'printqueue'} } = $printer;
624 return ( \%printers );
629 $printer = GetPrinter( $query, $printers );
633 sub GetPrinter ($$) {
634 my ( $query, $printers ) = @_; # get printer for this query from printers
635 my $printer = $query->param('printer');
636 my %cookie = $query->cookie('userenv');
637 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
638 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
644 Returns the number of pages to display in a pagination bar, given the number
645 of items and the number of items per page.
650 my ( $nb_items, $nb_items_per_page ) = @_;
652 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
657 (@themes) = &getallthemes('opac');
658 (@themes) = &getallthemes('intranet');
660 Returns an array of all available themes.
668 if ( $type eq 'intranet' ) {
669 $htdocs = C4::Context->config('intrahtdocs');
672 $htdocs = C4::Context->config('opachtdocs');
674 opendir D, "$htdocs";
675 my @dirlist = readdir D;
676 foreach my $directory (@dirlist) {
677 -d "$htdocs/$directory/en" and push @themes, $directory;
684 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
689 tags => [ qw/ 600a 601a 602a 603a 604a 605a 606ax 610a/ ],
695 tags => [ qw/ 651a / ],
701 tags => [ qw/ 500a 501a 502a 503a 504a / ],
707 tags => [ qw/ 700ab 701ab 702ab / ],
713 tags => [ qw/ 225a / ],
717 my $library_facet = {
719 label => 'Libraries',
720 tags => [ qw/ 995b / ],
723 push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
730 tags => [ qw/ 650a / ],
735 # label => 'People and Organizations',
736 # tags => [ qw/ 600a 610a 611a / ],
742 tags => [ qw/ 651a / ],
748 tags => [ qw/ 630a / ],
754 tags => [ qw/ 100a 110a 700a / ],
760 tags => [ qw/ 440a 490a / ],
767 label => 'Libraries',
768 tags => [ qw/ 952b / ],
772 push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
779 Return a href where a key is associated to a href. You give a query,
780 the name of the key among the fields returned by the query. If you
781 also give as third argument the name of the value, the function
782 returns a href of scalar. The optional 4th argument is an arrayref of
783 items passed to the C<execute()> call. It is designed to bind
784 parameters to any placeholders in your SQL.
793 # generic href of any information on the item, href of href.
794 my $iteminfos_of = get_infos_of($query, 'itemnumber');
795 print $iteminfos_of->{$itemnumber}{barcode};
797 # specific information, href of scalar
798 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
799 print $barcode_of_item->{$itemnumber};
804 my ( $query, $key_name, $value_name, $bind_params ) = @_;
806 my $dbh = C4::Context->dbh;
808 my $sth = $dbh->prepare($query);
809 $sth->execute( @$bind_params );
812 while ( my $row = $sth->fetchrow_hashref ) {
813 if ( defined $value_name ) {
814 $infos_of{ $row->{$key_name} } = $row->{$value_name};
817 $infos_of{ $row->{$key_name} } = $row;
825 =head2 get_notforloan_label_of
827 my $notforloan_label_of = get_notforloan_label_of();
829 Each authorised value of notforloan (information available in items and
830 itemtypes) is link to a single label.
832 Returns a href where keys are authorised values and values are corresponding
835 foreach my $authorised_value (keys %{$notforloan_label_of}) {
837 "authorised_value: %s => %s\n",
839 $notforloan_label_of->{$authorised_value}
845 # FIXME - why not use GetAuthorisedValues ??
847 sub get_notforloan_label_of {
848 my $dbh = C4::Context->dbh;
851 SELECT authorised_value
852 FROM marc_subfield_structure
853 WHERE kohafield = \'items.notforloan\'
856 my $sth = $dbh->prepare($query);
858 my ($statuscode) = $sth->fetchrow_array();
863 FROM authorised_values
866 $sth = $dbh->prepare($query);
867 $sth->execute($statuscode);
868 my %notforloan_label_of;
869 while ( my $row = $sth->fetchrow_hashref ) {
870 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
874 return \%notforloan_label_of;
877 =head2 displayServers
879 my $servers = displayServers();
880 my $servers = displayServers( $position );
881 my $servers = displayServers( $position, $type );
883 displayServers returns a listref of hashrefs, each containing
884 information about available z3950 servers. Each hashref has a format
888 'checked' => 'checked',
889 'encoding' => 'MARC-8'
891 'id' => 'LIBRARY OF CONGRESS',
895 'value' => 'z3950.loc.gov:7090/',
902 my ( $position, $type ) = @_;
903 my $dbh = C4::Context->dbh;
905 my $strsth = 'SELECT * FROM z3950servers';
910 push @bind_params, $position;
911 push @where_clauses, ' position = ? ';
915 push @bind_params, $type;
916 push @where_clauses, ' type = ? ';
919 # reassemble where clause from where clause pieces
920 if (@where_clauses) {
921 $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
924 my $rq = $dbh->prepare($strsth);
925 $rq->execute(@bind_params);
926 my @primaryserverloop;
928 while ( my $data = $rq->fetchrow_hashref ) {
929 push @primaryserverloop,
930 { label => $data->{description},
933 value => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
934 encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
935 checked => "checked",
936 icon => $data->{icon},
937 zed => $data->{type} eq 'zed',
938 opensearch => $data->{type} eq 'opensearch'
941 return \@primaryserverloop;
945 =head2 GetKohaImageurlFromAuthorisedValues
947 $authhorised_value = GetKohaImageurlFromAuthorisedValues( $category, $authvalcode );
949 Return the first url of the authorised value image represented by $lib.
953 sub GetKohaImageurlFromAuthorisedValues {
954 my ( $category, $lib ) = @_;
955 my $dbh = C4::Context->dbh;
956 my $sth = $dbh->prepare("SELECT imageurl FROM authorised_values WHERE category=? AND lib =?");
957 $sth->execute( $category, $lib );
958 while ( my $data = $sth->fetchrow_hashref ) {
959 return $data->{'imageurl'};
963 =head2 GetAuthValCode
965 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
970 my ($kohafield,$fwcode) = @_;
971 my $dbh = C4::Context->dbh;
972 $fwcode='' unless $fwcode;
973 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
974 $sth->execute($kohafield,$fwcode);
975 my ($authvalcode) = $sth->fetchrow_array;
979 =head2 GetAuthValCodeFromField
981 $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
983 C<$subfield> can be undefined
987 sub GetAuthValCodeFromField {
988 my ($field,$subfield,$fwcode) = @_;
989 my $dbh = C4::Context->dbh;
990 $fwcode='' unless $fwcode;
992 if (defined $subfield) {
993 $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
994 $sth->execute($field,$subfield,$fwcode);
996 $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
997 $sth->execute($field,$fwcode);
999 my ($authvalcode) = $sth->fetchrow_array;
1000 return $authvalcode;
1003 =head2 GetAuthorisedValues
1005 $authvalues = GetAuthorisedValues([$category], [$selected]);
1007 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
1009 C<$category> returns authorised values for just one category (optional).
1011 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1015 sub GetAuthorisedValues {
1016 my ($category,$selected,$opac) = @_;
1018 my $dbh = C4::Context->dbh;
1019 my $query = "SELECT * FROM authorised_values";
1020 $query .= " WHERE category = '" . $category . "'" if $category;
1021 $query .= " ORDER BY category, lib, lib_opac";
1022 my $sth = $dbh->prepare($query);
1024 while (my $data=$sth->fetchrow_hashref) {
1025 if ( (defined($selected)) && ($selected eq $data->{'authorised_value'}) ) {
1026 $data->{'selected'} = 1;
1029 $data->{'selected'} = 0;
1031 if ($opac && $data->{'lib_opac'}) {
1032 $data->{'lib'} = $data->{'lib_opac'};
1034 push @results, $data;
1036 #my $data = $sth->fetchall_arrayref({});
1037 return \@results; #$data;
1040 =head2 GetAuthorisedValueCategories
1042 $auth_categories = GetAuthorisedValueCategories();
1044 Return an arrayref of all of the available authorised
1049 sub GetAuthorisedValueCategories {
1050 my $dbh = C4::Context->dbh;
1051 my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1054 while (defined (my $category = $sth->fetchrow_array) ) {
1055 push @results, $category;
1060 =head2 GetAuthorisedValueByCode
1062 $authhorised_value = GetAuthorisedValueByCode( $category, $authvalcode );
1064 Return the lib attribute from authorised_values from the row identified
1065 by the passed category and code
1069 sub GetAuthorisedValueByCode {
1070 my ( $category, $authvalcode ) = @_;
1072 my $dbh = C4::Context->dbh;
1073 my $sth = $dbh->prepare("SELECT lib FROM authorised_values WHERE category=? AND authorised_value =?");
1074 $sth->execute( $category, $authvalcode );
1075 while ( my $data = $sth->fetchrow_hashref ) {
1076 return $data->{'lib'};
1080 =head2 GetKohaAuthorisedValues
1082 Takes $kohafield, $fwcode as parameters.
1084 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1086 Returns hashref of Code => description
1088 Returns undef if no authorised value category is defined for the kohafield.
1092 sub GetKohaAuthorisedValues {
1093 my ($kohafield,$fwcode,$opac) = @_;
1094 $fwcode='' unless $fwcode;
1096 my $dbh = C4::Context->dbh;
1097 my $avcode = GetAuthValCode($kohafield,$fwcode);
1099 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1100 $sth->execute($avcode);
1101 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1102 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1110 =head2 GetKohaAuthorisedValuesFromField
1112 Takes $field, $subfield, $fwcode as parameters.
1114 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1115 $subfield can be undefined
1117 Returns hashref of Code => description
1119 Returns undef if no authorised value category is defined for the given field and subfield
1123 sub GetKohaAuthorisedValuesFromField {
1124 my ($field, $subfield, $fwcode,$opac) = @_;
1125 $fwcode='' unless $fwcode;
1127 my $dbh = C4::Context->dbh;
1128 my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1130 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1131 $sth->execute($avcode);
1132 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1133 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1143 my $escaped_string = C4::Koha::xml_escape($string);
1145 Convert &, <, >, ', and " in a string to XML entities
1151 return '' unless defined $str;
1152 $str =~ s/&/&/g;
1155 $str =~ s/'/'/g;
1156 $str =~ s/"/"/g;
1160 =head2 GetKohaAuthorisedValueLib
1162 Takes $category, $authorised_value as parameters.
1164 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1166 Returns authorised value description
1170 sub GetKohaAuthorisedValueLib {
1171 my ($category,$authorised_value,$opac) = @_;
1173 my $dbh = C4::Context->dbh;
1174 my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1175 $sth->execute($category,$authorised_value);
1176 my $data = $sth->fetchrow_hashref;
1177 $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1181 =head2 display_marc_indicators
1183 my $display_form = C4::Koha::display_marc_indicators($field);
1185 C<$field> is a MARC::Field object
1187 Generate a display form of the indicators of a variable
1188 MARC field, replacing any blanks with '#'.
1192 sub display_marc_indicators {
1194 my $indicators = '';
1195 if ($field->tag() >= 10) {
1196 $indicators = $field->indicator(1) . $field->indicator(2);
1197 $indicators =~ s/ /#/g;
1202 sub GetNormalizedUPC {
1203 my ($record,$marcflavour) = @_;
1206 if ($marcflavour eq 'UNIMARC') {
1207 @fields = $record->field('072');
1208 foreach my $field (@fields) {
1209 my $upc = _normalize_match_point($field->subfield('a'));
1216 else { # assume marc21 if not unimarc
1217 @fields = $record->field('024');
1218 foreach my $field (@fields) {
1219 my $indicator = $field->indicator(1);
1220 my $upc = _normalize_match_point($field->subfield('a'));
1221 if ($indicator == 1 and $upc ne '') {
1228 # Normalizes and returns the first valid ISBN found in the record
1229 # ISBN13 are converted into ISBN10. This is required to get Amazon cover book.
1230 sub GetNormalizedISBN {
1231 my ($isbn,$record,$marcflavour) = @_;
1234 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1235 # anything after " | " should be removed, along with the delimiter
1236 $isbn =~ s/(.*)( \| )(.*)/$1/;
1237 return _isbn_cleanup($isbn);
1239 return undef unless $record;
1241 if ($marcflavour eq 'UNIMARC') {
1242 @fields = $record->field('010');
1243 foreach my $field (@fields) {
1244 my $isbn = $field->subfield('a');
1246 return _isbn_cleanup($isbn);
1252 else { # assume marc21 if not unimarc
1253 @fields = $record->field('020');
1254 foreach my $field (@fields) {
1255 $isbn = $field->subfield('a');
1257 return _isbn_cleanup($isbn);
1265 sub GetNormalizedEAN {
1266 my ($record,$marcflavour) = @_;
1269 if ($marcflavour eq 'UNIMARC') {
1270 @fields = $record->field('073');
1271 foreach my $field (@fields) {
1272 $ean = _normalize_match_point($field->subfield('a'));
1278 else { # assume marc21 if not unimarc
1279 @fields = $record->field('024');
1280 foreach my $field (@fields) {
1281 my $indicator = $field->indicator(1);
1282 $ean = _normalize_match_point($field->subfield('a'));
1283 if ($indicator == 3 and $ean ne '') {
1289 sub GetNormalizedOCLCNumber {
1290 my ($record,$marcflavour) = @_;
1293 if ($marcflavour eq 'UNIMARC') {
1294 # TODO: add UNIMARC fields
1296 else { # assume marc21 if not unimarc
1297 @fields = $record->field('035');
1298 foreach my $field (@fields) {
1299 $oclc = $field->subfield('a');
1300 if ($oclc =~ /OCoLC/) {
1301 $oclc =~ s/\(OCoLC\)//;
1310 =head2 GetDailyQuote($opts)
1312 Takes a hashref of options
1314 Currently supported options are:
1316 'id' An exact quote id
1317 'random' Select a random quote
1318 noop When no option is passed in, this sub will return the quote timestamped for the current day
1320 The function returns an anonymous hash following this format:
1323 'source' => 'source-of-quote',
1324 'timestamp' => 'timestamp-value',
1325 'text' => 'text-of-quote',
1331 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1332 # at least for default option
1336 my $dbh = C4::Context->dbh;
1341 $query = 'SELECT * FROM quotes WHERE id = ?';
1342 $sth = $dbh->prepare($query);
1343 $sth->execute($opts{'id'});
1344 $quote = $sth->fetchrow_hashref();
1346 elsif ($opts{'random'}) {
1347 # Fall through... we also return a random quote as a catch-all if all else fails
1350 $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1351 $sth = $dbh->prepare($query);
1353 $quote = $sth->fetchrow_hashref();
1355 unless ($quote) { # if there are not matches, choose a random quote
1356 # get a list of all available quote ids
1357 $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1359 my $range = ($sth->fetchrow_array)[0];
1361 # chose a random id within that range if there is more than one quote
1362 my $id = int(rand($range));
1364 $query = 'SELECT * FROM quotes WHERE id = ?;';
1365 $sth = C4::Context->dbh->prepare($query);
1369 $query = 'SELECT * FROM quotes;';
1370 $sth = C4::Context->dbh->prepare($query);
1373 $quote = $sth->fetchrow_hashref();
1374 # update the timestamp for that quote
1375 $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1376 $sth = C4::Context->dbh->prepare($query);
1377 $sth->execute(DateTime::Format::MySQL->format_datetime(DateTime->now), $quote->{'id'});
1382 sub _normalize_match_point {
1383 my $match_point = shift;
1384 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1385 $normalized_match_point =~ s/-//g;
1387 return $normalized_match_point;
1391 require Business::ISBN;
1392 my $isbn = Business::ISBN->new( $_[0] );
1394 $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13';
1395 if (defined $isbn) {
1396 return $isbn->as_string([]);