Merge remote branch 'koha-fbc/k_bug_5182' into to-push
[koha_fer] / C4 / Koha.pm
index 730e3c6..cb93034 100644 (file)
@@ -13,12 +13,13 @@ package C4::Koha;
 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
 #
-# You should have received a copy of the GNU General Public License along with
-# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
-# Suite 330, Boston, MA  02111-1307 USA
+# You should have received a copy of the GNU General Public License along
+# with Koha; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 
 
 use strict;
+#use warnings; FIXME - Bug 2505
 use C4::Context;
 use C4::Output;
 use URI::Split qw(uri_split);
@@ -37,6 +38,7 @@ BEGIN {
                &GetPrinters &GetPrinter
                &GetItemTypes &getitemtypeinfo
                &GetCcodes
+               &GetSupportName &GetSupportList
                &get_itemtypeinfos_of
                &getframeworks &getframeworkinfo
                &getauthtypes &getauthtype
@@ -52,6 +54,7 @@ BEGIN {
                &GetAuthorisedValues
                &GetAuthorisedValueCategories
                &GetKohaAuthorisedValues
+               &GetKohaAuthorisedValuesFromField
                &GetAuthValCode
                &GetNormalizedUPC
                &GetNormalizedISBN
@@ -68,16 +71,15 @@ memoize('GetAuthorisedValues');
 
 =head1 NAME
 
-    C4::Koha - Perl Module containing convenience functions for Koha scripts
+C4::Koha - Perl Module containing convenience functions for Koha scripts
 
 =head1 SYNOPSIS
 
-  use C4::Koha;
-
+use C4::Koha;
 
 =head1 DESCRIPTION
 
-    Koha.pm provides many functions for Koha scripts.
+Koha.pm provides many functions for Koha scripts.
 
 =head1 FUNCTIONS
 
@@ -87,8 +89,8 @@ memoize('GetAuthorisedValues');
 
   $slash_date = &slashifyDate($dash_date);
 
-    Takes a string of the form "DD-MM-YYYY" (or anything separated by
-    dashes), converts it to the form "YYYY/MM/DD", and returns the result.
+Takes a string of the form "DD-MM-YYYY" (or anything separated by
+dashes), converts it to the form "YYYY/MM/DD", and returns the result.
 
 =cut
 
@@ -103,7 +105,7 @@ sub slashifyDate {
 
 =head2 DisplayISBN
 
-    my $string = DisplayISBN( $isbn );
+  my $string = DisplayISBN( $isbn );
 
 =cut
 
@@ -211,6 +213,86 @@ sub subfield_is_koha_internal_p ($) {
     return length $subfield != 1;
 }
 
+=head2 GetSupportName
+
+  $itemtypename = &GetSupportName($codestring);
+
+Returns a string with the name of the itemtype.
+
+=cut
+
+sub GetSupportName{
+       my ($codestring)=@_;
+       return if (! $codestring); 
+       my $resultstring;
+       my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
+       if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {  
+               my $query = qq|
+                       SELECT description
+                       FROM   itemtypes
+                       WHERE itemtype=?
+                       order by description
+               |;
+               my $sth = C4::Context->dbh->prepare($query);
+               $sth->execute($codestring);
+               ($resultstring)=$sth->fetchrow;
+               return $resultstring;
+       } else {
+        my $sth =
+            C4::Context->dbh->prepare(
+                    "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
+                    );
+        $sth->execute( $advanced_search_types, $codestring );
+        my $data = $sth->fetchrow_hashref;
+        return $$data{'lib'};
+       }
+
+}
+=head2 GetSupportList
+
+  $itemtypes = &GetSupportList();
+
+Returns an array ref containing informations about Support (since itemtype is rather a circulation code when item-level-itypes is used).
+
+build a HTML select with the following code :
+
+=head3 in PERL SCRIPT
+
+    my $itemtypes = GetSupportList();
+    $template->param(itemtypeloop => $itemtypes);
+
+=head3 in TEMPLATE
+
+    <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
+        <select name="itemtype">
+            <option value="">Default</option>
+        <!-- TMPL_LOOP name="itemtypeloop" -->
+            <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>
+        <!-- /TMPL_LOOP -->
+        </select>
+        <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
+        <input type="submit" value="OK" class="button">
+    </form>
+
+=cut
+
+sub GetSupportList{
+       my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
+       if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {  
+               my $query = qq|
+                       SELECT *
+                       FROM   itemtypes
+                       order by description
+               |;
+               my $sth = C4::Context->dbh->prepare($query);
+               $sth->execute;
+               return $sth->fetchall_arrayref({});
+       } else {
+               my $advsearchtypes = GetAuthorisedValues($advanced_search_types);
+               my @results= map {{itemtype=>$$_{authorised_value},description=>$$_{lib},imageurl=>$$_{imageurl}}} @$advsearchtypes;
+               return \@results;
+       }
+}
 =head2 GetItemTypes
 
   $itemtypes = &GetItemTypes();
@@ -312,21 +394,21 @@ build a HTML select with the following code :
 
 =head3 in PERL SCRIPT
 
-my $authtypes = getauthtypes;
-my @authtypesloop;
-foreach my $thisauthtype (keys %$authtypes) {
-    my $selected = 1 if $thisauthtype eq $authtype;
-    my %row =(value => $thisauthtype,
+   my $authtypes = getauthtypes;
+   my @authtypesloop;
+   foreach my $thisauthtype (keys %$authtypes) {
+       my $selected = 1 if $thisauthtype eq $authtype;
+       my %row =(value => $thisauthtype,
                 selected => $selected,
                 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
             );
-    push @authtypesloop, \%row;
-}
-$template->param(itemtypeloop => \@itemtypesloop);
+        push @authtypesloop, \%row;
+    }
+    $template->param(itemtypeloop => \@itemtypesloop);
 
 =head3 in TEMPLATE
 
-<form action='<!-- TMPL_VAR name="script_name" -->' method=post>
+  <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
     <select name="authtype">
     <!-- TMPL_LOOP name="authtypeloop" -->
         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
@@ -334,7 +416,7 @@ $template->param(itemtypeloop => \@itemtypesloop);
     </select>
     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
     <input type="submit" value="OK" class="button">
-</form>
+  </form>
 
 
 =cut
@@ -374,21 +456,21 @@ build a HTML select with the following code :
 
 =head3 in PERL SCRIPT
 
-my $frameworks = frameworks();
-my @frameworkloop;
-foreach my $thisframework (keys %$frameworks) {
+  my $frameworks = frameworks();
+  my @frameworkloop;
+  foreach my $thisframework (keys %$frameworks) {
     my $selected = 1 if $thisframework eq $frameworkcode;
     my %row =(value => $thisframework,
                 selected => $selected,
                 description => $frameworks->{$thisframework}->{'frameworktext'},
             );
     push @frameworksloop, \%row;
-}
-$template->param(frameworkloop => \@frameworksloop);
+  }
+  $template->param(frameworkloop => \@frameworksloop);
 
 =head3 in TEMPLATE
 
-<form action='<!-- TMPL_VAR name="script_name" -->' method=post>
+  <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
     <select name="frameworkcode">
         <option value="">Default</option>
     <!-- TMPL_LOOP name="frameworkloop" -->
@@ -397,8 +479,7 @@ $template->param(frameworkloop => \@frameworksloop);
     </select>
     <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
     <input type="submit" value="OK" class="button">
-</form>
-
+  </form>
 
 =cut
 
@@ -455,18 +536,12 @@ sub getitemtypeinfo {
 
 =head2 getitemtypeimagedir
 
-=over
-
-=item 4
-
   my $directory = getitemtypeimagedir( 'opac' );
 
 pass in 'opac' or 'intranet'. Defaults to 'opac'.
 
 returns the full path to the appropriate directory containing images.
 
-=back
-
 =cut
 
 sub getitemtypeimagedir {
@@ -501,17 +576,16 @@ sub getitemtypeimagelocation($$) {
 
 =head3 _getImagesFromDirectory
 
-  Find all of the image files in a directory in the filesystem
+Find all of the image files in a directory in the filesystem
 
-  parameters:
-    a directory name
+parameters: a directory name
 
-  returns: a list of images in that directory.
+returns: a list of images in that directory.
 
-  Notes: this does not traverse into subdirectories. See
-      _getSubdirectoryNames for help with that.
-    Images are assumed to be files with .gif or .png file extensions.
-    The image names returned do not have the directory name on them.
+Notes: this does not traverse into subdirectories. See
+_getSubdirectoryNames for help with that.
+Images are assumed to be files with .gif or .png file extensions.
+The image names returned do not have the directory name on them.
 
 =cut
 
@@ -532,17 +606,15 @@ sub _getImagesFromDirectory {
 
 =head3 _getSubdirectoryNames
 
-  Find all of the directories in a directory in the filesystem
+Find all of the directories in a directory in the filesystem
 
-  parameters:
-    a directory name
+parameters: a directory name
 
-  returns: a list of subdirectories in that directory.
+returns: a list of subdirectories in that directory.
 
-  Notes: this does not traverse into subdirectories. Only the first
-      level of subdirectories are returned.
-    The directory names returned don't have the parent directory name
-      on them.
+Notes: this does not traverse into subdirectories. Only the first
+level of subdirectories are returned.
+The directory names returned don't have the parent directory name on them.
 
 =cut
 
@@ -563,18 +635,20 @@ sub _getSubdirectoryNames {
 
 =head3 getImageSets
 
-  returns: a listref of hashrefs. Each hash represents another collection of images.
-           { imagesetname => 'npl', # the name of the image set (npl is the original one)
-             images => listref of image hashrefs
-           }
-
-    each image is represented by a hashref like this:
-      { KohaImage     => 'npl/image.gif',
-        StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
-        OpacImageURL  => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
-        checked       => 0 or 1: was this the image passed to this method?
-                         Note: I'd like to remove this somehow.
-      }
+returns: a listref of hashrefs. Each hash represents another collection of images.
+
+ { imagesetname => 'npl', # the name of the image set (npl is the original one)
+         images => listref of image hashrefs
+ }
+
+each image is represented by a hashref like this:
+
+ { KohaImage     => 'npl/image.gif',
+   StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif',
+   OpacImageURL  => '/opac-tmpl/prog/itemtypeimg/npl/image.gif'
+   checked       => 0 or 1: was this the image passed to this method?
+                    Note: I'd like to remove this somehow.
+ }
 
 =cut
 
@@ -638,7 +712,7 @@ sub GetPrinters {
 
 =head2 GetPrinter
 
-$printer = GetPrinter( $query, $printers );
+  $printer = GetPrinter( $query, $printers );
 
 =cut
 
@@ -894,15 +968,9 @@ SELECT lib,
 
 =head2 displayServers
 
-=over 4
-
-my $servers = displayServers();
-
-my $servers = displayServers( $position );
-
-my $servers = displayServers( $position, $type );
-
-=back
+   my $servers = displayServers();
+   my $servers = displayServers( $position );
+   my $servers = displayServers( $position, $type );
 
 displayServers returns a listref of hashrefs, each containing
 information about available z3950 servers. Each hashref has a format
@@ -920,7 +988,6 @@ like:
       'zed'        => 1,
     },
 
-
 =cut
 
 sub displayServers {
@@ -968,7 +1035,7 @@ sub displayServers {
 
 =head2 GetAuthValCode
 
-$authvalcode = GetAuthValCode($kohafield,$frameworkcode);
+  $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
 
 =cut
 
@@ -982,30 +1049,59 @@ sub GetAuthValCode {
        return $authvalcode;
 }
 
+=head2 GetAuthValCodeFromField
+
+  $authvalcode = GetAuthValCodeFromField($field,$subfield,$frameworkcode);
+
+C<$subfield> can be undefined
+
+=cut
+
+sub GetAuthValCodeFromField {
+       my ($field,$subfield,$fwcode) = @_;
+       my $dbh = C4::Context->dbh;
+       $fwcode='' unless $fwcode;
+       my $sth;
+       if (defined $subfield) {
+           $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?');
+           $sth->execute($field,$subfield,$fwcode);
+       } else {
+           $sth = $dbh->prepare('select authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?');
+           $sth->execute($field,$fwcode);
+       }
+       my ($authvalcode) = $sth->fetchrow_array;
+       return $authvalcode;
+}
+
 =head2 GetAuthorisedValues
 
-$authvalues = GetAuthorisedValues([$category], [$selected]);
+  $authvalues = GetAuthorisedValues([$category], [$selected]);
 
-This function returns all authorised values from the'authosied_value' table in a reference to array of hashrefs.
+This function returns all authorised values from the'authorised_value' table in a reference to array of hashrefs.
 
 C<$category> returns authorised values for just one category (optional).
 
+C<$opac> If set to a true value, displays OPAC descriptions rather than normal ones when they exist.
+
 =cut
 
 sub GetAuthorisedValues {
-    my ($category,$selected) = @_;
+    my ($category,$selected,$opac) = @_;
        my @results;
     my $dbh      = C4::Context->dbh;
     my $query    = "SELECT * FROM authorised_values";
     $query .= " WHERE category = '" . $category . "'" if $category;
-
+    $query .= " ORDER BY category, lib, lib_opac";
     my $sth = $dbh->prepare($query);
     $sth->execute;
        while (my $data=$sth->fetchrow_hashref) {
-               if ($selected eq $data->{'authorised_value'} ) {
-                       $data->{'selected'} = 1;
-               }
-        push @results, $data;
+           if ($selected && $selected eq $data->{'authorised_value'} ) {
+                   $data->{'selected'} = 1;
+           }
+           if ($opac && $data->{'lib_opac'}) {
+               $data->{'lib'} = $data->{'lib_opac'};
+           }
+           push @results, $data;
        }
     #my $data = $sth->fetchall_arrayref({});
     return \@results; #$data;
@@ -1013,7 +1109,7 @@ sub GetAuthorisedValues {
 
 =head2 GetAuthorisedValueCategories
 
-$auth_categories = GetAuthorisedValueCategories();
+  $auth_categories = GetAuthorisedValueCategories();
 
 Return an arrayref of all of the available authorised
 value categories.
@@ -1032,25 +1128,28 @@ sub GetAuthorisedValueCategories {
 }
 
 =head2 GetKohaAuthorisedValues
-       
-       Takes $kohafield, $fwcode as parameters.
-       Returns hashref of Code => description
-       Returns undef 
-         if no authorised value category is defined for the kohafield.
+
+Takes $kohafield, $fwcode as parameters.
+
+If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
+
+Returns hashref of Code => description
+
+Returns undef if no authorised value category is defined for the kohafield.
 
 =cut
 
 sub GetKohaAuthorisedValues {
-  my ($kohafield,$fwcode,$codedvalue) = @_;
+  my ($kohafield,$fwcode,$opac) = @_;
   $fwcode='' unless $fwcode;
   my %values;
   my $dbh = C4::Context->dbh;
   my $avcode = GetAuthValCode($kohafield,$fwcode);
   if ($avcode) {  
-       my $sth = $dbh->prepare("select authorised_value, lib from authorised_values where category=? ");
+       my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
        $sth->execute($avcode);
-       while ( my ($val, $lib) = $sth->fetchrow_array ) { 
-               $values{$val}= $lib;
+       while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) { 
+               $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
        }
        return \%values;
   } else {
@@ -1058,14 +1157,42 @@ sub GetKohaAuthorisedValues {
   }
 }
 
-=head2 display_marc_indicators
+=head2 GetKohaAuthorisedValuesFromField
+
+Takes $field, $subfield, $fwcode as parameters.
+
+If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
+$subfield can be undefined
 
-=over 4
+Returns hashref of Code => description
+
+Returns undef if no authorised value category is defined for the given field and subfield 
+
+=cut
+
+sub GetKohaAuthorisedValuesFromField {
+  my ($field, $subfield, $fwcode,$opac) = @_;
+  $fwcode='' unless $fwcode;
+  my %values;
+  my $dbh = C4::Context->dbh;
+  my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
+  if ($avcode) {  
+       my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
+       $sth->execute($avcode);
+       while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) { 
+               $values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
+       }
+       return \%values;
+  } else {
+       return undef;
+  }
+}
+
+=head2 display_marc_indicators
 
-# field is a MARC::Field object
-my $display_form = C4::Koha::display_marc_indicators($field);
+  my $display_form = C4::Koha::display_marc_indicators($field);
 
-=back
+C<$field> is a MARC::Field object
 
 Generate a display form of the indicators of a variable
 MARC field, replacing any blanks with '#'.