Stores an associated borrowernumber now with issue data, if the system pref is set.
[koha.git] / C4 / Koha.pm
index 9321a9d..63d1f71 100644 (file)
@@ -17,13 +17,15 @@ package C4::Koha;
 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
 # Suite 330, Boston, MA  02111-1307 USA
 
+# $Id$
+
 use strict;
 require Exporter;
 use C4::Context;
 
 use vars qw($VERSION @ISA @EXPORT);
 
-$VERSION = 0.01;
+$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
 
 =head1 NAME
 
@@ -35,9 +37,6 @@ C4::Koha - Perl Module containing convenience functions for Koha scripts
 
 
   $date = slashifyDate("01-01-2002")
-  $ethnicity = fixEthnicity('asian');
-  ($categories, $labels) = borrowercategories();
-  ($categories, $labels) = ethnicitycategories();
 
 =head1 DESCRIPTION
 
@@ -51,120 +50,31 @@ Koha.pm provides many functions for Koha scripts.
 
 @ISA = qw(Exporter);
 @EXPORT = qw(
-                       &fixEthnicity
-                       &borrowercategories &getborrowercategory
-                       &ethnicitycategories
                        &subfield_is_koha_internal_p
                        &getbranches &getbranch &getbranchdetail
                        &getprinters &getprinter
                        &getitemtypes &getitemtypeinfo
+                        get_itemtypeinfos_of
                        &getframeworks &getframeworkinfo
                        &getauthtypes &getauthtype
                        &getallthemes &getalllanguages
-                       &getallbranches
+                       &getallbranches &getletters
+                       &getbranchname
+                        getnbpages
+                        getitemtypeimagedir
+                        getitemtypeimagesrc
+                        getitemtypeimagesrcfromurl
+                       &getcities
+                       &getroadtypes
+                        get_branchinfos_of
+                        get_notforloan_label_of
+                        get_infos_of
                        $DEBUG);
 
 use vars qw();
 
 my $DEBUG = 0;
 
-# removed slashifyDate => useless
-
-=head2 fixEthnicity
-
-  $ethn_name = &fixEthnicity($ethn_code);
-
-Takes an ethnicity code (e.g., "european" or "pi") and returns the
-corresponding descriptive name from the C<ethnicity> table in the
-Koha database ("European" or "Pacific Islander").
-
-=cut
-#'
-
-sub fixEthnicity($) {
-
-    my $ethnicity = shift;
-    my $dbh = C4::Context->dbh;
-    my $sth=$dbh->prepare("Select name from ethnicity where code = ?");
-    $sth->execute($ethnicity);
-    my $data=$sth->fetchrow_hashref;
-    $sth->finish;
-    return $data->{'name'};
-}
-
-=head2 borrowercategories
-
-  ($codes_arrayref, $labels_hashref) = &borrowercategories();
-
-Looks up the different types of borrowers in the database. Returns two
-elements: a reference-to-array, which lists the borrower category
-codes, and a reference-to-hash, which maps the borrower category codes
-to category descriptions.
-
-=cut
-#'
-
-sub borrowercategories {
-    my $dbh = C4::Context->dbh;
-    my $sth=$dbh->prepare("Select categorycode,description from categories order by description");
-    $sth->execute;
-    my %labels;
-    my @codes;
-    while (my $data=$sth->fetchrow_hashref){
-      push @codes,$data->{'categorycode'};
-      $labels{$data->{'categorycode'}}=$data->{'description'};
-    }
-    $sth->finish;
-    return(\@codes,\%labels);
-}
-
-=item getborrowercategory
-
-  $description = &getborrowercategory($categorycode);
-
-Given the borrower's category code, the function returns the corresponding
-description for a comprehensive information display.
-
-=cut
-
-sub getborrowercategory
-{
-       my ($catcode) = @_;
-       my $dbh = C4::Context->dbh;
-       my $sth = $dbh->prepare("SELECT description FROM categories WHERE categorycode = ?");
-       $sth->execute($catcode);
-       my $description = $sth->fetchrow();
-       $sth->finish();
-       return $description;
-} # sub getborrowercategory
-
-
-=head2 ethnicitycategories
-
-  ($codes_arrayref, $labels_hashref) = &ethnicitycategories();
-
-Looks up the different ethnic types in the database. Returns two
-elements: a reference-to-array, which lists the ethnicity codes, and a
-reference-to-hash, which maps the ethnicity codes to ethnicity
-descriptions.
-
-=cut
-#'
-
-sub ethnicitycategories {
-    my $dbh = C4::Context->dbh;
-    my $sth=$dbh->prepare("Select code,name from ethnicity order by name");
-    $sth->execute;
-    my %labels;
-    my @codes;
-    while (my $data=$sth->fetchrow_hashref){
-      push @codes,$data->{'code'};
-      $labels{$data->{'code'}}=$data->{'name'};
-    }
-    $sth->finish;
-    return(\@codes,\%labels);
-}
-
 # FIXME.. this should be moved to a MARC-specific module
 sub subfield_is_koha_internal_p ($) {
     my($subfield) = @_;
@@ -242,6 +152,18 @@ sub getbranches {
        return (\%branches);
 }
 
+sub getbranchname {
+       my ($branchcode)=@_;
+       my $dbh = C4::Context->dbh;
+       my $sth;
+       $sth = $dbh->prepare("Select branchname from branches where branchcode=?");
+       $sth->execute($branchcode);
+       my $branchname = $sth->fetchrow_array;
+       $sth->finish;
+       
+       return($branchname);
+}
+
 =head2 getallbranches
 
   $branches = &getallbranches();
@@ -273,6 +195,7 @@ foreach my $thisbranch (keys %$branches) {
 
 =cut
 
+
 sub getallbranches {
 # returns a reference to a hash of references to ALL branches...
        my %branches;
@@ -300,6 +223,57 @@ sub getallbranches {
        return (\%branches);
 }
 
+=head2 getletters
+
+  $letters = &getletters($category);
+  returns informations about letters.
+  if needed, $category filters for letters given category
+  Create a letter selector with the following code
+  
+=head3 in PERL SCRIPT
+
+my $letters = getletters($cat);
+my @letterloop;
+foreach my $thisletter (keys %$letters) {
+       my $selected = 1 if $thisletter eq $letter;
+       my %row =(value => $thisletter,
+                               selected => $selected,
+                               lettername => $letters->{$thisletter},
+                       );
+       push @letterloop, \%row;
+}
+
+
+=head3 in TEMPLATE  
+                       <select name="letter">
+                               <option value="">Default</option>
+                       <!-- TMPL_LOOP name="letterloop" -->
+                               <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="lettername" --></option>
+                       <!-- /TMPL_LOOP -->
+                       </select>
+
+=cut
+
+sub getletters {
+# returns a reference to a hash of references to ALL letters...
+       my $cat =@_;
+       my %letters;
+       my $dbh = C4::Context->dbh;
+       my $sth;
+       if ($cat ne ""){
+               $sth = $dbh->prepare("Select * from letter where module = \'".$cat."\' order by name");
+       } else {
+               $sth = $dbh->prepare("Select * from letter order by name");
+       }
+       $sth->execute;
+       my $count;
+       while (my $letter=$sth->fetchrow_hashref) {
+                       $letters{$letter->{'code'}}=$letter->{'name'};
+                       $count++;
+       }
+       return ($count,\%letters);
+}
+
 =head2 getitemtypes
 
   $itemtypes = &getitemtypes();
@@ -350,6 +324,21 @@ sub getitemtypes {
        return (\%itemtypes);
 }
 
+# FIXME this function is better and should replace getitemtypes everywhere
+sub get_itemtypeinfos_of {
+    my @itemtypes = @_;
+
+    my $query = '
+SELECT itemtype,
+       description,
+       notforloan
+  FROM itemtypes
+  WHERE itemtype IN ('.join(',', map({"'".$_."'"} @itemtypes)).')
+';
+
+    return get_infos_of($query, 'itemtype');
+}
+
 =head2 getauthtypes
 
   $authtypes = &getauthtypes();
@@ -491,9 +480,41 @@ sub getitemtypeinfo {
        my $sth=$dbh->prepare("select * from itemtypes where itemtype=?");
        $sth->execute($itemtype);
        my $res = $sth->fetchrow_hashref;
+
+        $res->{imageurl} = getitemtypeimagesrcfromurl($res->{imageurl});
+
        return $res;
 }
 
+sub getitemtypeimagesrcfromurl {
+    my ($imageurl) = @_;
+
+    if (defined $imageurl and $imageurl !~ m/^http/) {
+        $imageurl =
+            getitemtypeimagesrc()
+            .'/'.$imageurl
+            ;
+    }
+
+    return $imageurl;
+}
+
+sub getitemtypeimagedir {
+    return
+        C4::Context->intrahtdocs
+        .'/'.C4::Context->preference('template')
+        .'/itemtypeimg'
+        ;
+}
+
+sub getitemtypeimagesrc {
+    return
+        '/intranet-tmpl'
+        .'/'.C4::Context->preference('template')
+        .'/itemtypeimg'
+        ;
+}
+
 =head2 getprinters
 
   $printers = &getprinters($env);
@@ -568,90 +589,102 @@ Returns an array of all available languages.
 =cut
 
 sub getalllanguages {
-    my $type=shift;
-    my $theme=shift;
-    my $htdocs;
-    my @languages;
-    if ($type eq 'opac') {
-       $htdocs=C4::Context->config('opachtdocs');
-       if ($theme and -d "$htdocs/$theme") {
-           opendir D, "$htdocs/$theme";
-           foreach my $language (readdir D) {
-               next if $language=~/^\./;
-               next if $language eq 'all';
-               next if $language=~ /png$/;
-               next if $language=~ /css$/;
-               push @languages, $language;
-           }
-           return sort @languages;
-       } else {
-           my $lang;
-           foreach my $theme (getallthemes('opac')) {
-               opendir D, "$htdocs/$theme";
-               foreach my $language (readdir D) {
-                   next if $language=~/^\./;
-                   next if $language eq 'all';
-                       next if $language=~ /png$/;
-                       next if $language=~ /css$/;
-                   $lang->{$language}=1;
+       my $type=shift;
+       my $theme=shift;
+       my $htdocs;
+       my @languages;
+       if ($type eq 'opac') {
+               $htdocs=C4::Context->config('opachtdocs');
+               if ($theme and -d "$htdocs/$theme") {
+                       opendir D, "$htdocs/$theme";
+                       foreach my $language (readdir D) {
+                               next if $language=~/^\./;
+                               next if $language eq 'all';
+                               next if $language=~ /png$/;
+                               next if $language=~ /css$/;
+                               next if $language=~ /CVS$/;
+                               next if $language=~ /itemtypeimg$/;
+                               push @languages, $language;
+                       }
+                       return sort @languages;
+               } else {
+                       my $lang;
+                       foreach my $theme (getallthemes('opac')) {
+                               opendir D, "$htdocs/$theme";
+                               foreach my $language (readdir D) {
+                                       next if $language=~/^\./;
+                                       next if $language eq 'all';
+                                       next if $language=~ /png$/;
+                                       next if $language=~ /css$/;
+                                       next if $language=~ /CVS$/;
+                                       next if $language=~ /itemtypeimg$/;
+                                       $lang->{$language}=1;
+                               }
+                       }
+                       @languages=keys %$lang;
+                       return sort @languages;
                }
-           }
-           @languages=keys %$lang;
-           return sort @languages;
-       }
-    } elsif ($type eq 'intranet') {
-       $htdocs=C4::Context->config('intrahtdocs');
-       if ($theme and -d "$htdocs/$theme") {
-           opendir D, "$htdocs/$theme";
-           foreach my $language (readdir D) {
-               next if $language=~/^\./;
-               next if $language eq 'all';
-               next if $language=~ /png$/;
-               next if $language=~ /css$/;
-               push @languages, $language;
-           }
-           return sort @languages;
-       } else {
-           my $lang;
-           foreach my $theme (getallthemes('opac')) {
+       } elsif ($type eq 'intranet') {
+               $htdocs=C4::Context->config('intrahtdocs');
+               if ($theme and -d "$htdocs/$theme") {
+                       opendir D, "$htdocs/$theme";
+                       foreach my $language (readdir D) {
+                               next if $language=~/^\./;
+                               next if $language eq 'all';
+                               next if $language=~ /png$/;
+                               next if $language=~ /css$/;
+                               next if $language=~ /CVS$/;
+                               next if $language=~ /itemtypeimg$/;
+                               push @languages, $language;
+                       }
+                       return sort @languages;
+               } else {
+                       my $lang;
+                       foreach my $theme (getallthemes('opac')) {
+                               opendir D, "$htdocs/$theme";
+                               foreach my $language (readdir D) {
+                                       next if $language=~/^\./;
+                                       next if $language eq 'all';
+                                       next if $language=~ /png$/;
+                                       next if $language=~ /css$/;
+                                       next if $language=~ /CVS$/;
+                                       next if $language=~ /itemtypeimg$/;
+                                       $lang->{$language}=1;
+                               }
+                       }
+                       @languages=keys %$lang;
+                       return sort @languages;
+               }
+    } else {
+               my $lang;
+               my $htdocs=C4::Context->config('intrahtdocs');
+               foreach my $theme (getallthemes('intranet')) {
+                       opendir D, "$htdocs/$theme";
+                       foreach my $language (readdir D) {
+                               next if $language=~/^\./;
+                               next if $language eq 'all';
+                               next if $language=~ /png$/;
+                               next if $language=~ /css$/;
+                               next if $language=~ /CVS$/;
+                               next if $language=~ /itemtypeimg$/;
+                               $lang->{$language}=1;
+                       }
+               }
+               $htdocs=C4::Context->config('opachtdocs');
+               foreach my $theme (getallthemes('opac')) {
                opendir D, "$htdocs/$theme";
                foreach my $language (readdir D) {
-                   next if $language=~/^\./;
-                   next if $language eq 'all';
+                       next if $language=~/^\./;
+                       next if $language eq 'all';
                        next if $language=~ /png$/;
                        next if $language=~ /css$/;
-                   $lang->{$language}=1;
+                       next if $language=~ /CVS$/;
+                       next if $language=~ /itemtypeimg$/;
+                       $lang->{$language}=1;
+                       }
                }
-           }
-           @languages=keys %$lang;
-           return sort @languages;
-       }
-    } else {
-       my $lang;
-       my $htdocs=C4::Context->config('intrahtdocs');
-       foreach my $theme (getallthemes('intranet')) {
-           opendir D, "$htdocs/$theme";
-           foreach my $language (readdir D) {
-               next if $language=~/^\./;
-               next if $language eq 'all';
-               next if $language=~ /png$/;
-               next if $language=~ /css$/;
-               $lang->{$language}=1;
-           }
-       }
-       $htdocs=C4::Context->config('opachtdocs');
-       foreach my $theme (getallthemes('opac')) {
-           opendir D, "$htdocs/$theme";
-           foreach my $language (readdir D) {
-               next if $language=~/^\./;
-               next if $language eq 'all';
-               next if $language=~ /png$/;
-               next if $language=~ /css$/;
-               $lang->{$language}=1;
-           }
-       }
-       @languages=keys %$lang;
-       return sort @languages;
+               @languages=keys %$lang;
+               return sort @languages;
     }
 }
 
@@ -681,6 +714,211 @@ sub getallthemes {
     return @themes;
 }
 
+=item getnbpages
+
+Returns the number of pages to display in a pagination bar, given the number
+of items and the number of items per page.
+
+=cut
+
+sub getnbpages {
+    my ($nb_items, $nb_items_per_page) = @_;
+
+    return int(($nb_items - 1) / $nb_items_per_page) + 1;
+}
+
+
+=head2 getcities (OUEST-PROVENCE)
+
+  ($id_cityarrayref, $city_hashref) = &getcities();
+
+Looks up the different city and zip in the database. Returns two
+elements: a reference-to-array, which lists the zip city
+codes, and a reference-to-hash, which maps the name of the city.
+WHERE =>OUEST PROVENCE OR EXTERIEUR
+
+=cut
+sub getcities {
+    #my ($type_city) = @_;
+    my $dbh = C4::Context->dbh;
+    my $sth=$dbh->prepare("Select cityid,city_name from cities order by cityid  ");
+    #$sth->execute($type_city);
+    $sth->execute();    
+    my %city;
+    my @id;
+#    insert empty value to create a empty choice in cgi popup 
+        
+while (my $data=$sth->fetchrow_hashref){
+      
+       push @id,$data->{'cityid'};
+      $city{$data->{'cityid'}}=$data->{'city_name'};
+    }
+       
+       #test to know if the table contain some records if no the function return nothing
+       my $id=@id;
+       $sth->finish;
+       if ($id eq 0)
+       {
+       return();
+       }
+       else{
+       unshift (@id ,"");
+       return(\@id,\%city);
+       }
+}
+
+
+=head2 getroadtypes (OUEST-PROVENCE)
+
+  ($idroadtypearrayref, $roadttype_hashref) = &getroadtypes();
+
+Looks up the different road type . Returns two
+elements: a reference-to-array, which lists the id_roadtype
+codes, and a reference-to-hash, which maps the road type of the road .
+
+
+=cut
+sub getroadtypes {
+    my $dbh = C4::Context->dbh;
+    my $sth=$dbh->prepare("Select roadtypeid,road_type from roadtype order by road_type  ");
+    $sth->execute();
+    my %roadtype;
+    my @id;
+#    insert empty value to create a empty choice in cgi popup 
+while (my $data=$sth->fetchrow_hashref){
+       push @id,$data->{'roadtypeid'};
+      $roadtype{$data->{'roadtypeid'}}=$data->{'road_type'};
+    }
+       #test to know if the table contain some records if no the function return nothing
+       my $id=@id;
+       $sth->finish;
+       if ($id eq 0)
+       {
+       return();
+       }
+       else{
+               unshift (@id ,"");
+               return(\@id,\%roadtype);
+       }
+}
+
+=head2 get_branchinfos_of
+
+  my $branchinfos_of = get_branchinfos_of(@branchcodes);
+
+Associates a list of branchcodes to the information of the branch, taken in
+branches table.
+
+Returns a href where keys are branchcodes and values are href where keys are
+branch information key.
+
+  print 'branchname is ', $branchinfos_of->{$code}->{branchname};
+
+=cut
+sub get_branchinfos_of {
+    my @branchcodes = @_;
+
+    my $query = '
+SELECT branchcode,
+       branchname
+  FROM branches
+  WHERE branchcode IN ('.join(',', map({"'".$_."'"} @branchcodes)).')
+';
+    return get_infos_of($query, 'branchcode');
+}
+
+=head2 get_notforloan_label_of
+
+  my $notforloan_label_of = get_notforloan_label_of();
+
+Each authorised value of notforloan (information available in items and
+itemtypes) is link to a single label.
+
+Returns a href where keys are authorised values and values are corresponding
+labels.
+
+  foreach my $authorised_value (keys %{$notforloan_label_of}) {
+    printf(
+        "authorised_value: %s => %s\n",
+        $authorised_value,
+        $notforloan_label_of->{$authorised_value}
+    );
+  }
+
+=cut
+sub get_notforloan_label_of {
+    my $dbh = C4::Context->dbh;
+
+    my $query = '
+SELECT authorised_value
+  FROM marc_subfield_structure
+  WHERE kohafield = \'items.notforloan\'
+  LIMIT 0, 1
+';
+    my $sth = $dbh->prepare($query);
+    $sth->execute();
+    my ($statuscode) = $sth->fetchrow_array();
+
+    $query = '
+SELECT lib,
+       authorised_value
+  FROM authorised_values
+  WHERE category = ?
+';
+    $sth = $dbh->prepare($query);
+    $sth->execute($statuscode);
+    my %notforloan_label_of;
+    while (my $row = $sth->fetchrow_hashref) {
+        $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
+    }
+    $sth->finish;
+
+    return \%notforloan_label_of;
+}
+
+=head2 get_infos_of
+
+Return a href where a key is associated to a href. You give a query, the
+name of the key among the fields returned by the query. If you also give as
+third argument the name of the value, the function returns a href of scalar.
+
+  my $query = '
+SELECT itemnumber,
+       notforloan,
+       barcode
+  FROM items
+';
+
+  # generic href of any information on the item, href of href.
+  my $iteminfos_of = get_infos_of($query, 'itemnumber');
+  print $iteminfos_of->{$itemnumber}{barcode};
+
+  # specific information, href of scalar
+  my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
+  print $barcode_of_item->{$itemnumber};
+
+=cut
+sub get_infos_of {
+    my ($query, $key_name, $value_name) = @_;
+
+    my $dbh = C4::Context->dbh;
+
+    my $sth = $dbh->prepare($query);
+    $sth->execute();
+
+    my %infos_of;
+    while (my $row = $sth->fetchrow_hashref) {
+        if (defined $value_name) {
+            $infos_of{ $row->{$key_name} } = $row->{$value_name};
+        }
+        else {
+            $infos_of{ $row->{$key_name} } = $row;
+        }
+    }
+    $sth->finish;
+
+    return \%infos_of;
+}
 
 1;
 __END__