3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA 02111-1307 USA
26 use vars qw($VERSION @ISA @EXPORT);
28 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
32 C4::Koha - Perl Module containing convenience functions for Koha scripts
39 $date = slashifyDate("01-01-2002")
43 Koha.pm provides many functions for Koha scripts.
53 &subfield_is_koha_internal_p
54 &getbranches &getbranch &getbranchdetail
55 &getprinters &getprinter
56 &getitemtypes &getitemtypeinfo
58 &getframeworks &getframeworkinfo
59 &getauthtypes &getauthtype
60 &getallthemes &getalllanguages
61 &getallbranches &getletters
66 getitemtypeimagesrcfromurl
70 get_notforloan_label_of
78 # FIXME.. this should be moved to a MARC-specific module
79 sub subfield_is_koha_internal_p ($) {
82 # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
83 # But real MARC subfields are always single-character
84 # so it really is safer just to check the length
86 return length $subfield != 1;
91 $branches = &getbranches();
92 returns informations about branches.
93 Create a branch selector with the following code
94 Is branchIndependant sensitive
95 When IndependantBranches is set AND user is not superlibrarian, displays only user's branch
99 my $branches = getbranches;
101 foreach my $thisbranch (sort keys %$branches) {
102 my $selected = 1 if $thisbranch eq $branch;
103 my %row =(value => $thisbranch,
104 selected => $selected,
105 branchname => $branches->{$thisbranch}->{'branchname'},
107 push @branchloop, \%row;
112 <select name="branch">
113 <option value="">Default</option>
114 <!-- TMPL_LOOP name="branchloop" -->
115 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="branchname" --></option>
122 # returns a reference to a hash of references to branches...
124 my $dbh = C4::Context->dbh;
126 if (C4::Context->preference("IndependantBranches") && (C4::Context->userenv->{flags}!=1)){
127 my $strsth ="Select * from branches ";
128 $strsth.= " WHERE branchcode = ".$dbh->quote(C4::Context->userenv->{branch});
129 $strsth.= " order by branchname";
130 $sth=$dbh->prepare($strsth);
132 $sth = $dbh->prepare("Select * from branches order by branchname");
135 while (my $branch=$sth->fetchrow_hashref) {
136 my $nsth = $dbh->prepare("select categorycode from branchrelations where branchcode = ?");
137 $nsth->execute($branch->{'branchcode'});
138 while (my ($cat) = $nsth->fetchrow_array) {
139 # FIXME - This seems wrong. It ought to be
140 # $branch->{categorycodes}{$cat} = 1;
141 # otherwise, there's a namespace collision if there's a
142 # category with the same name as a field in the 'branches'
143 # table (i.e., don't create a category called "issuing").
144 # In addition, the current structure doesn't really allow
145 # you to list the categories that a branch belongs to:
146 # you'd have to list keys %$branch, and remove those keys
147 # that aren't fields in the "branches" table.
150 $branches{$branch->{'branchcode'}}=$branch;
157 my $dbh = C4::Context->dbh;
159 $sth = $dbh->prepare("Select branchname from branches where branchcode=?");
160 $sth->execute($branchcode);
161 my $branchname = $sth->fetchrow_array;
167 =head2 getallbranches
169 $branches = &getallbranches();
170 returns informations about ALL branches.
171 Create a branch selector with the following code
172 IndependantBranches Insensitive...
174 =head3 in PERL SCRIPT
176 my $branches = getallbranches;
178 foreach my $thisbranch (keys %$branches) {
179 my $selected = 1 if $thisbranch eq $branch;
180 my %row =(value => $thisbranch,
181 selected => $selected,
182 branchname => $branches->{$thisbranch}->{'branchname'},
184 push @branchloop, \%row;
189 <select name="branch">
190 <option value="">Default</option>
191 <!-- TMPL_LOOP name="branchloop" -->
192 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="branchname" --></option>
200 # returns a reference to a hash of references to ALL branches...
202 my $dbh = C4::Context->dbh;
204 $sth = $dbh->prepare("Select * from branches order by branchname");
206 while (my $branch=$sth->fetchrow_hashref) {
207 my $nsth = $dbh->prepare("select categorycode from branchrelations where branchcode = ?");
208 $nsth->execute($branch->{'branchcode'});
209 while (my ($cat) = $nsth->fetchrow_array) {
210 # FIXME - This seems wrong. It ought to be
211 # $branch->{categorycodes}{$cat} = 1;
212 # otherwise, there's a namespace collision if there's a
213 # category with the same name as a field in the 'branches'
214 # table (i.e., don't create a category called "issuing").
215 # In addition, the current structure doesn't really allow
216 # you to list the categories that a branch belongs to:
217 # you'd have to list keys %$branch, and remove those keys
218 # that aren't fields in the "branches" table.
221 $branches{$branch->{'branchcode'}}=$branch;
228 $letters = &getletters($category);
229 returns informations about letters.
230 if needed, $category filters for letters given category
231 Create a letter selector with the following code
233 =head3 in PERL SCRIPT
235 my $letters = getletters($cat);
237 foreach my $thisletter (keys %$letters) {
238 my $selected = 1 if $thisletter eq $letter;
239 my %row =(value => $thisletter,
240 selected => $selected,
241 lettername => $letters->{$thisletter},
243 push @letterloop, \%row;
248 <select name="letter">
249 <option value="">Default</option>
250 <!-- TMPL_LOOP name="letterloop" -->
251 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="lettername" --></option>
258 # returns a reference to a hash of references to ALL letters...
261 my $dbh = C4::Context->dbh;
264 $sth = $dbh->prepare("Select * from letter where module = \'".$cat."\' order by name");
266 $sth = $dbh->prepare("Select * from letter order by name");
270 while (my $letter=$sth->fetchrow_hashref) {
271 $letters{$letter->{'code'}}=$letter->{'name'};
274 return ($count,\%letters);
279 $itemtypes = &getitemtypes();
281 Returns information about existing itemtypes.
283 build a HTML select with the following code :
285 =head3 in PERL SCRIPT
287 my $itemtypes = getitemtypes;
289 foreach my $thisitemtype (sort keys %$itemtypes) {
290 my $selected = 1 if $thisitemtype eq $itemtype;
291 my %row =(value => $thisitemtype,
292 selected => $selected,
293 description => $itemtypes->{$thisitemtype}->{'description'},
295 push @itemtypesloop, \%row;
297 $template->param(itemtypeloop => \@itemtypesloop);
301 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
302 <select name="itemtype">
303 <option value="">Default</option>
304 <!-- TMPL_LOOP name="itemtypeloop" -->
305 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
308 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
309 <input type="submit" value="OK" class="button">
316 # returns a reference to a hash of references to branches...
318 my $dbh = C4::Context->dbh;
319 my $sth=$dbh->prepare("select * from itemtypes");
321 while (my $IT=$sth->fetchrow_hashref) {
322 $itemtypes{$IT->{'itemtype'}}=$IT;
324 return (\%itemtypes);
327 # FIXME this function is better and should replace getitemtypes everywhere
328 sub get_itemtypeinfos_of {
336 WHERE itemtype IN ('.join(',', map({"'".$_."'"} @itemtypes)).')
339 return get_infos_of($query, 'itemtype');
344 $authtypes = &getauthtypes();
346 Returns information about existing authtypes.
348 build a HTML select with the following code :
350 =head3 in PERL SCRIPT
352 my $authtypes = getauthtypes;
354 foreach my $thisauthtype (keys %$authtypes) {
355 my $selected = 1 if $thisauthtype eq $authtype;
356 my %row =(value => $thisauthtype,
357 selected => $selected,
358 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
360 push @authtypesloop, \%row;
362 $template->param(itemtypeloop => \@itemtypesloop);
366 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
367 <select name="authtype">
368 <!-- TMPL_LOOP name="authtypeloop" -->
369 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
372 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
373 <input type="submit" value="OK" class="button">
380 # returns a reference to a hash of references to authtypes...
382 my $dbh = C4::Context->dbh;
383 my $sth=$dbh->prepare("select * from auth_types order by authtypetext");
385 while (my $IT=$sth->fetchrow_hashref) {
386 $authtypes{$IT->{'authtypecode'}}=$IT;
388 return (\%authtypes);
392 my ($authtypecode) = @_;
393 # returns a reference to a hash of references to authtypes...
395 my $dbh = C4::Context->dbh;
396 my $sth=$dbh->prepare("select * from auth_types where authtypecode=?");
397 $sth->execute($authtypecode);
398 my $res=$sth->fetchrow_hashref;
404 $frameworks = &getframework();
406 Returns information about existing frameworks
408 build a HTML select with the following code :
410 =head3 in PERL SCRIPT
412 my $frameworks = frameworks();
414 foreach my $thisframework (keys %$frameworks) {
415 my $selected = 1 if $thisframework eq $frameworkcode;
416 my %row =(value => $thisframework,
417 selected => $selected,
418 description => $frameworks->{$thisframework}->{'frameworktext'},
420 push @frameworksloop, \%row;
422 $template->param(frameworkloop => \@frameworksloop);
426 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
427 <select name="frameworkcode">
428 <option value="">Default</option>
429 <!-- TMPL_LOOP name="frameworkloop" -->
430 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
433 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
434 <input type="submit" value="OK" class="button">
441 # returns a reference to a hash of references to branches...
443 my $dbh = C4::Context->dbh;
444 my $sth=$dbh->prepare("select * from biblio_framework");
446 while (my $IT=$sth->fetchrow_hashref) {
447 $itemtypes{$IT->{'frameworkcode'}}=$IT;
449 return (\%itemtypes);
451 =head2 getframeworkinfo
453 $frameworkinfo = &getframeworkinfo($frameworkcode);
455 Returns information about an frameworkcode.
459 sub getframeworkinfo {
460 my ($frameworkcode) = @_;
461 my $dbh = C4::Context->dbh;
462 my $sth=$dbh->prepare("select * from biblio_framework where frameworkcode=?");
463 $sth->execute($frameworkcode);
464 my $res = $sth->fetchrow_hashref;
469 =head2 getitemtypeinfo
471 $itemtype = &getitemtype($itemtype);
473 Returns information about an itemtype.
477 sub getitemtypeinfo {
479 my $dbh = C4::Context->dbh;
480 my $sth=$dbh->prepare("select * from itemtypes where itemtype=?");
481 $sth->execute($itemtype);
482 my $res = $sth->fetchrow_hashref;
484 $res->{imageurl} = getitemtypeimagesrcfromurl($res->{imageurl});
489 sub getitemtypeimagesrcfromurl {
492 if (defined $imageurl and $imageurl !~ m/^http/) {
494 getitemtypeimagesrc()
502 sub getitemtypeimagedir {
504 C4::Context->intrahtdocs
505 .'/'.C4::Context->preference('template')
510 sub getitemtypeimagesrc {
513 .'/'.C4::Context->preference('template')
520 $printers = &getprinters($env);
521 @queues = keys %$printers;
523 Returns information about existing printer queues.
527 C<$printers> is a reference-to-hash whose keys are the print queues
528 defined in the printers table of the Koha database. The values are
529 references-to-hash, whose keys are the fields in the printers table.
536 my $dbh = C4::Context->dbh;
537 my $sth=$dbh->prepare("select * from printers");
539 while (my $printer=$sth->fetchrow_hashref) {
540 $printers{$printer->{'printqueue'}}=$printer;
546 my($query, $branches) = @_; # get branch for this query from branches
547 my $branch = $query->param('branch');
548 ($branch) || ($branch = $query->cookie('branch'));
549 ($branches->{$branch}) || ($branch=(keys %$branches)[0]);
553 =item getbranchdetail
555 $branchname = &getbranchdetail($branchcode);
557 Given the branch code, the function returns the corresponding
558 branch name for a comprehensive information display
564 my ($branchcode) = @_;
565 my $dbh = C4::Context->dbh;
566 my $sth = $dbh->prepare("SELECT * FROM branches WHERE branchcode = ?");
567 $sth->execute($branchcode);
568 my $branchname = $sth->fetchrow_hashref();
571 } # sub getbranchname
574 sub getprinter ($$) {
575 my($query, $printers) = @_; # get printer for this query from printers
576 my $printer = $query->param('printer');
577 ($printer) || ($printer = $query->cookie('printer')) || ($printer='');
578 ($printers->{$printer}) || ($printer = (keys %$printers)[0]);
582 =item getalllanguages
584 (@languages) = &getalllanguages($type);
585 (@languages) = &getalllanguages($type,$theme);
587 Returns an array of all available languages.
591 sub getalllanguages {
596 if ($type eq 'opac') {
597 $htdocs=C4::Context->config('opachtdocs');
598 if ($theme and -d "$htdocs/$theme") {
599 opendir D, "$htdocs/$theme";
600 foreach my $language (readdir D) {
601 next if $language=~/^\./;
602 next if $language eq 'all';
603 next if $language=~ /png$/;
604 next if $language=~ /css$/;
605 next if $language=~ /CVS$/;
606 next if $language=~ /itemtypeimg$/;
607 push @languages, $language;
609 return sort @languages;
612 foreach my $theme (getallthemes('opac')) {
613 opendir D, "$htdocs/$theme";
614 foreach my $language (readdir D) {
615 next if $language=~/^\./;
616 next if $language eq 'all';
617 next if $language=~ /png$/;
618 next if $language=~ /css$/;
619 next if $language=~ /CVS$/;
620 next if $language=~ /itemtypeimg$/;
621 $lang->{$language}=1;
624 @languages=keys %$lang;
625 return sort @languages;
627 } elsif ($type eq 'intranet') {
628 $htdocs=C4::Context->config('intrahtdocs');
629 if ($theme and -d "$htdocs/$theme") {
630 opendir D, "$htdocs/$theme";
631 foreach my $language (readdir D) {
632 next if $language=~/^\./;
633 next if $language eq 'all';
634 next if $language=~ /png$/;
635 next if $language=~ /css$/;
636 next if $language=~ /CVS$/;
637 next if $language=~ /itemtypeimg$/;
638 push @languages, $language;
640 return sort @languages;
643 foreach my $theme (getallthemes('opac')) {
644 opendir D, "$htdocs/$theme";
645 foreach my $language (readdir D) {
646 next if $language=~/^\./;
647 next if $language eq 'all';
648 next if $language=~ /png$/;
649 next if $language=~ /css$/;
650 next if $language=~ /CVS$/;
651 next if $language=~ /itemtypeimg$/;
652 $lang->{$language}=1;
655 @languages=keys %$lang;
656 return sort @languages;
660 my $htdocs=C4::Context->config('intrahtdocs');
661 foreach my $theme (getallthemes('intranet')) {
662 opendir D, "$htdocs/$theme";
663 foreach my $language (readdir D) {
664 next if $language=~/^\./;
665 next if $language eq 'all';
666 next if $language=~ /png$/;
667 next if $language=~ /css$/;
668 next if $language=~ /CVS$/;
669 next if $language=~ /itemtypeimg$/;
670 $lang->{$language}=1;
673 $htdocs=C4::Context->config('opachtdocs');
674 foreach my $theme (getallthemes('opac')) {
675 opendir D, "$htdocs/$theme";
676 foreach my $language (readdir D) {
677 next if $language=~/^\./;
678 next if $language eq 'all';
679 next if $language=~ /png$/;
680 next if $language=~ /css$/;
681 next if $language=~ /CVS$/;
682 next if $language=~ /itemtypeimg$/;
683 $lang->{$language}=1;
686 @languages=keys %$lang;
687 return sort @languages;
693 (@themes) = &getallthemes('opac');
694 (@themes) = &getallthemes('intranet');
696 Returns an array of all available themes.
704 if ($type eq 'intranet') {
705 $htdocs=C4::Context->config('intrahtdocs');
707 $htdocs=C4::Context->config('opachtdocs');
709 opendir D, "$htdocs";
710 my @dirlist=readdir D;
711 foreach my $directory (@dirlist) {
712 -d "$htdocs/$directory/en" and push @themes, $directory;
719 Returns the number of pages to display in a pagination bar, given the number
720 of items and the number of items per page.
725 my ($nb_items, $nb_items_per_page) = @_;
727 return int(($nb_items - 1) / $nb_items_per_page) + 1;
731 =head2 getcities (OUEST-PROVENCE)
733 ($id_cityarrayref, $city_hashref) = &getcities();
735 Looks up the different city and zip in the database. Returns two
736 elements: a reference-to-array, which lists the zip city
737 codes, and a reference-to-hash, which maps the name of the city.
738 WHERE =>OUEST PROVENCE OR EXTERIEUR
742 #my ($type_city) = @_;
743 my $dbh = C4::Context->dbh;
744 my $sth=$dbh->prepare("Select cityid,city_name from cities order by cityid ");
745 #$sth->execute($type_city);
749 # insert empty value to create a empty choice in cgi popup
751 while (my $data=$sth->fetchrow_hashref){
753 push @id,$data->{'cityid'};
754 $city{$data->{'cityid'}}=$data->{'city_name'};
757 #test to know if the table contain some records if no the function return nothing
771 =head2 getroadtypes (OUEST-PROVENCE)
773 ($idroadtypearrayref, $roadttype_hashref) = &getroadtypes();
775 Looks up the different road type . Returns two
776 elements: a reference-to-array, which lists the id_roadtype
777 codes, and a reference-to-hash, which maps the road type of the road .
782 my $dbh = C4::Context->dbh;
783 my $sth=$dbh->prepare("Select roadtypeid,road_type from roadtype order by road_type ");
787 # insert empty value to create a empty choice in cgi popup
788 while (my $data=$sth->fetchrow_hashref){
789 push @id,$data->{'roadtypeid'};
790 $roadtype{$data->{'roadtypeid'}}=$data->{'road_type'};
792 #test to know if the table contain some records if no the function return nothing
801 return(\@id,\%roadtype);
805 =head2 get_branchinfos_of
807 my $branchinfos_of = get_branchinfos_of(@branchcodes);
809 Associates a list of branchcodes to the information of the branch, taken in
812 Returns a href where keys are branchcodes and values are href where keys are
813 branch information key.
815 print 'branchname is ', $branchinfos_of->{$code}->{branchname};
818 sub get_branchinfos_of {
819 my @branchcodes = @_;
825 WHERE branchcode IN ('.join(',', map({"'".$_."'"} @branchcodes)).')
827 return get_infos_of($query, 'branchcode');
830 =head2 get_notforloan_label_of
832 my $notforloan_label_of = get_notforloan_label_of();
834 Each authorised value of notforloan (information available in items and
835 itemtypes) is link to a single label.
837 Returns a href where keys are authorised values and values are corresponding
840 foreach my $authorised_value (keys %{$notforloan_label_of}) {
842 "authorised_value: %s => %s\n",
844 $notforloan_label_of->{$authorised_value}
849 sub get_notforloan_label_of {
850 my $dbh = C4::Context->dbh;
853 SELECT authorised_value
854 FROM marc_subfield_structure
855 WHERE kohafield = \'items.notforloan\'
858 my $sth = $dbh->prepare($query);
860 my ($statuscode) = $sth->fetchrow_array();
865 FROM authorised_values
868 $sth = $dbh->prepare($query);
869 $sth->execute($statuscode);
870 my %notforloan_label_of;
871 while (my $row = $sth->fetchrow_hashref) {
872 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
876 return \%notforloan_label_of;
881 Return a href where a key is associated to a href. You give a query, the
882 name of the key among the fields returned by the query. If you also give as
883 third argument the name of the value, the function returns a href of scalar.
892 # generic href of any information on the item, href of href.
893 my $iteminfos_of = get_infos_of($query, 'itemnumber');
894 print $iteminfos_of->{$itemnumber}{barcode};
896 # specific information, href of scalar
897 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
898 print $barcode_of_item->{$itemnumber};
902 my ($query, $key_name, $value_name) = @_;
904 my $dbh = C4::Context->dbh;
906 my $sth = $dbh->prepare($query);
910 while (my $row = $sth->fetchrow_hashref) {
911 if (defined $value_name) {
912 $infos_of{ $row->{$key_name} } = $row->{$value_name};
915 $infos_of{ $row->{$key_name} } = $row;