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 next if $directory eq 'lib';
678 -d "$htdocs/$directory/en" and push @themes, $directory;
685 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
690 tags => [ qw/ 600a 601a 602a 603a 604a 605a 606ax 610a/ ],
696 tags => [ qw/ 651a / ],
702 tags => [ qw/ 500a 501a 502a 503a 504a / ],
708 tags => [ qw/ 700ab 701ab 702ab / ],
714 tags => [ qw/ 225a / ],
718 my $library_facet = {
720 label => 'Libraries',
721 tags => [ qw/ 995b / ],
724 push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
731 tags => [ qw/ 650a / ],
736 # label => 'People and Organizations',
737 # tags => [ qw/ 600a 610a 611a / ],
743 tags => [ qw/ 651a / ],
749 tags => [ qw/ 630a / ],
755 tags => [ qw/ 100a 110a 700a / ],
761 tags => [ qw/ 440a 490a / ],
766 label => 'ItemTypes',
767 tags => [ qw/ 952y 942c / ],
774 label => 'Libraries',
775 tags => [ qw/ 952b / ],
779 push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
786 Return a href where a key is associated to a href. You give a query,
787 the name of the key among the fields returned by the query. If you
788 also give as third argument the name of the value, the function
789 returns a href of scalar. The optional 4th argument is an arrayref of
790 items passed to the C<execute()> call. It is designed to bind
791 parameters to any placeholders in your SQL.
800 # generic href of any information on the item, href of href.
801 my $iteminfos_of = get_infos_of($query, 'itemnumber');
802 print $iteminfos_of->{$itemnumber}{barcode};
804 # specific information, href of scalar
805 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
806 print $barcode_of_item->{$itemnumber};
811 my ( $query, $key_name, $value_name, $bind_params ) = @_;
813 my $dbh = C4::Context->dbh;
815 my $sth = $dbh->prepare($query);
816 $sth->execute( @$bind_params );
819 while ( my $row = $sth->fetchrow_hashref ) {
820 if ( defined $value_name ) {
821 $infos_of{ $row->{$key_name} } = $row->{$value_name};
824 $infos_of{ $row->{$key_name} } = $row;
832 =head2 get_notforloan_label_of
834 my $notforloan_label_of = get_notforloan_label_of();
836 Each authorised value of notforloan (information available in items and
837 itemtypes) is link to a single label.
839 Returns a href where keys are authorised values and values are corresponding
842 foreach my $authorised_value (keys %{$notforloan_label_of}) {
844 "authorised_value: %s => %s\n",
846 $notforloan_label_of->{$authorised_value}
852 # FIXME - why not use GetAuthorisedValues ??
854 sub get_notforloan_label_of {
855 my $dbh = C4::Context->dbh;
858 SELECT authorised_value
859 FROM marc_subfield_structure
860 WHERE kohafield = \'items.notforloan\'
863 my $sth = $dbh->prepare($query);
865 my ($statuscode) = $sth->fetchrow_array();
870 FROM authorised_values
873 $sth = $dbh->prepare($query);
874 $sth->execute($statuscode);
875 my %notforloan_label_of;
876 while ( my $row = $sth->fetchrow_hashref ) {
877 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
881 return \%notforloan_label_of;
884 =head2 displayServers
886 my $servers = displayServers();
887 my $servers = displayServers( $position );
888 my $servers = displayServers( $position, $type );
890 displayServers returns a listref of hashrefs, each containing
891 information about available z3950 servers. Each hashref has a format
895 'checked' => 'checked',
896 'encoding' => 'MARC-8'
898 'id' => 'LIBRARY OF CONGRESS',
902 'value' => 'z3950.loc.gov:7090/',
909 my ( $position, $type ) = @_;
910 my $dbh = C4::Context->dbh;
912 my $strsth = 'SELECT * FROM z3950servers';
917 push @bind_params, $position;
918 push @where_clauses, ' position = ? ';
922 push @bind_params, $type;
923 push @where_clauses, ' type = ? ';
926 # reassemble where clause from where clause pieces
927 if (@where_clauses) {
928 $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
931 my $rq = $dbh->prepare($strsth);
932 $rq->execute(@bind_params);
933 my @primaryserverloop;
935 while ( my $data = $rq->fetchrow_hashref ) {
936 push @primaryserverloop,
937 { label => $data->{description},
940 value => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
941 encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
942 checked => "checked",
943 icon => $data->{icon},
944 zed => $data->{type} eq 'zed',
945 opensearch => $data->{type} eq 'opensearch'
948 return \@primaryserverloop;
952 =head2 GetKohaImageurlFromAuthorisedValues
954 $authhorised_value = GetKohaImageurlFromAuthorisedValues( $category, $authvalcode );
956 Return the first url of the authorised value image represented by $lib.
960 sub GetKohaImageurlFromAuthorisedValues {
961 my ( $category, $lib ) = @_;
962 my $dbh = C4::Context->dbh;
963 my $sth = $dbh->prepare("SELECT imageurl FROM authorised_values WHERE category=? AND lib =?");
964 $sth->execute( $category, $lib );
965 while ( my $data = $sth->fetchrow_hashref ) {
966 return $data->{'imageurl'};
970 =head2 GetAuthValCode
972 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
977 my ($kohafield,$fwcode) = @_;
978 my $dbh = C4::Context->dbh;
979 $fwcode='' unless $fwcode;
980 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
981 $sth->execute($kohafield,$fwcode);
982 my ($authvalcode) = $sth->fetchrow_array;
986 =head2 GetAuthValCodeFromField
988 $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
990 C<$subfield> can be undefined
994 sub GetAuthValCodeFromField {
995 my ($field,$subfield,$fwcode) = @_;
996 my $dbh = C4::Context->dbh;
997 $fwcode='' unless $fwcode;
999 if (defined $subfield) {
1000 $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
1001 $sth->execute($field,$subfield,$fwcode);
1003 $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
1004 $sth->execute($field,$fwcode);
1006 my ($authvalcode) = $sth->fetchrow_array;
1007 return $authvalcode;
1010 =head2 GetAuthorisedValues
1012 $authvalues = GetAuthorisedValues([$category], [$selected]);
1014 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
1016 C<$category> returns authorised values for just one category (optional).
1018 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1022 sub GetAuthorisedValues {
1023 my ($category,$selected,$opac) = @_;
1025 my $dbh = C4::Context->dbh;
1026 my $query = "SELECT * FROM authorised_values";
1027 $query .= " WHERE category = '" . $category . "'" if $category;
1028 $query .= " ORDER BY category, lib, lib_opac";
1029 my $sth = $dbh->prepare($query);
1031 while (my $data=$sth->fetchrow_hashref) {
1032 if ( (defined($selected)) && ($selected eq $data->{'authorised_value'}) ) {
1033 $data->{'selected'} = 1;
1036 $data->{'selected'} = 0;
1038 if ($opac && $data->{'lib_opac'}) {
1039 $data->{'lib'} = $data->{'lib_opac'};
1041 push @results, $data;
1043 #my $data = $sth->fetchall_arrayref({});
1044 return \@results; #$data;
1047 =head2 GetAuthorisedValueCategories
1049 $auth_categories = GetAuthorisedValueCategories();
1051 Return an arrayref of all of the available authorised
1056 sub GetAuthorisedValueCategories {
1057 my $dbh = C4::Context->dbh;
1058 my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1061 while (defined (my $category = $sth->fetchrow_array) ) {
1062 push @results, $category;
1067 =head2 GetAuthorisedValueByCode
1069 $authhorised_value = GetAuthorisedValueByCode( $category, $authvalcode );
1071 Return the lib attribute from authorised_values from the row identified
1072 by the passed category and code
1076 sub GetAuthorisedValueByCode {
1077 my ( $category, $authvalcode, $opac ) = @_;
1079 my $field = $opac ? 'lib_opac' : 'lib';
1080 my $dbh = C4::Context->dbh;
1081 my $sth = $dbh->prepare("SELECT $field FROM authorised_values WHERE category=? AND authorised_value =?");
1082 $sth->execute( $category, $authvalcode );
1083 while ( my $data = $sth->fetchrow_hashref ) {
1084 return $data->{ $field };
1088 =head2 GetKohaAuthorisedValues
1090 Takes $kohafield, $fwcode as parameters.
1092 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1094 Returns hashref of Code => description
1096 Returns undef if no authorised value category is defined for the kohafield.
1100 sub GetKohaAuthorisedValues {
1101 my ($kohafield,$fwcode,$opac) = @_;
1102 $fwcode='' unless $fwcode;
1104 my $dbh = C4::Context->dbh;
1105 my $avcode = GetAuthValCode($kohafield,$fwcode);
1107 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1108 $sth->execute($avcode);
1109 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1110 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1118 =head2 GetKohaAuthorisedValuesFromField
1120 Takes $field, $subfield, $fwcode as parameters.
1122 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1123 $subfield can be undefined
1125 Returns hashref of Code => description
1127 Returns undef if no authorised value category is defined for the given field and subfield
1131 sub GetKohaAuthorisedValuesFromField {
1132 my ($field, $subfield, $fwcode,$opac) = @_;
1133 $fwcode='' unless $fwcode;
1135 my $dbh = C4::Context->dbh;
1136 my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1138 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1139 $sth->execute($avcode);
1140 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1141 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1151 my $escaped_string = C4::Koha::xml_escape($string);
1153 Convert &, <, >, ', and " in a string to XML entities
1159 return '' unless defined $str;
1160 $str =~ s/&/&/g;
1163 $str =~ s/'/'/g;
1164 $str =~ s/"/"/g;
1168 =head2 GetKohaAuthorisedValueLib
1170 Takes $category, $authorised_value as parameters.
1172 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1174 Returns authorised value description
1178 sub GetKohaAuthorisedValueLib {
1179 my ($category,$authorised_value,$opac) = @_;
1181 my $dbh = C4::Context->dbh;
1182 my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1183 $sth->execute($category,$authorised_value);
1184 my $data = $sth->fetchrow_hashref;
1185 $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1189 =head2 display_marc_indicators
1191 my $display_form = C4::Koha::display_marc_indicators($field);
1193 C<$field> is a MARC::Field object
1195 Generate a display form of the indicators of a variable
1196 MARC field, replacing any blanks with '#'.
1200 sub display_marc_indicators {
1202 my $indicators = '';
1203 if ($field->tag() >= 10) {
1204 $indicators = $field->indicator(1) . $field->indicator(2);
1205 $indicators =~ s/ /#/g;
1210 sub GetNormalizedUPC {
1211 my ($record,$marcflavour) = @_;
1214 if ($marcflavour eq 'UNIMARC') {
1215 @fields = $record->field('072');
1216 foreach my $field (@fields) {
1217 my $upc = _normalize_match_point($field->subfield('a'));
1224 else { # assume marc21 if not unimarc
1225 @fields = $record->field('024');
1226 foreach my $field (@fields) {
1227 my $indicator = $field->indicator(1);
1228 my $upc = _normalize_match_point($field->subfield('a'));
1229 if ($indicator == 1 and $upc ne '') {
1236 # Normalizes and returns the first valid ISBN found in the record
1237 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
1238 sub GetNormalizedISBN {
1239 my ($isbn,$record,$marcflavour) = @_;
1242 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1243 # anything after " | " should be removed, along with the delimiter
1244 $isbn =~ s/(.*)( \| )(.*)/$1/;
1245 return _isbn_cleanup($isbn);
1247 return undef unless $record;
1249 if ($marcflavour eq 'UNIMARC') {
1250 @fields = $record->field('010');
1251 foreach my $field (@fields) {
1252 my $isbn = $field->subfield('a');
1254 return _isbn_cleanup($isbn);
1260 else { # assume marc21 if not unimarc
1261 @fields = $record->field('020');
1262 foreach my $field (@fields) {
1263 $isbn = $field->subfield('a');
1265 return _isbn_cleanup($isbn);
1273 sub GetNormalizedEAN {
1274 my ($record,$marcflavour) = @_;
1277 if ($marcflavour eq 'UNIMARC') {
1278 @fields = $record->field('073');
1279 foreach my $field (@fields) {
1280 $ean = _normalize_match_point($field->subfield('a'));
1286 else { # assume marc21 if not unimarc
1287 @fields = $record->field('024');
1288 foreach my $field (@fields) {
1289 my $indicator = $field->indicator(1);
1290 $ean = _normalize_match_point($field->subfield('a'));
1291 if ($indicator == 3 and $ean ne '') {
1297 sub GetNormalizedOCLCNumber {
1298 my ($record,$marcflavour) = @_;
1301 if ($marcflavour eq 'UNIMARC') {
1302 # TODO: add UNIMARC fields
1304 else { # assume marc21 if not unimarc
1305 @fields = $record->field('035');
1306 foreach my $field (@fields) {
1307 $oclc = $field->subfield('a');
1308 if ($oclc =~ /OCoLC/) {
1309 $oclc =~ s/\(OCoLC\)//;
1318 =head2 GetDailyQuote($opts)
1320 Takes a hashref of options
1322 Currently supported options are:
1324 'id' An exact quote id
1325 'random' Select a random quote
1326 noop When no option is passed in, this sub will return the quote timestamped for the current day
1328 The function returns an anonymous hash following this format:
1331 'source' => 'source-of-quote',
1332 'timestamp' => 'timestamp-value',
1333 'text' => 'text-of-quote',
1339 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1340 # at least for default option
1344 my $dbh = C4::Context->dbh;
1349 $query = 'SELECT * FROM quotes WHERE id = ?';
1350 $sth = $dbh->prepare($query);
1351 $sth->execute($opts{'id'});
1352 $quote = $sth->fetchrow_hashref();
1354 elsif ($opts{'random'}) {
1355 # Fall through... we also return a random quote as a catch-all if all else fails
1358 $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1359 $sth = $dbh->prepare($query);
1361 $quote = $sth->fetchrow_hashref();
1363 unless ($quote) { # if there are not matches, choose a random quote
1364 # get a list of all available quote ids
1365 $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1367 my $range = ($sth->fetchrow_array)[0];
1369 # chose a random id within that range if there is more than one quote
1370 my $id = int(rand($range));
1372 $query = 'SELECT * FROM quotes WHERE id = ?;';
1373 $sth = C4::Context->dbh->prepare($query);
1377 $query = 'SELECT * FROM quotes;';
1378 $sth = C4::Context->dbh->prepare($query);
1381 $quote = $sth->fetchrow_hashref();
1382 # update the timestamp for that quote
1383 $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1384 $sth = C4::Context->dbh->prepare($query);
1385 $sth->execute(DateTime::Format::MySQL->format_datetime(DateTime->now), $quote->{'id'});
1390 sub _normalize_match_point {
1391 my $match_point = shift;
1392 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1393 $normalized_match_point =~ s/-//g;
1395 return $normalized_match_point;
1399 require Business::ISBN;
1400 my $isbn = Business::ISBN->new( $_[0] );
1402 $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13';
1403 if (defined $isbn) {
1404 return $isbn->as_string([]);