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);
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);
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 / ],
765 label => 'ItemTypes',
766 tags => [ qw/ 952y 942c / ],
773 label => 'Libraries',
774 tags => [ qw/ 952b / ],
778 push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
785 Return a href where a key is associated to a href. You give a query,
786 the name of the key among the fields returned by the query. If you
787 also give as third argument the name of the value, the function
788 returns a href of scalar. The optional 4th argument is an arrayref of
789 items passed to the C<execute()> call. It is designed to bind
790 parameters to any placeholders in your SQL.
799 # generic href of any information on the item, href of href.
800 my $iteminfos_of = get_infos_of($query, 'itemnumber');
801 print $iteminfos_of->{$itemnumber}{barcode};
803 # specific information, href of scalar
804 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
805 print $barcode_of_item->{$itemnumber};
810 my ( $query, $key_name, $value_name, $bind_params ) = @_;
812 my $dbh = C4::Context->dbh;
814 my $sth = $dbh->prepare($query);
815 $sth->execute( @$bind_params );
818 while ( my $row = $sth->fetchrow_hashref ) {
819 if ( defined $value_name ) {
820 $infos_of{ $row->{$key_name} } = $row->{$value_name};
823 $infos_of{ $row->{$key_name} } = $row;
831 =head2 get_notforloan_label_of
833 my $notforloan_label_of = get_notforloan_label_of();
835 Each authorised value of notforloan (information available in items and
836 itemtypes) is link to a single label.
838 Returns a href where keys are authorised values and values are corresponding
841 foreach my $authorised_value (keys %{$notforloan_label_of}) {
843 "authorised_value: %s => %s\n",
845 $notforloan_label_of->{$authorised_value}
851 # FIXME - why not use GetAuthorisedValues ??
853 sub get_notforloan_label_of {
854 my $dbh = C4::Context->dbh;
857 SELECT authorised_value
858 FROM marc_subfield_structure
859 WHERE kohafield = \'items.notforloan\'
862 my $sth = $dbh->prepare($query);
864 my ($statuscode) = $sth->fetchrow_array();
869 FROM authorised_values
872 $sth = $dbh->prepare($query);
873 $sth->execute($statuscode);
874 my %notforloan_label_of;
875 while ( my $row = $sth->fetchrow_hashref ) {
876 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
880 return \%notforloan_label_of;
883 =head2 displayServers
885 my $servers = displayServers();
886 my $servers = displayServers( $position );
887 my $servers = displayServers( $position, $type );
889 displayServers returns a listref of hashrefs, each containing
890 information about available z3950 servers. Each hashref has a format
894 'checked' => 'checked',
895 'encoding' => 'MARC-8'
897 'id' => 'LIBRARY OF CONGRESS',
901 'value' => 'z3950.loc.gov:7090/',
908 my ( $position, $type ) = @_;
909 my $dbh = C4::Context->dbh;
911 my $strsth = 'SELECT * FROM z3950servers';
916 push @bind_params, $position;
917 push @where_clauses, ' position = ? ';
921 push @bind_params, $type;
922 push @where_clauses, ' type = ? ';
925 # reassemble where clause from where clause pieces
926 if (@where_clauses) {
927 $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
930 my $rq = $dbh->prepare($strsth);
931 $rq->execute(@bind_params);
932 my @primaryserverloop;
934 while ( my $data = $rq->fetchrow_hashref ) {
935 push @primaryserverloop,
936 { label => $data->{description},
939 value => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
940 encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
941 checked => "checked",
942 icon => $data->{icon},
943 zed => $data->{type} eq 'zed',
944 opensearch => $data->{type} eq 'opensearch'
947 return \@primaryserverloop;
951 =head2 GetKohaImageurlFromAuthorisedValues
953 $authhorised_value = GetKohaImageurlFromAuthorisedValues( $category, $authvalcode );
955 Return the first url of the authorised value image represented by $lib.
959 sub GetKohaImageurlFromAuthorisedValues {
960 my ( $category, $lib ) = @_;
961 my $dbh = C4::Context->dbh;
962 my $sth = $dbh->prepare("SELECT imageurl FROM authorised_values WHERE category=? AND lib =?");
963 $sth->execute( $category, $lib );
964 while ( my $data = $sth->fetchrow_hashref ) {
965 return $data->{'imageurl'};
969 =head2 GetAuthValCode
971 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
976 my ($kohafield,$fwcode) = @_;
977 my $dbh = C4::Context->dbh;
978 $fwcode='' unless $fwcode;
979 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
980 $sth->execute($kohafield,$fwcode);
981 my ($authvalcode) = $sth->fetchrow_array;
985 =head2 GetAuthValCodeFromField
987 $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
989 C<$subfield> can be undefined
993 sub GetAuthValCodeFromField {
994 my ($field,$subfield,$fwcode) = @_;
995 my $dbh = C4::Context->dbh;
996 $fwcode='' unless $fwcode;
998 if (defined $subfield) {
999 $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
1000 $sth->execute($field,$subfield,$fwcode);
1002 $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
1003 $sth->execute($field,$fwcode);
1005 my ($authvalcode) = $sth->fetchrow_array;
1006 return $authvalcode;
1009 =head2 GetAuthorisedValues
1011 $authvalues = GetAuthorisedValues([$category], [$selected]);
1013 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
1015 C<$category> returns authorised values for just one category (optional).
1017 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1021 sub GetAuthorisedValues {
1022 my ($category,$selected,$opac) = @_;
1024 my $dbh = C4::Context->dbh;
1025 my $query = "SELECT * FROM authorised_values";
1026 $query .= " WHERE category = '" . $category . "'" if $category;
1027 $query .= " ORDER BY category, lib, lib_opac";
1028 my $sth = $dbh->prepare($query);
1030 while (my $data=$sth->fetchrow_hashref) {
1031 if ( (defined($selected)) && ($selected eq $data->{'authorised_value'}) ) {
1032 $data->{'selected'} = 1;
1035 $data->{'selected'} = 0;
1037 if ($opac && $data->{'lib_opac'}) {
1038 $data->{'lib'} = $data->{'lib_opac'};
1040 push @results, $data;
1042 #my $data = $sth->fetchall_arrayref({});
1043 return \@results; #$data;
1046 =head2 GetAuthorisedValueCategories
1048 $auth_categories = GetAuthorisedValueCategories();
1050 Return an arrayref of all of the available authorised
1055 sub GetAuthorisedValueCategories {
1056 my $dbh = C4::Context->dbh;
1057 my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1060 while (defined (my $category = $sth->fetchrow_array) ) {
1061 push @results, $category;
1066 =head2 GetAuthorisedValueByCode
1068 $authhorised_value = GetAuthorisedValueByCode( $category, $authvalcode );
1070 Return the lib attribute from authorised_values from the row identified
1071 by the passed category and code
1075 sub GetAuthorisedValueByCode {
1076 my ( $category, $authvalcode ) = @_;
1078 my $dbh = C4::Context->dbh;
1079 my $sth = $dbh->prepare("SELECT lib FROM authorised_values WHERE category=? AND authorised_value =?");
1080 $sth->execute( $category, $authvalcode );
1081 while ( my $data = $sth->fetchrow_hashref ) {
1082 return $data->{'lib'};
1086 =head2 GetKohaAuthorisedValues
1088 Takes $kohafield, $fwcode as parameters.
1090 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1092 Returns hashref of Code => description
1094 Returns undef if no authorised value category is defined for the kohafield.
1098 sub GetKohaAuthorisedValues {
1099 my ($kohafield,$fwcode,$opac) = @_;
1100 $fwcode='' unless $fwcode;
1102 my $dbh = C4::Context->dbh;
1103 my $avcode = GetAuthValCode($kohafield,$fwcode);
1105 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1106 $sth->execute($avcode);
1107 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1108 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1116 =head2 GetKohaAuthorisedValuesFromField
1118 Takes $field, $subfield, $fwcode as parameters.
1120 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1121 $subfield can be undefined
1123 Returns hashref of Code => description
1125 Returns undef if no authorised value category is defined for the given field and subfield
1129 sub GetKohaAuthorisedValuesFromField {
1130 my ($field, $subfield, $fwcode,$opac) = @_;
1131 $fwcode='' unless $fwcode;
1133 my $dbh = C4::Context->dbh;
1134 my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1136 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1137 $sth->execute($avcode);
1138 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1139 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1149 my $escaped_string = C4::Koha::xml_escape($string);
1151 Convert &, <, >, ', and " in a string to XML entities
1157 return '' unless defined $str;
1158 $str =~ s/&/&/g;
1161 $str =~ s/'/'/g;
1162 $str =~ s/"/"/g;
1166 =head2 GetKohaAuthorisedValueLib
1168 Takes $category, $authorised_value as parameters.
1170 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1172 Returns authorised value description
1176 sub GetKohaAuthorisedValueLib {
1177 my ($category,$authorised_value,$opac) = @_;
1179 my $dbh = C4::Context->dbh;
1180 my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1181 $sth->execute($category,$authorised_value);
1182 my $data = $sth->fetchrow_hashref;
1183 $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1187 =head2 display_marc_indicators
1189 my $display_form = C4::Koha::display_marc_indicators($field);
1191 C<$field> is a MARC::Field object
1193 Generate a display form of the indicators of a variable
1194 MARC field, replacing any blanks with '#'.
1198 sub display_marc_indicators {
1200 my $indicators = '';
1201 if ($field->tag() >= 10) {
1202 $indicators = $field->indicator(1) . $field->indicator(2);
1203 $indicators =~ s/ /#/g;
1208 sub GetNormalizedUPC {
1209 my ($record,$marcflavour) = @_;
1212 if ($marcflavour eq 'UNIMARC') {
1213 @fields = $record->field('072');
1214 foreach my $field (@fields) {
1215 my $upc = _normalize_match_point($field->subfield('a'));
1222 else { # assume marc21 if not unimarc
1223 @fields = $record->field('024');
1224 foreach my $field (@fields) {
1225 my $indicator = $field->indicator(1);
1226 my $upc = _normalize_match_point($field->subfield('a'));
1227 if ($indicator == 1 and $upc ne '') {
1234 # Normalizes and returns the first valid ISBN found in the record
1235 # ISBN13 are converted into ISBN10. This is required to get Amazon cover book.
1236 sub GetNormalizedISBN {
1237 my ($isbn,$record,$marcflavour) = @_;
1240 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1241 # anything after " | " should be removed, along with the delimiter
1242 $isbn =~ s/(.*)( \| )(.*)/$1/;
1243 return _isbn_cleanup($isbn);
1245 return undef unless $record;
1247 if ($marcflavour eq 'UNIMARC') {
1248 @fields = $record->field('010');
1249 foreach my $field (@fields) {
1250 my $isbn = $field->subfield('a');
1252 return _isbn_cleanup($isbn);
1258 else { # assume marc21 if not unimarc
1259 @fields = $record->field('020');
1260 foreach my $field (@fields) {
1261 $isbn = $field->subfield('a');
1263 return _isbn_cleanup($isbn);
1271 sub GetNormalizedEAN {
1272 my ($record,$marcflavour) = @_;
1275 if ($marcflavour eq 'UNIMARC') {
1276 @fields = $record->field('073');
1277 foreach my $field (@fields) {
1278 $ean = _normalize_match_point($field->subfield('a'));
1284 else { # assume marc21 if not unimarc
1285 @fields = $record->field('024');
1286 foreach my $field (@fields) {
1287 my $indicator = $field->indicator(1);
1288 $ean = _normalize_match_point($field->subfield('a'));
1289 if ($indicator == 3 and $ean ne '') {
1295 sub GetNormalizedOCLCNumber {
1296 my ($record,$marcflavour) = @_;
1299 if ($marcflavour eq 'UNIMARC') {
1300 # TODO: add UNIMARC fields
1302 else { # assume marc21 if not unimarc
1303 @fields = $record->field('035');
1304 foreach my $field (@fields) {
1305 $oclc = $field->subfield('a');
1306 if ($oclc =~ /OCoLC/) {
1307 $oclc =~ s/\(OCoLC\)//;
1316 =head2 GetDailyQuote($opts)
1318 Takes a hashref of options
1320 Currently supported options are:
1322 'id' An exact quote id
1323 'random' Select a random quote
1324 noop When no option is passed in, this sub will return the quote timestamped for the current day
1326 The function returns an anonymous hash following this format:
1329 'source' => 'source-of-quote',
1330 'timestamp' => 'timestamp-value',
1331 'text' => 'text-of-quote',
1337 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1338 # at least for default option
1342 my $dbh = C4::Context->dbh;
1347 $query = 'SELECT * FROM quotes WHERE id = ?';
1348 $sth = $dbh->prepare($query);
1349 $sth->execute($opts{'id'});
1350 $quote = $sth->fetchrow_hashref();
1352 elsif ($opts{'random'}) {
1353 # Fall through... we also return a random quote as a catch-all if all else fails
1356 $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1357 $sth = $dbh->prepare($query);
1359 $quote = $sth->fetchrow_hashref();
1361 unless ($quote) { # if there are not matches, choose a random quote
1362 # get a list of all available quote ids
1363 $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1365 my $range = ($sth->fetchrow_array)[0];
1367 # chose a random id within that range if there is more than one quote
1368 my $id = int(rand($range));
1370 $query = 'SELECT * FROM quotes WHERE id = ?;';
1371 $sth = C4::Context->dbh->prepare($query);
1375 $query = 'SELECT * FROM quotes;';
1376 $sth = C4::Context->dbh->prepare($query);
1379 $quote = $sth->fetchrow_hashref();
1380 # update the timestamp for that quote
1381 $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1382 $sth = C4::Context->dbh->prepare($query);
1383 $sth->execute(DateTime::Format::MySQL->format_datetime(DateTime->now), $quote->{'id'});
1388 sub _normalize_match_point {
1389 my $match_point = shift;
1390 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1391 $normalized_match_point =~ s/-//g;
1393 return $normalized_match_point;
1397 require Business::ISBN;
1398 my $isbn = Business::ISBN->new( $_[0] );
1400 $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13';
1401 if (defined $isbn) {
1402 return $isbn->as_string([]);