3 # Copyright 2000-2002 Katipo Communications
4 # Parts Copyright 2010 Nelsonville Public Library
5 # Parts copyright 2010 BibLibre
7 # This file is part of Koha.
9 # Koha is free software; you can redistribute it and/or modify it under the
10 # terms of the GNU General Public License as published by the Free Software
11 # Foundation; either version 2 of the License, or (at your option) any later
14 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
15 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
16 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License along
19 # with Koha; if not, write to the Free Software Foundation, Inc.,
20 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
24 #use warnings; FIXME - Bug 2505
27 use C4::Branch qw(GetBranchesCount);
28 use Koha::DateUtils qw(dt_from_string);
30 use DateTime::Format::MySQL;
31 use autouse 'Data::Dumper' => qw(Dumper);
33 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $DEBUG);
36 $VERSION = 3.07.00.049;
41 &subfield_is_koha_internal_p
42 &GetPrinters &GetPrinter
43 &GetItemTypes &getitemtypeinfo
45 &GetSupportName &GetSupportList
47 &getframeworks &getframeworkinfo
48 &getauthtypes &getauthtype
54 &get_notforloan_label_of
57 &getitemtypeimagelocation
59 &GetAuthorisedValueCategories
60 &IsAuthorisedValueCategory
61 &GetKohaAuthorisedValues
62 &GetKohaAuthorisedValuesFromField
63 &GetKohaAuthorisedValueLib
64 &GetAuthorisedValueByCode
65 &GetKohaImageurlFromAuthorisedValues
71 &GetNormalizedOCLCNumber
77 @EXPORT_OK = qw( GetDailyQuote );
81 memoize('GetAuthorisedValues');
85 C4::Koha - Perl Module containing convenience functions for Koha scripts
93 Koha.pm provides many functions for Koha scripts.
101 $slash_date = &slashifyDate($dash_date);
103 Takes a string of the form "DD-MM-YYYY" (or anything separated by
104 dashes), converts it to the form "YYYY/MM/DD", and returns the result.
110 # accepts a date of the form xx-xx-xx[xx] and returns it in the
112 my @dateOut = split( '-', shift );
113 return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
116 # FIXME.. this should be moved to a MARC-specific module
117 sub subfield_is_koha_internal_p {
120 # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
121 # But real MARC subfields are always single-character
122 # so it really is safer just to check the length
124 return length $subfield != 1;
127 =head2 GetSupportName
129 $itemtypename = &GetSupportName($codestring);
131 Returns a string with the name of the itemtype.
137 return if (! $codestring);
139 my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
140 if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
147 my $sth = C4::Context->dbh->prepare($query);
148 $sth->execute($codestring);
149 ($resultstring)=$sth->fetchrow;
150 return $resultstring;
153 C4::Context->dbh->prepare(
154 "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
156 $sth->execute( $advanced_search_types, $codestring );
157 my $data = $sth->fetchrow_hashref;
158 return $$data{'lib'};
162 =head2 GetSupportList
164 $itemtypes = &GetSupportList();
166 Returns an array ref containing informations about Support (since itemtype is rather a circulation code when item-level-itypes is used).
168 build a HTML select with the following code :
170 =head3 in PERL SCRIPT
172 my $itemtypes = GetSupportList();
173 $template->param(itemtypeloop => $itemtypes);
177 <select name="itemtype" id="itemtype">
178 <option value=""></option>
179 [% FOREACH itemtypeloo IN itemtypeloop %]
180 [% IF ( itemtypeloo.selected ) %]
181 <option value="[% itemtypeloo.itemtype %]" selected="selected">[% itemtypeloo.description %]</option>
183 <option value="[% itemtypeloo.itemtype %]">[% itemtypeloo.description %]</option>
191 my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
192 if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
198 my $sth = C4::Context->dbh->prepare($query);
200 return $sth->fetchall_arrayref({});
202 my $advsearchtypes = GetAuthorisedValues($advanced_search_types);
203 my @results= map {{itemtype=>$$_{authorised_value},description=>$$_{lib},imageurl=>$$_{imageurl}}} @$advsearchtypes;
209 $itemtypes = &GetItemTypes( style => $style );
211 Returns information about existing itemtypes.
214 style: either 'array' or 'hash', defaults to 'hash'.
215 'array' returns an arrayref,
216 'hash' return a hashref with the itemtype value as the key
218 build a HTML select with the following code :
220 =head3 in PERL SCRIPT
222 my $itemtypes = GetItemTypes;
224 foreach my $thisitemtype (sort keys %$itemtypes) {
225 my $selected = 1 if $thisitemtype eq $itemtype;
226 my %row =(value => $thisitemtype,
227 selected => $selected,
228 description => $itemtypes->{$thisitemtype}->{'description'},
230 push @itemtypesloop, \%row;
232 $template->param(itemtypeloop => \@itemtypesloop);
236 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
237 <select name="itemtype">
238 <option value="">Default</option>
239 <!-- TMPL_LOOP name="itemtypeloop" -->
240 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
243 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
244 <input type="submit" value="OK" class="button">
251 my $style = defined( $params{'style'} ) ? $params{'style'} : 'hash';
253 # returns a reference to a hash of references to itemtypes...
255 my $dbh = C4::Context->dbh;
260 my $sth = $dbh->prepare($query);
263 if ( $style eq 'hash' ) {
264 while ( my $IT = $sth->fetchrow_hashref ) {
265 $itemtypes{ $IT->{'itemtype'} } = $IT;
267 return ( \%itemtypes );
269 return $sth->fetchall_arrayref({});
273 sub get_itemtypeinfos_of {
276 my $placeholders = join( ', ', map { '?' } @itemtypes );
277 my $query = <<"END_SQL";
283 WHERE itemtype IN ( $placeholders )
286 return get_infos_of( $query, 'itemtype', undef, \@itemtypes );
289 # this is temporary until we separate collection codes and item types
293 my $dbh = C4::Context->dbh;
296 "SELECT * FROM authorised_values ORDER BY authorised_value");
298 while ( my $data = $sth->fetchrow_hashref ) {
299 if ( $data->{category} eq "CCODE" ) {
301 $results[$count] = $data;
307 return ( $count, @results );
312 $authtypes = &getauthtypes();
314 Returns information about existing authtypes.
316 build a HTML select with the following code :
318 =head3 in PERL SCRIPT
320 my $authtypes = getauthtypes;
322 foreach my $thisauthtype (keys %$authtypes) {
323 my $selected = 1 if $thisauthtype eq $authtype;
324 my %row =(value => $thisauthtype,
325 selected => $selected,
326 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
328 push @authtypesloop, \%row;
330 $template->param(itemtypeloop => \@itemtypesloop);
334 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
335 <select name="authtype">
336 <!-- TMPL_LOOP name="authtypeloop" -->
337 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
340 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
341 <input type="submit" value="OK" class="button">
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 order by authtypetext");
354 while ( my $IT = $sth->fetchrow_hashref ) {
355 $authtypes{ $IT->{'authtypecode'} } = $IT;
357 return ( \%authtypes );
361 my ($authtypecode) = @_;
363 # returns a reference to a hash of references to authtypes...
365 my $dbh = C4::Context->dbh;
366 my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
367 $sth->execute($authtypecode);
368 my $res = $sth->fetchrow_hashref;
374 $frameworks = &getframework();
376 Returns information about existing frameworks
378 build a HTML select with the following code :
380 =head3 in PERL SCRIPT
382 my $frameworks = frameworks();
384 foreach my $thisframework (keys %$frameworks) {
385 my $selected = 1 if $thisframework eq $frameworkcode;
386 my %row =(value => $thisframework,
387 selected => $selected,
388 description => $frameworks->{$thisframework}->{'frameworktext'},
390 push @frameworksloop, \%row;
392 $template->param(frameworkloop => \@frameworksloop);
396 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
397 <select name="frameworkcode">
398 <option value="">Default</option>
399 <!-- TMPL_LOOP name="frameworkloop" -->
400 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
403 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
404 <input type="submit" value="OK" class="button">
411 # returns a reference to a hash of references to branches...
413 my $dbh = C4::Context->dbh;
414 my $sth = $dbh->prepare("select * from biblio_framework");
416 while ( my $IT = $sth->fetchrow_hashref ) {
417 $itemtypes{ $IT->{'frameworkcode'} } = $IT;
419 return ( \%itemtypes );
422 =head2 getframeworkinfo
424 $frameworkinfo = &getframeworkinfo($frameworkcode);
426 Returns information about an frameworkcode.
430 sub getframeworkinfo {
431 my ($frameworkcode) = @_;
432 my $dbh = C4::Context->dbh;
434 $dbh->prepare("select * from biblio_framework where frameworkcode=?");
435 $sth->execute($frameworkcode);
436 my $res = $sth->fetchrow_hashref;
440 =head2 getitemtypeinfo
442 $itemtype = &getitemtypeinfo($itemtype, [$interface]);
444 Returns information about an itemtype. The optional $interface argument
445 sets which interface ('opac' or 'intranet') to return the imageurl for.
446 Defaults to intranet.
450 sub getitemtypeinfo {
451 my ($itemtype, $interface) = @_;
452 my $dbh = C4::Context->dbh;
453 my $sth = $dbh->prepare("select * from itemtypes where itemtype=?");
454 $sth->execute($itemtype);
455 my $res = $sth->fetchrow_hashref;
457 $res->{imageurl} = getitemtypeimagelocation( ( ( defined $interface && $interface eq 'opac' ) ? 'opac' : 'intranet' ), $res->{imageurl} );
462 =head2 getitemtypeimagedir
464 my $directory = getitemtypeimagedir( 'opac' );
466 pass in 'opac' or 'intranet'. Defaults to 'opac'.
468 returns the full path to the appropriate directory containing images.
472 sub getitemtypeimagedir {
473 my $src = shift || 'opac';
474 if ($src eq 'intranet') {
475 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
477 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
481 sub getitemtypeimagesrc {
482 my $src = shift || 'opac';
483 if ($src eq 'intranet') {
484 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
486 return '/opac-tmpl' . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
490 sub getitemtypeimagelocation {
491 my ( $src, $image ) = @_;
493 return '' if ( !$image );
496 my $scheme = ( URI::Split::uri_split( $image ) )[0];
498 return $image if ( $scheme );
500 return getitemtypeimagesrc( $src ) . '/' . $image;
503 =head3 _getImagesFromDirectory
505 Find all of the image files in a directory in the filesystem
507 parameters: a directory name
509 returns: a list of images in that directory.
511 Notes: this does not traverse into subdirectories. See
512 _getSubdirectoryNames for help with that.
513 Images are assumed to be files with .gif or .png file extensions.
514 The image names returned do not have the directory name on them.
518 sub _getImagesFromDirectory {
519 my $directoryname = shift;
520 return unless defined $directoryname;
521 return unless -d $directoryname;
523 if ( opendir ( my $dh, $directoryname ) ) {
524 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
526 @images = sort(@images);
529 warn "unable to opendir $directoryname: $!";
534 =head3 _getSubdirectoryNames
536 Find all of the directories in a directory in the filesystem
538 parameters: a directory name
540 returns: a list of subdirectories in that directory.
542 Notes: this does not traverse into subdirectories. Only the first
543 level of subdirectories are returned.
544 The directory names returned don't have the parent directory name on them.
548 sub _getSubdirectoryNames {
549 my $directoryname = shift;
550 return unless defined $directoryname;
551 return unless -d $directoryname;
553 if ( opendir ( my $dh, $directoryname ) ) {
554 my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
558 warn "unable to opendir $directoryname: $!";
565 returns: a listref of hashrefs. Each hash represents another collection of images.
567 { imagesetname => 'npl', # the name of the image set (npl is the original one)
568 images => listref of image hashrefs
571 each image is represented by a hashref like this:
573 { KohaImage => 'npl/image.gif',
574 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
575 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
576 checked => 0 or 1: was this the image passed to this method?
577 Note: I'd like to remove this somehow.
584 my $checked = $params{'checked'} || '';
586 my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
587 url => getitemtypeimagesrc('intranet'),
589 opac => { filesystem => getitemtypeimagedir('opac'),
590 url => getitemtypeimagesrc('opac'),
594 my @imagesets = (); # list of hasrefs of image set data to pass to template
595 my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
596 foreach my $imagesubdir ( @subdirectories ) {
597 warn $imagesubdir if $DEBUG;
598 my @imagelist = (); # hashrefs of image info
599 my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
600 my $imagesetactive = 0;
601 foreach my $thisimage ( @imagenames ) {
603 { KohaImage => "$imagesubdir/$thisimage",
604 StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
605 OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
606 checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
609 $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
611 push @imagesets, { imagesetname => $imagesubdir,
612 imagesetactive => $imagesetactive,
613 images => \@imagelist };
621 $printers = &GetPrinters();
622 @queues = keys %$printers;
624 Returns information about existing printer queues.
626 C<$printers> is a reference-to-hash whose keys are the print queues
627 defined in the printers table of the Koha database. The values are
628 references-to-hash, whose keys are the fields in the printers table.
634 my $dbh = C4::Context->dbh;
635 my $sth = $dbh->prepare("select * from printers");
637 while ( my $printer = $sth->fetchrow_hashref ) {
638 $printers{ $printer->{'printqueue'} } = $printer;
640 return ( \%printers );
645 $printer = GetPrinter( $query, $printers );
650 my ( $query, $printers ) = @_; # get printer for this query from printers
651 my $printer = $query->param('printer');
652 my %cookie = $query->cookie('userenv');
653 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
654 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
660 Returns the number of pages to display in a pagination bar, given the number
661 of items and the number of items per page.
666 my ( $nb_items, $nb_items_per_page ) = @_;
668 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
673 (@themes) = &getallthemes('opac');
674 (@themes) = &getallthemes('intranet');
676 Returns an array of all available themes.
684 if ( $type eq 'intranet' ) {
685 $htdocs = C4::Context->config('intrahtdocs');
688 $htdocs = C4::Context->config('opachtdocs');
690 opendir D, "$htdocs";
691 my @dirlist = readdir D;
692 foreach my $directory (@dirlist) {
693 next if $directory eq 'lib';
694 -d "$htdocs/$directory/en" and push @themes, $directory;
701 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
706 tags => [ qw/ 600ab 601ab 602a 604at 605a 606ax 610a / ],
712 tags => [ qw/ 607a / ],
718 tags => [ qw/ 500a 501a 503a / ],
724 tags => [ qw/ 700ab 701ab 702ab / ],
725 sep => C4::Context->preference("UNIMARCAuthorsFacetsSeparator"),
730 tags => [ qw/ 225a / ],
736 unless ( C4::Context->preference("singleBranchMode") || GetBranchesCount() == 1 ) {
739 label => 'Libraries',
740 tags => [ qw/ 995b / ],
746 tags => [ qw/ 995c / ],
749 push( @$facets, $library_facet );
756 tags => [ qw/ 650a / ],
761 # label => 'People and Organizations',
762 # tags => [ qw/ 600a 610a 611a / ],
768 tags => [ qw/ 651a / ],
774 tags => [ qw/ 630a / ],
780 tags => [ qw/ 100a 110a 700a / ],
786 tags => [ qw/ 440a 490a / ],
791 label => 'ItemTypes',
792 tags => [ qw/ 952y 942c / ],
798 unless ( C4::Context->preference("singleBranchMode") || GetBranchesCount() == 1 ) {
801 label => 'Libraries',
802 tags => [ qw / 952b / ],
808 tags => [ qw / 952c / ],
811 push( @$facets, $library_facet );
818 Return a href where a key is associated to a href. You give a query,
819 the name of the key among the fields returned by the query. If you
820 also give as third argument the name of the value, the function
821 returns a href of scalar. The optional 4th argument is an arrayref of
822 items passed to the C<execute()> call. It is designed to bind
823 parameters to any placeholders in your SQL.
832 # generic href of any information on the item, href of href.
833 my $iteminfos_of = get_infos_of($query, 'itemnumber');
834 print $iteminfos_of->{$itemnumber}{barcode};
836 # specific information, href of scalar
837 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
838 print $barcode_of_item->{$itemnumber};
843 my ( $query, $key_name, $value_name, $bind_params ) = @_;
845 my $dbh = C4::Context->dbh;
847 my $sth = $dbh->prepare($query);
848 $sth->execute( @$bind_params );
851 while ( my $row = $sth->fetchrow_hashref ) {
852 if ( defined $value_name ) {
853 $infos_of{ $row->{$key_name} } = $row->{$value_name};
856 $infos_of{ $row->{$key_name} } = $row;
864 =head2 get_notforloan_label_of
866 my $notforloan_label_of = get_notforloan_label_of();
868 Each authorised value of notforloan (information available in items and
869 itemtypes) is link to a single label.
871 Returns a href where keys are authorised values and values are corresponding
874 foreach my $authorised_value (keys %{$notforloan_label_of}) {
876 "authorised_value: %s => %s\n",
878 $notforloan_label_of->{$authorised_value}
884 # FIXME - why not use GetAuthorisedValues ??
886 sub get_notforloan_label_of {
887 my $dbh = C4::Context->dbh;
890 SELECT authorised_value
891 FROM marc_subfield_structure
892 WHERE kohafield = \'items.notforloan\'
895 my $sth = $dbh->prepare($query);
897 my ($statuscode) = $sth->fetchrow_array();
902 FROM authorised_values
905 $sth = $dbh->prepare($query);
906 $sth->execute($statuscode);
907 my %notforloan_label_of;
908 while ( my $row = $sth->fetchrow_hashref ) {
909 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
913 return \%notforloan_label_of;
916 =head2 displayServers
918 my $servers = displayServers();
919 my $servers = displayServers( $position );
920 my $servers = displayServers( $position, $type );
922 displayServers returns a listref of hashrefs, each containing
923 information about available z3950 servers. Each hashref has a format
927 'checked' => 'checked',
928 'encoding' => 'utf8',
930 'id' => 'LIBRARY OF CONGRESS',
934 'value' => 'lx2.loc.gov:210/',
941 my ( $position, $type ) = @_;
942 my $dbh = C4::Context->dbh;
944 my $strsth = 'SELECT * FROM z3950servers';
949 push @bind_params, $position;
950 push @where_clauses, ' position = ? ';
954 push @bind_params, $type;
955 push @where_clauses, ' type = ? ';
958 # reassemble where clause from where clause pieces
959 if (@where_clauses) {
960 $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
963 my $rq = $dbh->prepare($strsth);
964 $rq->execute(@bind_params);
965 my @primaryserverloop;
967 while ( my $data = $rq->fetchrow_hashref ) {
968 push @primaryserverloop,
969 { label => $data->{description},
972 value => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
973 encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
974 checked => "checked",
975 icon => $data->{icon},
976 zed => $data->{type} eq 'zed',
977 opensearch => $data->{type} eq 'opensearch'
980 return \@primaryserverloop;
984 =head2 GetKohaImageurlFromAuthorisedValues
986 $authhorised_value = GetKohaImageurlFromAuthorisedValues( $category, $authvalcode );
988 Return the first url of the authorised value image represented by $lib.
992 sub GetKohaImageurlFromAuthorisedValues {
993 my ( $category, $lib ) = @_;
994 my $dbh = C4::Context->dbh;
995 my $sth = $dbh->prepare("SELECT imageurl FROM authorised_values WHERE category=? AND lib =?");
996 $sth->execute( $category, $lib );
997 while ( my $data = $sth->fetchrow_hashref ) {
998 return $data->{'imageurl'};
1002 =head2 GetAuthValCode
1004 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
1008 sub GetAuthValCode {
1009 my ($kohafield,$fwcode) = @_;
1010 my $dbh = C4::Context->dbh;
1011 $fwcode='' unless $fwcode;
1012 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
1013 $sth->execute($kohafield,$fwcode);
1014 my ($authvalcode) = $sth->fetchrow_array;
1015 return $authvalcode;
1018 =head2 GetAuthValCodeFromField
1020 $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
1022 C<$subfield> can be undefined
1026 sub GetAuthValCodeFromField {
1027 my ($field,$subfield,$fwcode) = @_;
1028 my $dbh = C4::Context->dbh;
1029 $fwcode='' unless $fwcode;
1031 if (defined $subfield) {
1032 $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
1033 $sth->execute($field,$subfield,$fwcode);
1035 $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
1036 $sth->execute($field,$fwcode);
1038 my ($authvalcode) = $sth->fetchrow_array;
1039 return $authvalcode;
1042 =head2 GetAuthorisedValues
1044 $authvalues = GetAuthorisedValues([$category], [$selected]);
1046 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
1048 C<$category> returns authorised values for just one category (optional).
1050 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1054 sub GetAuthorisedValues {
1055 my ( $category, $selected, $opac ) = @_;
1056 my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1058 my $dbh = C4::Context->dbh;
1061 FROM authorised_values
1064 LEFT JOIN authorised_values_branches ON ( id = av_id )
1069 push @where_strings, "category = ?";
1070 push @where_args, $category;
1073 push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
1074 push @where_args, $branch_limit;
1076 if(@where_strings > 0) {
1077 $query .= " WHERE " . join(" AND ", @where_strings);
1079 $query .= " GROUP BY lib ORDER BY category, " . ($opac ? "lib_opac, lib" : "lib, lib_opac");
1081 my $sth = $dbh->prepare($query);
1083 $sth->execute( @where_args );
1084 while (my $data=$sth->fetchrow_hashref) {
1085 if ( defined $selected and $selected eq $data->{authorised_value} ) {
1086 $data->{selected} = 1;
1089 $data->{selected} = 0;
1092 if ($opac && $data->{lib_opac}) {
1093 $data->{lib} = $data->{lib_opac};
1095 push @results, $data;
1101 =head2 GetAuthorisedValueCategories
1103 $auth_categories = GetAuthorisedValueCategories();
1105 Return an arrayref of all of the available authorised
1110 sub GetAuthorisedValueCategories {
1111 my $dbh = C4::Context->dbh;
1112 my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1115 while (defined (my $category = $sth->fetchrow_array) ) {
1116 push @results, $category;
1121 =head2 IsAuthorisedValueCategory
1123 $is_auth_val_category = IsAuthorisedValueCategory($category);
1125 Returns whether a given category name is a valid one
1129 sub IsAuthorisedValueCategory {
1130 my $category = shift;
1133 FROM authorised_values
1134 WHERE BINARY category=?
1137 my $sth = C4::Context->dbh->prepare($query);
1138 $sth->execute($category);
1139 $sth->fetchrow ? return 1
1143 =head2 GetAuthorisedValueByCode
1145 $authorised_value = GetAuthorisedValueByCode( $category, $authvalcode, $opac );
1147 Return the lib attribute from authorised_values from the row identified
1148 by the passed category and code
1152 sub GetAuthorisedValueByCode {
1153 my ( $category, $authvalcode, $opac ) = @_;
1155 my $field = $opac ? 'lib_opac' : 'lib';
1156 my $dbh = C4::Context->dbh;
1157 my $sth = $dbh->prepare("SELECT $field FROM authorised_values WHERE category=? AND authorised_value =?");
1158 $sth->execute( $category, $authvalcode );
1159 while ( my $data = $sth->fetchrow_hashref ) {
1160 return $data->{ $field };
1164 =head2 GetKohaAuthorisedValues
1166 Takes $kohafield, $fwcode as parameters.
1168 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1170 Returns hashref of Code => description
1172 Returns undef if no authorised value category is defined for the kohafield.
1176 sub GetKohaAuthorisedValues {
1177 my ($kohafield,$fwcode,$opac) = @_;
1178 $fwcode='' unless $fwcode;
1180 my $dbh = C4::Context->dbh;
1181 my $avcode = GetAuthValCode($kohafield,$fwcode);
1183 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1184 $sth->execute($avcode);
1185 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1186 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1194 =head2 GetKohaAuthorisedValuesFromField
1196 Takes $field, $subfield, $fwcode as parameters.
1198 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1199 $subfield can be undefined
1201 Returns hashref of Code => description
1203 Returns undef if no authorised value category is defined for the given field and subfield
1207 sub GetKohaAuthorisedValuesFromField {
1208 my ($field, $subfield, $fwcode,$opac) = @_;
1209 $fwcode='' unless $fwcode;
1211 my $dbh = C4::Context->dbh;
1212 my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1214 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1215 $sth->execute($avcode);
1216 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1217 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1227 my $escaped_string = C4::Koha::xml_escape($string);
1229 Convert &, <, >, ', and " in a string to XML entities
1235 return '' unless defined $str;
1236 $str =~ s/&/&/g;
1239 $str =~ s/'/'/g;
1240 $str =~ s/"/"/g;
1244 =head2 GetKohaAuthorisedValueLib
1246 Takes $category, $authorised_value as parameters.
1248 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1250 Returns authorised value description
1254 sub GetKohaAuthorisedValueLib {
1255 my ($category,$authorised_value,$opac) = @_;
1257 my $dbh = C4::Context->dbh;
1258 my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1259 $sth->execute($category,$authorised_value);
1260 my $data = $sth->fetchrow_hashref;
1261 $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1265 =head2 AddAuthorisedValue
1267 AddAuthorisedValue($category, $authorised_value, $lib, $lib_opac, $imageurl);
1269 Create a new authorised value.
1273 sub AddAuthorisedValue {
1274 my ($category, $authorised_value, $lib, $lib_opac, $imageurl) = @_;
1276 my $dbh = C4::Context->dbh;
1278 INSERT INTO authorised_values (category, authorised_value, lib, lib_opac, imageurl)
1281 my $sth = $dbh->prepare($query);
1282 $sth->execute($category, $authorised_value, $lib, $lib_opac, $imageurl);
1285 =head2 display_marc_indicators
1287 my $display_form = C4::Koha::display_marc_indicators($field);
1289 C<$field> is a MARC::Field object
1291 Generate a display form of the indicators of a variable
1292 MARC field, replacing any blanks with '#'.
1296 sub display_marc_indicators {
1298 my $indicators = '';
1299 if ($field->tag() >= 10) {
1300 $indicators = $field->indicator(1) . $field->indicator(2);
1301 $indicators =~ s/ /#/g;
1306 sub GetNormalizedUPC {
1307 my ($record,$marcflavour) = @_;
1310 if ($marcflavour eq 'UNIMARC') {
1311 @fields = $record->field('072');
1312 foreach my $field (@fields) {
1313 my $upc = _normalize_match_point($field->subfield('a'));
1320 else { # assume marc21 if not unimarc
1321 @fields = $record->field('024');
1322 foreach my $field (@fields) {
1323 my $indicator = $field->indicator(1);
1324 my $upc = _normalize_match_point($field->subfield('a'));
1325 if ($indicator == 1 and $upc ne '') {
1332 # Normalizes and returns the first valid ISBN found in the record
1333 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
1334 sub GetNormalizedISBN {
1335 my ($isbn,$record,$marcflavour) = @_;
1338 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1339 # anything after " | " should be removed, along with the delimiter
1340 $isbn =~ s/(.*)( \| )(.*)/$1/;
1341 return _isbn_cleanup($isbn);
1343 return unless $record;
1345 if ($marcflavour eq 'UNIMARC') {
1346 @fields = $record->field('010');
1347 foreach my $field (@fields) {
1348 my $isbn = $field->subfield('a');
1350 return _isbn_cleanup($isbn);
1356 else { # assume marc21 if not unimarc
1357 @fields = $record->field('020');
1358 foreach my $field (@fields) {
1359 $isbn = $field->subfield('a');
1361 return _isbn_cleanup($isbn);
1369 sub GetNormalizedEAN {
1370 my ($record,$marcflavour) = @_;
1373 if ($marcflavour eq 'UNIMARC') {
1374 @fields = $record->field('073');
1375 foreach my $field (@fields) {
1376 $ean = _normalize_match_point($field->subfield('a'));
1382 else { # assume marc21 if not unimarc
1383 @fields = $record->field('024');
1384 foreach my $field (@fields) {
1385 my $indicator = $field->indicator(1);
1386 $ean = _normalize_match_point($field->subfield('a'));
1387 if ($indicator == 3 and $ean ne '') {
1393 sub GetNormalizedOCLCNumber {
1394 my ($record,$marcflavour) = @_;
1397 if ($marcflavour eq 'UNIMARC') {
1398 # TODO: add UNIMARC fields
1400 else { # assume marc21 if not unimarc
1401 @fields = $record->field('035');
1402 foreach my $field (@fields) {
1403 $oclc = $field->subfield('a');
1404 if ($oclc =~ /OCoLC/) {
1405 $oclc =~ s/\(OCoLC\)//;
1414 =head2 GetDailyQuote($opts)
1416 Takes a hashref of options
1418 Currently supported options are:
1420 'id' An exact quote id
1421 'random' Select a random quote
1422 noop When no option is passed in, this sub will return the quote timestamped for the current day
1424 The function returns an anonymous hash following this format:
1427 'source' => 'source-of-quote',
1428 'timestamp' => 'timestamp-value',
1429 'text' => 'text-of-quote',
1435 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1436 # at least for default option
1440 my $dbh = C4::Context->dbh;
1445 $query = 'SELECT * FROM quotes WHERE id = ?';
1446 $sth = $dbh->prepare($query);
1447 $sth->execute($opts{'id'});
1448 $quote = $sth->fetchrow_hashref();
1450 elsif ($opts{'random'}) {
1451 # Fall through... we also return a random quote as a catch-all if all else fails
1454 $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1455 $sth = $dbh->prepare($query);
1457 $quote = $sth->fetchrow_hashref();
1459 unless ($quote) { # if there are not matches, choose a random quote
1460 # get a list of all available quote ids
1461 $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1463 my $range = ($sth->fetchrow_array)[0];
1465 # chose a random id within that range if there is more than one quote
1466 my $id = int(rand($range));
1468 $query = 'SELECT * FROM quotes WHERE id = ?;';
1469 $sth = C4::Context->dbh->prepare($query);
1473 $query = 'SELECT * FROM quotes;';
1474 $sth = C4::Context->dbh->prepare($query);
1477 $quote = $sth->fetchrow_hashref();
1478 # update the timestamp for that quote
1479 $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1480 $sth = C4::Context->dbh->prepare($query);
1482 DateTime::Format::MySQL->format_datetime( dt_from_string() ),
1489 sub _normalize_match_point {
1490 my $match_point = shift;
1491 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1492 $normalized_match_point =~ s/-//g;
1494 return $normalized_match_point;
1498 require Business::ISBN;
1499 my $isbn = Business::ISBN->new( $_[0] );
1501 $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13';
1502 if (defined $isbn) {
1503 return $isbn->as_string([]);