3 # Copyright 2000-2002 Katipo Communications
4 # Parts Copyright 2010 Nelsonville Public Library
5 # Parts copyright 2010 BibLibre
7 # This file is part of Koha.
9 # Koha is free software; you can redistribute it and/or modify it under the
10 # terms of the GNU General Public License as published by the Free Software
11 # Foundation; either version 2 of the License, or (at your option) any later
14 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
15 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
16 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License along
19 # with Koha; if not, write to the Free Software Foundation, Inc.,
20 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
24 #use warnings; FIXME - Bug 2505
27 use C4::Branch qw(GetBranchesCount);
30 use DateTime::Format::MySQL;
31 use autouse 'Data::Dumper' => qw(Dumper);
33 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $DEBUG);
36 $VERSION = 3.07.00.049;
41 &subfield_is_koha_internal_p
42 &GetPrinters &GetPrinter
43 &GetItemTypes &getitemtypeinfo
45 &GetSupportName &GetSupportList
47 &getframeworks &getframeworkinfo
48 &getauthtypes &getauthtype
54 &get_notforloan_label_of
57 &getitemtypeimagelocation
59 &GetAuthorisedValueCategories
60 &GetKohaAuthorisedValues
61 &GetKohaAuthorisedValuesFromField
62 &GetKohaAuthorisedValueLib
63 &GetAuthorisedValueByCode
64 &GetKohaImageurlFromAuthorisedValues
69 &GetNormalizedOCLCNumber
75 @EXPORT_OK = qw( GetDailyQuote );
79 memoize('GetAuthorisedValues');
83 C4::Koha - Perl Module containing convenience functions for Koha scripts
91 Koha.pm provides many functions for Koha scripts.
99 $slash_date = &slashifyDate($dash_date);
101 Takes a string of the form "DD-MM-YYYY" (or anything separated by
102 dashes), converts it to the form "YYYY/MM/DD", and returns the result.
108 # accepts a date of the form xx-xx-xx[xx] and returns it in the
110 my @dateOut = split( '-', shift );
111 return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
114 # FIXME.. this should be moved to a MARC-specific module
115 sub subfield_is_koha_internal_p {
118 # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
119 # But real MARC subfields are always single-character
120 # so it really is safer just to check the length
122 return length $subfield != 1;
125 =head2 GetSupportName
127 $itemtypename = &GetSupportName($codestring);
129 Returns a string with the name of the itemtype.
135 return if (! $codestring);
137 my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
138 if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
145 my $sth = C4::Context->dbh->prepare($query);
146 $sth->execute($codestring);
147 ($resultstring)=$sth->fetchrow;
148 return $resultstring;
151 C4::Context->dbh->prepare(
152 "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
154 $sth->execute( $advanced_search_types, $codestring );
155 my $data = $sth->fetchrow_hashref;
156 return $$data{'lib'};
160 =head2 GetSupportList
162 $itemtypes = &GetSupportList();
164 Returns an array ref containing informations about Support (since itemtype is rather a circulation code when item-level-itypes is used).
166 build a HTML select with the following code :
168 =head3 in PERL SCRIPT
170 my $itemtypes = GetSupportList();
171 $template->param(itemtypeloop => $itemtypes);
175 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
176 <select name="itemtype">
177 <option value="">Default</option>
178 <!-- TMPL_LOOP name="itemtypeloop" -->
179 <option value="<!-- TMPL_VAR name="itemtype" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->> <!--TMPL_IF Name="imageurl"--><img alt="<!-- TMPL_VAR name="description" -->" src="<!--TMPL_VAR Name="imageurl"-->><!--TMPL_ELSE-->"<!-- TMPL_VAR name="description" --><!--/TMPL_IF--></option>
182 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
183 <input type="submit" value="OK" class="button">
189 my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
190 if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
196 my $sth = C4::Context->dbh->prepare($query);
198 return $sth->fetchall_arrayref({});
200 my $advsearchtypes = GetAuthorisedValues($advanced_search_types);
201 my @results= map {{itemtype=>$$_{authorised_value},description=>$$_{lib},imageurl=>$$_{imageurl}}} @$advsearchtypes;
207 $itemtypes = &GetItemTypes();
209 Returns information about existing itemtypes.
211 build a HTML select with the following code :
213 =head3 in PERL SCRIPT
215 my $itemtypes = GetItemTypes;
217 foreach my $thisitemtype (sort keys %$itemtypes) {
218 my $selected = 1 if $thisitemtype eq $itemtype;
219 my %row =(value => $thisitemtype,
220 selected => $selected,
221 description => $itemtypes->{$thisitemtype}->{'description'},
223 push @itemtypesloop, \%row;
225 $template->param(itemtypeloop => \@itemtypesloop);
229 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
230 <select name="itemtype">
231 <option value="">Default</option>
232 <!-- TMPL_LOOP name="itemtypeloop" -->
233 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
236 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
237 <input type="submit" value="OK" class="button">
244 # returns a reference to a hash of references to itemtypes...
246 my $dbh = C4::Context->dbh;
251 my $sth = $dbh->prepare($query);
253 while ( my $IT = $sth->fetchrow_hashref ) {
254 $itemtypes{ $IT->{'itemtype'} } = $IT;
256 return ( \%itemtypes );
259 sub get_itemtypeinfos_of {
262 my $placeholders = join( ', ', map { '?' } @itemtypes );
263 my $query = <<"END_SQL";
269 WHERE itemtype IN ( $placeholders )
272 return get_infos_of( $query, 'itemtype', undef, \@itemtypes );
275 # this is temporary until we separate collection codes and item types
279 my $dbh = C4::Context->dbh;
282 "SELECT * FROM authorised_values ORDER BY authorised_value");
284 while ( my $data = $sth->fetchrow_hashref ) {
285 if ( $data->{category} eq "CCODE" ) {
287 $results[$count] = $data;
293 return ( $count, @results );
298 $authtypes = &getauthtypes();
300 Returns information about existing authtypes.
302 build a HTML select with the following code :
304 =head3 in PERL SCRIPT
306 my $authtypes = getauthtypes;
308 foreach my $thisauthtype (keys %$authtypes) {
309 my $selected = 1 if $thisauthtype eq $authtype;
310 my %row =(value => $thisauthtype,
311 selected => $selected,
312 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
314 push @authtypesloop, \%row;
316 $template->param(itemtypeloop => \@itemtypesloop);
320 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
321 <select name="authtype">
322 <!-- TMPL_LOOP name="authtypeloop" -->
323 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
326 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
327 <input type="submit" value="OK" class="button">
335 # returns a reference to a hash of references to authtypes...
337 my $dbh = C4::Context->dbh;
338 my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
340 while ( my $IT = $sth->fetchrow_hashref ) {
341 $authtypes{ $IT->{'authtypecode'} } = $IT;
343 return ( \%authtypes );
347 my ($authtypecode) = @_;
349 # returns a reference to a hash of references to authtypes...
351 my $dbh = C4::Context->dbh;
352 my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
353 $sth->execute($authtypecode);
354 my $res = $sth->fetchrow_hashref;
360 $frameworks = &getframework();
362 Returns information about existing frameworks
364 build a HTML select with the following code :
366 =head3 in PERL SCRIPT
368 my $frameworks = frameworks();
370 foreach my $thisframework (keys %$frameworks) {
371 my $selected = 1 if $thisframework eq $frameworkcode;
372 my %row =(value => $thisframework,
373 selected => $selected,
374 description => $frameworks->{$thisframework}->{'frameworktext'},
376 push @frameworksloop, \%row;
378 $template->param(frameworkloop => \@frameworksloop);
382 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
383 <select name="frameworkcode">
384 <option value="">Default</option>
385 <!-- TMPL_LOOP name="frameworkloop" -->
386 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
389 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
390 <input type="submit" value="OK" class="button">
397 # returns a reference to a hash of references to branches...
399 my $dbh = C4::Context->dbh;
400 my $sth = $dbh->prepare("select * from biblio_framework");
402 while ( my $IT = $sth->fetchrow_hashref ) {
403 $itemtypes{ $IT->{'frameworkcode'} } = $IT;
405 return ( \%itemtypes );
408 =head2 getframeworkinfo
410 $frameworkinfo = &getframeworkinfo($frameworkcode);
412 Returns information about an frameworkcode.
416 sub getframeworkinfo {
417 my ($frameworkcode) = @_;
418 my $dbh = C4::Context->dbh;
420 $dbh->prepare("select * from biblio_framework where frameworkcode=?");
421 $sth->execute($frameworkcode);
422 my $res = $sth->fetchrow_hashref;
426 =head2 getitemtypeinfo
428 $itemtype = &getitemtype($itemtype);
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 );
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/ 600ab 601ab 602a 604at 605a 606ax 610a / ],
696 tags => [ qw/ 607a / ],
702 tags => [ qw/ 500a 501a 503a / ],
708 tags => [ qw/ 700ab 701ab 702ab / ],
714 tags => [ qw/ 225a / ],
720 unless ( C4::Context->preference("singleBranchMode") || GetBranchesCount() == 1 ) {
723 label => 'Libraries',
724 tags => [ qw/ 995b / ],
730 tags => [ qw/ 995c / ],
733 push( @$facets, $library_facet );
740 tags => [ qw/ 650a / ],
745 # label => 'People and Organizations',
746 # tags => [ qw/ 600a 610a 611a / ],
752 tags => [ qw/ 651a / ],
758 tags => [ qw/ 630a / ],
764 tags => [ qw/ 100a 110a 700a / ],
770 tags => [ qw/ 440a 490a / ],
775 label => 'ItemTypes',
776 tags => [ qw/ 952y 942c / ],
782 unless ( C4::Context->preference("singleBranchMode") || GetBranchesCount() == 1 ) {
785 label => 'Libraries',
786 tags => [ qw / 952b / ],
792 tags => [ qw / 952c / ],
795 push( @$facets, $library_facet );
802 Return a href where a key is associated to a href. You give a query,
803 the name of the key among the fields returned by the query. If you
804 also give as third argument the name of the value, the function
805 returns a href of scalar. The optional 4th argument is an arrayref of
806 items passed to the C<execute()> call. It is designed to bind
807 parameters to any placeholders in your SQL.
816 # generic href of any information on the item, href of href.
817 my $iteminfos_of = get_infos_of($query, 'itemnumber');
818 print $iteminfos_of->{$itemnumber}{barcode};
820 # specific information, href of scalar
821 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
822 print $barcode_of_item->{$itemnumber};
827 my ( $query, $key_name, $value_name, $bind_params ) = @_;
829 my $dbh = C4::Context->dbh;
831 my $sth = $dbh->prepare($query);
832 $sth->execute( @$bind_params );
835 while ( my $row = $sth->fetchrow_hashref ) {
836 if ( defined $value_name ) {
837 $infos_of{ $row->{$key_name} } = $row->{$value_name};
840 $infos_of{ $row->{$key_name} } = $row;
848 =head2 get_notforloan_label_of
850 my $notforloan_label_of = get_notforloan_label_of();
852 Each authorised value of notforloan (information available in items and
853 itemtypes) is link to a single label.
855 Returns a href where keys are authorised values and values are corresponding
858 foreach my $authorised_value (keys %{$notforloan_label_of}) {
860 "authorised_value: %s => %s\n",
862 $notforloan_label_of->{$authorised_value}
868 # FIXME - why not use GetAuthorisedValues ??
870 sub get_notforloan_label_of {
871 my $dbh = C4::Context->dbh;
874 SELECT authorised_value
875 FROM marc_subfield_structure
876 WHERE kohafield = \'items.notforloan\'
879 my $sth = $dbh->prepare($query);
881 my ($statuscode) = $sth->fetchrow_array();
886 FROM authorised_values
889 $sth = $dbh->prepare($query);
890 $sth->execute($statuscode);
891 my %notforloan_label_of;
892 while ( my $row = $sth->fetchrow_hashref ) {
893 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
897 return \%notforloan_label_of;
900 =head2 displayServers
902 my $servers = displayServers();
903 my $servers = displayServers( $position );
904 my $servers = displayServers( $position, $type );
906 displayServers returns a listref of hashrefs, each containing
907 information about available z3950 servers. Each hashref has a format
911 'checked' => 'checked',
912 'encoding' => 'MARC-8'
914 'id' => 'LIBRARY OF CONGRESS',
918 'value' => 'z3950.loc.gov:7090/',
925 my ( $position, $type ) = @_;
926 my $dbh = C4::Context->dbh;
928 my $strsth = 'SELECT * FROM z3950servers';
933 push @bind_params, $position;
934 push @where_clauses, ' position = ? ';
938 push @bind_params, $type;
939 push @where_clauses, ' type = ? ';
942 # reassemble where clause from where clause pieces
943 if (@where_clauses) {
944 $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
947 my $rq = $dbh->prepare($strsth);
948 $rq->execute(@bind_params);
949 my @primaryserverloop;
951 while ( my $data = $rq->fetchrow_hashref ) {
952 push @primaryserverloop,
953 { label => $data->{description},
956 value => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
957 encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
958 checked => "checked",
959 icon => $data->{icon},
960 zed => $data->{type} eq 'zed',
961 opensearch => $data->{type} eq 'opensearch'
964 return \@primaryserverloop;
968 =head2 GetKohaImageurlFromAuthorisedValues
970 $authhorised_value = GetKohaImageurlFromAuthorisedValues( $category, $authvalcode );
972 Return the first url of the authorised value image represented by $lib.
976 sub GetKohaImageurlFromAuthorisedValues {
977 my ( $category, $lib ) = @_;
978 my $dbh = C4::Context->dbh;
979 my $sth = $dbh->prepare("SELECT imageurl FROM authorised_values WHERE category=? AND lib =?");
980 $sth->execute( $category, $lib );
981 while ( my $data = $sth->fetchrow_hashref ) {
982 return $data->{'imageurl'};
986 =head2 GetAuthValCode
988 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
993 my ($kohafield,$fwcode) = @_;
994 my $dbh = C4::Context->dbh;
995 $fwcode='' unless $fwcode;
996 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
997 $sth->execute($kohafield,$fwcode);
998 my ($authvalcode) = $sth->fetchrow_array;
1002 =head2 GetAuthValCodeFromField
1004 $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
1006 C<$subfield> can be undefined
1010 sub GetAuthValCodeFromField {
1011 my ($field,$subfield,$fwcode) = @_;
1012 my $dbh = C4::Context->dbh;
1013 $fwcode='' unless $fwcode;
1015 if (defined $subfield) {
1016 $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
1017 $sth->execute($field,$subfield,$fwcode);
1019 $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
1020 $sth->execute($field,$fwcode);
1022 my ($authvalcode) = $sth->fetchrow_array;
1023 return $authvalcode;
1026 =head2 GetAuthorisedValues
1028 $authvalues = GetAuthorisedValues([$category], [$selected]);
1030 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
1032 C<$category> returns authorised values for just one category (optional).
1034 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1038 sub GetAuthorisedValues {
1039 my ( $category, $selected, $opac ) = @_;
1040 my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1042 my $dbh = C4::Context->dbh;
1045 FROM authorised_values
1048 LEFT JOIN authorised_values_branches ON ( id = av_id )
1053 push @where_strings, "category = ?";
1054 push @where_args, $category;
1057 push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
1058 push @where_args, $branch_limit;
1060 if(@where_strings > 0) {
1061 $query .= " WHERE " . join(" AND ", @where_strings);
1063 $query .= " GROUP BY lib ORDER BY category, lib, lib_opac";
1065 my $sth = $dbh->prepare($query);
1067 $sth->execute( @where_args );
1068 while (my $data=$sth->fetchrow_hashref) {
1069 if ( defined $selected and $selected eq $data->{authorised_value} ) {
1070 $data->{selected} = 1;
1073 $data->{selected} = 0;
1076 if ($opac && $data->{lib_opac}) {
1077 $data->{lib} = $data->{lib_opac};
1079 push @results, $data;
1085 =head2 GetAuthorisedValueCategories
1087 $auth_categories = GetAuthorisedValueCategories();
1089 Return an arrayref of all of the available authorised
1094 sub GetAuthorisedValueCategories {
1095 my $dbh = C4::Context->dbh;
1096 my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1099 while (defined (my $category = $sth->fetchrow_array) ) {
1100 push @results, $category;
1105 =head2 GetAuthorisedValueByCode
1107 $authhorised_value = GetAuthorisedValueByCode( $category, $authvalcode );
1109 Return the lib attribute from authorised_values from the row identified
1110 by the passed category and code
1114 sub GetAuthorisedValueByCode {
1115 my ( $category, $authvalcode, $opac ) = @_;
1117 my $field = $opac ? 'lib_opac' : 'lib';
1118 my $dbh = C4::Context->dbh;
1119 my $sth = $dbh->prepare("SELECT $field FROM authorised_values WHERE category=? AND authorised_value =?");
1120 $sth->execute( $category, $authvalcode );
1121 while ( my $data = $sth->fetchrow_hashref ) {
1122 return $data->{ $field };
1126 =head2 GetKohaAuthorisedValues
1128 Takes $kohafield, $fwcode as parameters.
1130 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1132 Returns hashref of Code => description
1134 Returns undef if no authorised value category is defined for the kohafield.
1138 sub GetKohaAuthorisedValues {
1139 my ($kohafield,$fwcode,$opac) = @_;
1140 $fwcode='' unless $fwcode;
1142 my $dbh = C4::Context->dbh;
1143 my $avcode = GetAuthValCode($kohafield,$fwcode);
1145 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1146 $sth->execute($avcode);
1147 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1148 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1156 =head2 GetKohaAuthorisedValuesFromField
1158 Takes $field, $subfield, $fwcode as parameters.
1160 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1161 $subfield can be undefined
1163 Returns hashref of Code => description
1165 Returns undef if no authorised value category is defined for the given field and subfield
1169 sub GetKohaAuthorisedValuesFromField {
1170 my ($field, $subfield, $fwcode,$opac) = @_;
1171 $fwcode='' unless $fwcode;
1173 my $dbh = C4::Context->dbh;
1174 my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1176 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1177 $sth->execute($avcode);
1178 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1179 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1189 my $escaped_string = C4::Koha::xml_escape($string);
1191 Convert &, <, >, ', and " in a string to XML entities
1197 return '' unless defined $str;
1198 $str =~ s/&/&/g;
1201 $str =~ s/'/'/g;
1202 $str =~ s/"/"/g;
1206 =head2 GetKohaAuthorisedValueLib
1208 Takes $category, $authorised_value as parameters.
1210 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1212 Returns authorised value description
1216 sub GetKohaAuthorisedValueLib {
1217 my ($category,$authorised_value,$opac) = @_;
1219 my $dbh = C4::Context->dbh;
1220 my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1221 $sth->execute($category,$authorised_value);
1222 my $data = $sth->fetchrow_hashref;
1223 $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1227 =head2 display_marc_indicators
1229 my $display_form = C4::Koha::display_marc_indicators($field);
1231 C<$field> is a MARC::Field object
1233 Generate a display form of the indicators of a variable
1234 MARC field, replacing any blanks with '#'.
1238 sub display_marc_indicators {
1240 my $indicators = '';
1241 if ($field->tag() >= 10) {
1242 $indicators = $field->indicator(1) . $field->indicator(2);
1243 $indicators =~ s/ /#/g;
1248 sub GetNormalizedUPC {
1249 my ($record,$marcflavour) = @_;
1252 if ($marcflavour eq 'UNIMARC') {
1253 @fields = $record->field('072');
1254 foreach my $field (@fields) {
1255 my $upc = _normalize_match_point($field->subfield('a'));
1262 else { # assume marc21 if not unimarc
1263 @fields = $record->field('024');
1264 foreach my $field (@fields) {
1265 my $indicator = $field->indicator(1);
1266 my $upc = _normalize_match_point($field->subfield('a'));
1267 if ($indicator == 1 and $upc ne '') {
1274 # Normalizes and returns the first valid ISBN found in the record
1275 # ISBN13 are converted into ISBN10. This is required to get some book cover images.
1276 sub GetNormalizedISBN {
1277 my ($isbn,$record,$marcflavour) = @_;
1280 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1281 # anything after " | " should be removed, along with the delimiter
1282 $isbn =~ s/(.*)( \| )(.*)/$1/;
1283 return _isbn_cleanup($isbn);
1285 return unless $record;
1287 if ($marcflavour eq 'UNIMARC') {
1288 @fields = $record->field('010');
1289 foreach my $field (@fields) {
1290 my $isbn = $field->subfield('a');
1292 return _isbn_cleanup($isbn);
1298 else { # assume marc21 if not unimarc
1299 @fields = $record->field('020');
1300 foreach my $field (@fields) {
1301 $isbn = $field->subfield('a');
1303 return _isbn_cleanup($isbn);
1311 sub GetNormalizedEAN {
1312 my ($record,$marcflavour) = @_;
1315 if ($marcflavour eq 'UNIMARC') {
1316 @fields = $record->field('073');
1317 foreach my $field (@fields) {
1318 $ean = _normalize_match_point($field->subfield('a'));
1324 else { # assume marc21 if not unimarc
1325 @fields = $record->field('024');
1326 foreach my $field (@fields) {
1327 my $indicator = $field->indicator(1);
1328 $ean = _normalize_match_point($field->subfield('a'));
1329 if ($indicator == 3 and $ean ne '') {
1335 sub GetNormalizedOCLCNumber {
1336 my ($record,$marcflavour) = @_;
1339 if ($marcflavour eq 'UNIMARC') {
1340 # TODO: add UNIMARC fields
1342 else { # assume marc21 if not unimarc
1343 @fields = $record->field('035');
1344 foreach my $field (@fields) {
1345 $oclc = $field->subfield('a');
1346 if ($oclc =~ /OCoLC/) {
1347 $oclc =~ s/\(OCoLC\)//;
1356 =head2 GetDailyQuote($opts)
1358 Takes a hashref of options
1360 Currently supported options are:
1362 'id' An exact quote id
1363 'random' Select a random quote
1364 noop When no option is passed in, this sub will return the quote timestamped for the current day
1366 The function returns an anonymous hash following this format:
1369 'source' => 'source-of-quote',
1370 'timestamp' => 'timestamp-value',
1371 'text' => 'text-of-quote',
1377 # This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues...
1378 # at least for default option
1382 my $dbh = C4::Context->dbh;
1387 $query = 'SELECT * FROM quotes WHERE id = ?';
1388 $sth = $dbh->prepare($query);
1389 $sth->execute($opts{'id'});
1390 $quote = $sth->fetchrow_hashref();
1392 elsif ($opts{'random'}) {
1393 # Fall through... we also return a random quote as a catch-all if all else fails
1396 $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1';
1397 $sth = $dbh->prepare($query);
1399 $quote = $sth->fetchrow_hashref();
1401 unless ($quote) { # if there are not matches, choose a random quote
1402 # get a list of all available quote ids
1403 $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;');
1405 my $range = ($sth->fetchrow_array)[0];
1407 # chose a random id within that range if there is more than one quote
1408 my $id = int(rand($range));
1410 $query = 'SELECT * FROM quotes WHERE id = ?;';
1411 $sth = C4::Context->dbh->prepare($query);
1415 $query = 'SELECT * FROM quotes;';
1416 $sth = C4::Context->dbh->prepare($query);
1419 $quote = $sth->fetchrow_hashref();
1420 # update the timestamp for that quote
1421 $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?';
1422 $sth = C4::Context->dbh->prepare($query);
1423 $sth->execute(DateTime::Format::MySQL->format_datetime(DateTime->now), $quote->{'id'});
1428 sub _normalize_match_point {
1429 my $match_point = shift;
1430 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1431 $normalized_match_point =~ s/-//g;
1433 return $normalized_match_point;
1437 require Business::ISBN;
1438 my $isbn = Business::ISBN->new( $_[0] );
1440 $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13';
1441 if (defined $isbn) {
1442 return $isbn->as_string([]);