3 # Copyright 2000-2002 Katipo Communications
4 # Parts Copyright 2010 Nelsonville Public Library
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it under the
9 # terms of the GNU General Public License as published by the Free Software
10 # Foundation; either version 2 of the License, or (at your option) any later
13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License along
18 # with Koha; if not, write to the Free Software Foundation, Inc.,
19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
23 #use warnings; FIXME - Bug 2505
26 use URI::Split qw(uri_split);
30 use vars qw($VERSION @ISA @EXPORT $DEBUG);
38 &subfield_is_koha_internal_p
39 &GetPrinters &GetPrinter
40 &GetItemTypes &getitemtypeinfo
42 &GetSupportName &GetSupportList
44 &getframeworks &getframeworkinfo
45 &getauthtypes &getauthtype
51 &get_notforloan_label_of
54 &getitemtypeimagelocation
56 &GetAuthorisedValueCategories
57 &GetKohaAuthorisedValues
58 &GetKohaAuthorisedValuesFromField
59 &GetKohaAuthorisedValueLib
64 &GetNormalizedOCLCNumber
73 memoize('GetAuthorisedValues');
77 C4::Koha - Perl Module containing convenience functions for Koha scripts
85 Koha.pm provides many functions for Koha scripts.
93 $slash_date = &slashifyDate($dash_date);
95 Takes a string of the form "DD-MM-YYYY" (or anything separated by
96 dashes), converts it to the form "YYYY/MM/DD", and returns the result.
102 # accepts a date of the form xx-xx-xx[xx] and returns it in the
104 my @dateOut = split( '-', shift );
105 return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
108 # FIXME.. this should be moved to a MARC-specific module
109 sub subfield_is_koha_internal_p ($) {
112 # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
113 # But real MARC subfields are always single-character
114 # so it really is safer just to check the length
116 return length $subfield != 1;
119 =head2 GetSupportName
121 $itemtypename = &GetSupportName($codestring);
123 Returns a string with the name of the itemtype.
129 return if (! $codestring);
131 my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
132 if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
139 my $sth = C4::Context->dbh->prepare($query);
140 $sth->execute($codestring);
141 ($resultstring)=$sth->fetchrow;
142 return $resultstring;
145 C4::Context->dbh->prepare(
146 "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
148 $sth->execute( $advanced_search_types, $codestring );
149 my $data = $sth->fetchrow_hashref;
150 return $$data{'lib'};
154 =head2 GetSupportList
156 $itemtypes = &GetSupportList();
158 Returns an array ref containing informations about Support (since itemtype is rather a circulation code when item-level-itypes is used).
160 build a HTML select with the following code :
162 =head3 in PERL SCRIPT
164 my $itemtypes = GetSupportList();
165 $template->param(itemtypeloop => $itemtypes);
169 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
170 <select name="itemtype">
171 <option value="">Default</option>
172 <!-- TMPL_LOOP name="itemtypeloop" -->
173 <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>
176 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
177 <input type="submit" value="OK" class="button">
183 my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
184 if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
190 my $sth = C4::Context->dbh->prepare($query);
192 return $sth->fetchall_arrayref({});
194 my $advsearchtypes = GetAuthorisedValues($advanced_search_types);
195 my @results= map {{itemtype=>$$_{authorised_value},description=>$$_{lib},imageurl=>$$_{imageurl}}} @$advsearchtypes;
201 $itemtypes = &GetItemTypes();
203 Returns information about existing itemtypes.
205 build a HTML select with the following code :
207 =head3 in PERL SCRIPT
209 my $itemtypes = GetItemTypes;
211 foreach my $thisitemtype (sort keys %$itemtypes) {
212 my $selected = 1 if $thisitemtype eq $itemtype;
213 my %row =(value => $thisitemtype,
214 selected => $selected,
215 description => $itemtypes->{$thisitemtype}->{'description'},
217 push @itemtypesloop, \%row;
219 $template->param(itemtypeloop => \@itemtypesloop);
223 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
224 <select name="itemtype">
225 <option value="">Default</option>
226 <!-- TMPL_LOOP name="itemtypeloop" -->
227 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
230 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
231 <input type="submit" value="OK" class="button">
238 # returns a reference to a hash of references to itemtypes...
240 my $dbh = C4::Context->dbh;
245 my $sth = $dbh->prepare($query);
247 while ( my $IT = $sth->fetchrow_hashref ) {
248 $itemtypes{ $IT->{'itemtype'} } = $IT;
250 return ( \%itemtypes );
253 sub get_itemtypeinfos_of {
256 my $placeholders = join( ', ', map { '?' } @itemtypes );
257 my $query = <<"END_SQL";
263 WHERE itemtype IN ( $placeholders )
266 return get_infos_of( $query, 'itemtype', undef, \@itemtypes );
269 # this is temporary until we separate collection codes and item types
273 my $dbh = C4::Context->dbh;
276 "SELECT * FROM authorised_values ORDER BY authorised_value");
278 while ( my $data = $sth->fetchrow_hashref ) {
279 if ( $data->{category} eq "CCODE" ) {
281 $results[$count] = $data;
287 return ( $count, @results );
292 $authtypes = &getauthtypes();
294 Returns information about existing authtypes.
296 build a HTML select with the following code :
298 =head3 in PERL SCRIPT
300 my $authtypes = getauthtypes;
302 foreach my $thisauthtype (keys %$authtypes) {
303 my $selected = 1 if $thisauthtype eq $authtype;
304 my %row =(value => $thisauthtype,
305 selected => $selected,
306 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
308 push @authtypesloop, \%row;
310 $template->param(itemtypeloop => \@itemtypesloop);
314 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
315 <select name="authtype">
316 <!-- TMPL_LOOP name="authtypeloop" -->
317 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
320 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
321 <input type="submit" value="OK" class="button">
329 # returns a reference to a hash of references to authtypes...
331 my $dbh = C4::Context->dbh;
332 my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
334 while ( my $IT = $sth->fetchrow_hashref ) {
335 $authtypes{ $IT->{'authtypecode'} } = $IT;
337 return ( \%authtypes );
341 my ($authtypecode) = @_;
343 # returns a reference to a hash of references to authtypes...
345 my $dbh = C4::Context->dbh;
346 my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
347 $sth->execute($authtypecode);
348 my $res = $sth->fetchrow_hashref;
354 $frameworks = &getframework();
356 Returns information about existing frameworks
358 build a HTML select with the following code :
360 =head3 in PERL SCRIPT
362 my $frameworks = frameworks();
364 foreach my $thisframework (keys %$frameworks) {
365 my $selected = 1 if $thisframework eq $frameworkcode;
366 my %row =(value => $thisframework,
367 selected => $selected,
368 description => $frameworks->{$thisframework}->{'frameworktext'},
370 push @frameworksloop, \%row;
372 $template->param(frameworkloop => \@frameworksloop);
376 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
377 <select name="frameworkcode">
378 <option value="">Default</option>
379 <!-- TMPL_LOOP name="frameworkloop" -->
380 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
383 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
384 <input type="submit" value="OK" class="button">
391 # returns a reference to a hash of references to branches...
393 my $dbh = C4::Context->dbh;
394 my $sth = $dbh->prepare("select * from biblio_framework");
396 while ( my $IT = $sth->fetchrow_hashref ) {
397 $itemtypes{ $IT->{'frameworkcode'} } = $IT;
399 return ( \%itemtypes );
402 =head2 getframeworkinfo
404 $frameworkinfo = &getframeworkinfo($frameworkcode);
406 Returns information about an frameworkcode.
410 sub getframeworkinfo {
411 my ($frameworkcode) = @_;
412 my $dbh = C4::Context->dbh;
414 $dbh->prepare("select * from biblio_framework where frameworkcode=?");
415 $sth->execute($frameworkcode);
416 my $res = $sth->fetchrow_hashref;
420 =head2 getitemtypeinfo
422 $itemtype = &getitemtype($itemtype);
424 Returns information about an itemtype.
428 sub getitemtypeinfo {
430 my $dbh = C4::Context->dbh;
431 my $sth = $dbh->prepare("select * from itemtypes where itemtype=?");
432 $sth->execute($itemtype);
433 my $res = $sth->fetchrow_hashref;
435 $res->{imageurl} = getitemtypeimagelocation( 'intranet', $res->{imageurl} );
440 =head2 getitemtypeimagedir
442 my $directory = getitemtypeimagedir( 'opac' );
444 pass in 'opac' or 'intranet'. Defaults to 'opac'.
446 returns the full path to the appropriate directory containing images.
450 sub getitemtypeimagedir {
451 my $src = shift || 'opac';
452 if ($src eq 'intranet') {
453 return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
455 return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('template') . '/itemtypeimg';
459 sub getitemtypeimagesrc {
460 my $src = shift || 'opac';
461 if ($src eq 'intranet') {
462 return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
464 return '/opac-tmpl' . '/' . C4::Context->preference('template') . '/itemtypeimg';
468 sub getitemtypeimagelocation($$) {
469 my ( $src, $image ) = @_;
471 return '' if ( !$image );
473 my $scheme = ( uri_split( $image ) )[0];
475 return $image if ( $scheme );
477 return getitemtypeimagesrc( $src ) . '/' . $image;
480 =head3 _getImagesFromDirectory
482 Find all of the image files in a directory in the filesystem
484 parameters: a directory name
486 returns: a list of images in that directory.
488 Notes: this does not traverse into subdirectories. See
489 _getSubdirectoryNames for help with that.
490 Images are assumed to be files with .gif or .png file extensions.
491 The image names returned do not have the directory name on them.
495 sub _getImagesFromDirectory {
496 my $directoryname = shift;
497 return unless defined $directoryname;
498 return unless -d $directoryname;
500 if ( opendir ( my $dh, $directoryname ) ) {
501 my @images = grep { /\.(gif|png)$/i } readdir( $dh );
503 @images = sort(@images);
506 warn "unable to opendir $directoryname: $!";
511 =head3 _getSubdirectoryNames
513 Find all of the directories in a directory in the filesystem
515 parameters: a directory name
517 returns: a list of subdirectories in that directory.
519 Notes: this does not traverse into subdirectories. Only the first
520 level of subdirectories are returned.
521 The directory names returned don't have the parent directory name on them.
525 sub _getSubdirectoryNames {
526 my $directoryname = shift;
527 return unless defined $directoryname;
528 return unless -d $directoryname;
530 if ( opendir ( my $dh, $directoryname ) ) {
531 my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
535 warn "unable to opendir $directoryname: $!";
542 returns: a listref of hashrefs. Each hash represents another collection of images.
544 { imagesetname => 'npl', # the name of the image set (npl is the original one)
545 images => listref of image hashrefs
548 each image is represented by a hashref like this:
550 { KohaImage => 'npl/image.gif',
551 StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
552 OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
553 checked => 0 or 1: was this the image passed to this method?
554 Note: I'd like to remove this somehow.
561 my $checked = $params{'checked'} || '';
563 my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
564 url => getitemtypeimagesrc('intranet'),
566 opac => { filesystem => getitemtypeimagedir('opac'),
567 url => getitemtypeimagesrc('opac'),
571 my @imagesets = (); # list of hasrefs of image set data to pass to template
572 my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
573 warn $paths->{'staff'}{'filesystem'};
574 foreach my $imagesubdir ( @subdirectories ) {
576 my @imagelist = (); # hashrefs of image info
577 my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
578 my $imagesetactive = 0;
579 foreach my $thisimage ( @imagenames ) {
581 { KohaImage => "$imagesubdir/$thisimage",
582 StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
583 OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
584 checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
587 $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked;
589 push @imagesets, { imagesetname => $imagesubdir,
590 imagesetactive => $imagesetactive,
591 images => \@imagelist };
599 $printers = &GetPrinters();
600 @queues = keys %$printers;
602 Returns information about existing printer queues.
604 C<$printers> is a reference-to-hash whose keys are the print queues
605 defined in the printers table of the Koha database. The values are
606 references-to-hash, whose keys are the fields in the printers table.
612 my $dbh = C4::Context->dbh;
613 my $sth = $dbh->prepare("select * from printers");
615 while ( my $printer = $sth->fetchrow_hashref ) {
616 $printers{ $printer->{'printqueue'} } = $printer;
618 return ( \%printers );
623 $printer = GetPrinter( $query, $printers );
627 sub GetPrinter ($$) {
628 my ( $query, $printers ) = @_; # get printer for this query from printers
629 my $printer = $query->param('printer');
630 my %cookie = $query->cookie('userenv');
631 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
632 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
638 Returns the number of pages to display in a pagination bar, given the number
639 of items and the number of items per page.
644 my ( $nb_items, $nb_items_per_page ) = @_;
646 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
651 (@themes) = &getallthemes('opac');
652 (@themes) = &getallthemes('intranet');
654 Returns an array of all available themes.
662 if ( $type eq 'intranet' ) {
663 $htdocs = C4::Context->config('intrahtdocs');
666 $htdocs = C4::Context->config('opachtdocs');
668 opendir D, "$htdocs";
669 my @dirlist = readdir D;
670 foreach my $directory (@dirlist) {
671 -d "$htdocs/$directory/en" and push @themes, $directory;
678 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
681 link_value => 'su-to',
682 label_value => 'Topics',
684 [ '600', '601', '602', '603', '604', '605', '606', '610' ],
688 link_value => 'su-geo',
689 label_value => 'Places',
694 link_value => 'su-ut',
695 label_value => 'Titles',
696 tags => [ '500', '501', '502', '503', '504', ],
701 label_value => 'Authors',
702 tags => [ '700', '701', '702', ],
707 label_value => 'Series',
716 link_value => 'branch',
717 label_value => 'Libraries',
722 push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
727 link_value => 'su-to',
728 label_value => 'Topics',
734 # link_value => 'su-na',
735 # label_value => 'People and Organizations',
736 # tags => ['600', '610', '611'],
740 link_value => 'su-geo',
741 label_value => 'Places',
746 link_value => 'su-ut',
747 label_value => 'Titles',
753 label_value => 'Authors',
754 tags => [ '100', '110', '700', ],
759 label_value => 'Series',
760 tags => [ '440', '490', ],
766 link_value => 'branch',
767 label_value => 'Libraries',
772 push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
779 Return a href where a key is associated to a href. You give a query,
780 the name of the key among the fields returned by the query. If you
781 also give as third argument the name of the value, the function
782 returns a href of scalar. The optional 4th argument is an arrayref of
783 items passed to the C<execute()> call. It is designed to bind
784 parameters to any placeholders in your SQL.
793 # generic href of any information on the item, href of href.
794 my $iteminfos_of = get_infos_of($query, 'itemnumber');
795 print $iteminfos_of->{$itemnumber}{barcode};
797 # specific information, href of scalar
798 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
799 print $barcode_of_item->{$itemnumber};
804 my ( $query, $key_name, $value_name, $bind_params ) = @_;
806 my $dbh = C4::Context->dbh;
808 my $sth = $dbh->prepare($query);
809 $sth->execute( @$bind_params );
812 while ( my $row = $sth->fetchrow_hashref ) {
813 if ( defined $value_name ) {
814 $infos_of{ $row->{$key_name} } = $row->{$value_name};
817 $infos_of{ $row->{$key_name} } = $row;
825 =head2 get_notforloan_label_of
827 my $notforloan_label_of = get_notforloan_label_of();
829 Each authorised value of notforloan (information available in items and
830 itemtypes) is link to a single label.
832 Returns a href where keys are authorised values and values are corresponding
835 foreach my $authorised_value (keys %{$notforloan_label_of}) {
837 "authorised_value: %s => %s\n",
839 $notforloan_label_of->{$authorised_value}
845 # FIXME - why not use GetAuthorisedValues ??
847 sub get_notforloan_label_of {
848 my $dbh = C4::Context->dbh;
851 SELECT authorised_value
852 FROM marc_subfield_structure
853 WHERE kohafield = \'items.notforloan\'
856 my $sth = $dbh->prepare($query);
858 my ($statuscode) = $sth->fetchrow_array();
863 FROM authorised_values
866 $sth = $dbh->prepare($query);
867 $sth->execute($statuscode);
868 my %notforloan_label_of;
869 while ( my $row = $sth->fetchrow_hashref ) {
870 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
874 return \%notforloan_label_of;
877 =head2 displayServers
879 my $servers = displayServers();
880 my $servers = displayServers( $position );
881 my $servers = displayServers( $position, $type );
883 displayServers returns a listref of hashrefs, each containing
884 information about available z3950 servers. Each hashref has a format
888 'checked' => 'checked',
889 'encoding' => 'MARC-8'
891 'id' => 'LIBRARY OF CONGRESS',
895 'value' => 'z3950.loc.gov:7090/',
902 my ( $position, $type ) = @_;
903 my $dbh = C4::Context->dbh;
905 my $strsth = 'SELECT * FROM z3950servers';
910 push @bind_params, $position;
911 push @where_clauses, ' position = ? ';
915 push @bind_params, $type;
916 push @where_clauses, ' type = ? ';
919 # reassemble where clause from where clause pieces
920 if (@where_clauses) {
921 $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
924 my $rq = $dbh->prepare($strsth);
925 $rq->execute(@bind_params);
926 my @primaryserverloop;
928 while ( my $data = $rq->fetchrow_hashref ) {
929 push @primaryserverloop,
930 { label => $data->{description},
933 value => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
934 encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
935 checked => "checked",
936 icon => $data->{icon},
937 zed => $data->{type} eq 'zed',
938 opensearch => $data->{type} eq 'opensearch'
941 return \@primaryserverloop;
944 =head2 GetAuthValCode
946 $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
951 my ($kohafield,$fwcode) = @_;
952 my $dbh = C4::Context->dbh;
953 $fwcode='' unless $fwcode;
954 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
955 $sth->execute($kohafield,$fwcode);
956 my ($authvalcode) = $sth->fetchrow_array;
960 =head2 GetAuthValCodeFromField
962 $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
964 C<$subfield> can be undefined
968 sub GetAuthValCodeFromField {
969 my ($field,$subfield,$fwcode) = @_;
970 my $dbh = C4::Context->dbh;
971 $fwcode='' unless $fwcode;
973 if (defined $subfield) {
974 $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
975 $sth->execute($field,$subfield,$fwcode);
977 $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
978 $sth->execute($field,$fwcode);
980 my ($authvalcode) = $sth->fetchrow_array;
984 =head2 GetAuthorisedValues
986 $authvalues = GetAuthorisedValues([$category], [$selected]);
988 This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
990 C<$category> returns authorised values for just one category (optional).
992 C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
996 sub GetAuthorisedValues {
997 my ($category,$selected,$opac) = @_;
999 my $dbh = C4::Context->dbh;
1000 my $query = "SELECT * FROM authorised_values";
1001 $query .= " WHERE category = '" . $category . "'" if $category;
1002 $query .= " ORDER BY category, lib, lib_opac";
1003 my $sth = $dbh->prepare($query);
1005 while (my $data=$sth->fetchrow_hashref) {
1006 if ($selected && $selected eq $data->{'authorised_value'} ) {
1007 $data->{'selected'} = 1;
1009 if ($opac && $data->{'lib_opac'}) {
1010 $data->{'lib'} = $data->{'lib_opac'};
1012 push @results, $data;
1014 #my $data = $sth->fetchall_arrayref({});
1015 return \@results; #$data;
1018 =head2 GetAuthorisedValueCategories
1020 $auth_categories = GetAuthorisedValueCategories();
1022 Return an arrayref of all of the available authorised
1027 sub GetAuthorisedValueCategories {
1028 my $dbh = C4::Context->dbh;
1029 my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
1032 while (my $category = $sth->fetchrow_array) {
1033 push @results, $category;
1038 =head2 GetKohaAuthorisedValues
1040 Takes $kohafield, $fwcode as parameters.
1042 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1044 Returns hashref of Code => description
1046 Returns undef if no authorised value category is defined for the kohafield.
1050 sub GetKohaAuthorisedValues {
1051 my ($kohafield,$fwcode,$opac) = @_;
1052 $fwcode='' unless $fwcode;
1054 my $dbh = C4::Context->dbh;
1055 my $avcode = GetAuthValCode($kohafield,$fwcode);
1057 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1058 $sth->execute($avcode);
1059 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1060 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1068 =head2 GetKohaAuthorisedValuesFromField
1070 Takes $field, $subfield, $fwcode as parameters.
1072 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1073 $subfield can be undefined
1075 Returns hashref of Code => description
1077 Returns undef if no authorised value category is defined for the given field and subfield
1081 sub GetKohaAuthorisedValuesFromField {
1082 my ($field, $subfield, $fwcode,$opac) = @_;
1083 $fwcode='' unless $fwcode;
1085 my $dbh = C4::Context->dbh;
1086 my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1088 my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1089 $sth->execute($avcode);
1090 while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1091 $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1101 my $escaped_string = C4::Koha::xml_escape($string);
1103 Convert &, <, >, ', and " in a string to XML entities
1109 return '' unless defined $str;
1110 $str =~ s/&/&/g;
1113 $str =~ s/'/'/g;
1114 $str =~ s/"/"/g;
1118 =head2 GetKohaAuthorisedValueLib
1120 Takes $category, $authorised_value as parameters.
1122 If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
1124 Returns authorised value description
1128 sub GetKohaAuthorisedValueLib {
1129 my ($category,$authorised_value,$opac) = @_;
1131 my $dbh = C4::Context->dbh;
1132 my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?");
1133 $sth->execute($category,$authorised_value);
1134 my $data = $sth->fetchrow_hashref;
1135 $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'};
1139 =head2 display_marc_indicators
1141 my $display_form = C4::Koha::display_marc_indicators($field);
1143 C<$field> is a MARC::Field object
1145 Generate a display form of the indicators of a variable
1146 MARC field, replacing any blanks with '#'.
1150 sub display_marc_indicators {
1152 my $indicators = '';
1153 if ($field->tag() >= 10) {
1154 $indicators = $field->indicator(1) . $field->indicator(2);
1155 $indicators =~ s/ /#/g;
1160 sub GetNormalizedUPC {
1161 my ($record,$marcflavour) = @_;
1164 if ($marcflavour eq 'MARC21') {
1165 @fields = $record->field('024');
1166 foreach my $field (@fields) {
1167 my $indicator = $field->indicator(1);
1168 my $upc = _normalize_match_point($field->subfield('a'));
1169 if ($indicator == 1 and $upc ne '') {
1174 else { # assume unimarc if not marc21
1175 @fields = $record->field('072');
1176 foreach my $field (@fields) {
1177 my $upc = _normalize_match_point($field->subfield('a'));
1185 # Normalizes and returns the first valid ISBN found in the record
1186 # ISBN13 are converted into ISBN10. This is required to get Amazon cover book.
1187 sub GetNormalizedISBN {
1188 my ($isbn,$record,$marcflavour) = @_;
1191 # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | "
1192 # anything after " | " should be removed, along with the delimiter
1193 $isbn =~ s/(.*)( \| )(.*)/$1/;
1194 return _isbn_cleanup($isbn);
1196 return undef unless $record;
1198 if ($marcflavour eq 'MARC21') {
1199 @fields = $record->field('020');
1200 foreach my $field (@fields) {
1201 $isbn = $field->subfield('a');
1203 return _isbn_cleanup($isbn);
1209 else { # assume unimarc if not marc21
1210 @fields = $record->field('010');
1211 foreach my $field (@fields) {
1212 my $isbn = $field->subfield('a');
1214 return _isbn_cleanup($isbn);
1223 sub GetNormalizedEAN {
1224 my ($record,$marcflavour) = @_;
1227 if ($marcflavour eq 'MARC21') {
1228 @fields = $record->field('024');
1229 foreach my $field (@fields) {
1230 my $indicator = $field->indicator(1);
1231 $ean = _normalize_match_point($field->subfield('a'));
1232 if ($indicator == 3 and $ean ne '') {
1237 else { # assume unimarc if not marc21
1238 @fields = $record->field('073');
1239 foreach my $field (@fields) {
1240 $ean = _normalize_match_point($field->subfield('a'));
1247 sub GetNormalizedOCLCNumber {
1248 my ($record,$marcflavour) = @_;
1251 if ($marcflavour eq 'MARC21') {
1252 @fields = $record->field('035');
1253 foreach my $field (@fields) {
1254 $oclc = $field->subfield('a');
1255 if ($oclc =~ /OCoLC/) {
1256 $oclc =~ s/\(OCoLC\)//;
1263 else { # TODO: add UNIMARC fields
1267 sub _normalize_match_point {
1268 my $match_point = shift;
1269 (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
1270 $normalized_match_point =~ s/-//g;
1272 return $normalized_match_point;
1276 my $isbn = Business::ISBN->new( $_[0] );
1278 $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13';
1279 if (defined $isbn) {
1280 return $isbn->as_string([]);