Bug 2400 [11/18]: fixing pod syntax in C4/Labels.pm
[koha_fer] / C4 / Koha.pm
index f653271..687448d 100644 (file)
@@ -21,6 +21,7 @@ package C4::Koha;
 use strict;
 use C4::Context;
 use C4::Output;
+
 use vars qw($VERSION @ISA @EXPORT $DEBUG);
 
 BEGIN {
@@ -47,6 +48,7 @@ BEGIN {
                &getitemtypeimagedir
                &getitemtypeimagesrc
                &GetAuthorisedValues
+               &GetAuthorisedValueCategories
                &GetKohaAuthorisedValues
                &GetAuthValCode
                &GetManagedTagSubfields
@@ -71,9 +73,8 @@ BEGIN {
 
 =head1 FUNCTIONS
 
-=over 2
-
 =cut
+
 =head2 slashifyDate
 
   $slash_date = &slashifyDate($dash_date);
@@ -259,16 +260,17 @@ sub GetItemTypes {
 sub get_itemtypeinfos_of {
     my @itemtypes = @_;
 
-    my $query = '
+    my $placeholders = join( ', ', map { '?' } @itemtypes );
+    my $query = <<"END_SQL";
 SELECT itemtype,
        description,
        imageurl,
        notforloan
   FROM itemtypes
-  WHERE itemtype IN (' . join( ',', map( { "'" . $_ . "'" } @itemtypes ) ) . ')
-';
+  WHERE itemtype IN ( $placeholders )
+END_SQL
 
-    return get_infos_of( $query, 'itemtype' );
+    return get_infos_of( $query, 'itemtype', undef, \@itemtypes );
 }
 
 # this is temporary until we separate collection codes and item types
@@ -453,8 +455,26 @@ sub getitemtypeimagesrcfromurl {
     return $imageurl;
 }
 
+=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 {
        my $src = shift;
+        $src = 'opac' unless defined $src;
+
        if ($src eq 'intranet') {
                return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
        }
@@ -473,6 +493,119 @@ sub getitemtypeimagesrc {
        }
 }
 
+=head3 _getImagesFromDirectory
+
+  Find all of the image files in a directory in the filesystem
+
+  parameters:
+    a directory name
+
+  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.
+
+=cut
+
+sub _getImagesFromDirectory {
+    my $directoryname = shift;
+    return unless defined $directoryname;
+    return unless -d $directoryname;
+
+    if ( opendir ( my $dh, $directoryname ) ) {
+        my @images = grep { /\.(gif|png)$/i } readdir( $dh );
+        closedir $dh;
+        return @images;
+    } else {
+        warn "unable to opendir $directoryname: $!";
+        return;
+    }
+}
+
+=head3 _getSubdirectoryNames
+
+  Find all of the directories in a directory in the filesystem
+
+  parameters:
+    a directory name
+
+  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.
+
+=cut
+
+sub _getSubdirectoryNames {
+    my $directoryname = shift;
+    return unless defined $directoryname;
+    return unless -d $directoryname;
+
+    if ( opendir ( my $dh, $directoryname ) ) {
+        my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh );
+        closedir $dh;
+        return @directories;
+    } else {
+        warn "unable to opendir $directoryname: $!";
+        return;
+    }
+}
+
+=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.
+      }
+
+=cut
+
+sub getImageSets {
+    my %params = @_;
+    my $checked = $params{'checked'} || '';
+
+    my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'),
+                             url        => getitemtypeimagesrc('intranet'),
+                        },
+                  opac => { filesystem => getitemtypeimagedir('opac'),
+                             url       => getitemtypeimagesrc('opac'),
+                        }
+                  };
+
+    my @imagesets = (); # list of hasrefs of image set data to pass to template
+    my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} );
+
+    foreach my $imagesubdir ( @subdirectories ) {
+        my @imagelist     = (); # hashrefs of image info
+        my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
+        foreach my $thisimage ( @imagenames ) {
+            push( @imagelist,
+                  { KohaImage     => "$imagesubdir/$thisimage",
+                    StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ),
+                    OpacImageUrl  => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ),
+                    checked       => "$imagesubdir/$thisimage" eq $checked ? 1 : 0,
+               }
+             );
+        }
+        push @imagesets, { imagesetname => $imagesubdir,
+                           images       => \@imagelist };
+        
+    }
+    return \@imagesets;
+}
+
 =head2 GetPrinters
 
   $printers = &GetPrinters();
@@ -512,7 +645,7 @@ sub GetPrinter ($$) {
     return $printer;
 }
 
-=item getnbpages
+=head2 getnbpages
 
 Returns the number of pages to display in a pagination bar, given the number
 of items and the number of items per page.
@@ -525,7 +658,7 @@ sub getnbpages {
     return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
 }
 
-=item getallthemes
+=head2 getallthemes
 
   (@themes) = &getallthemes('opac');
   (@themes) = &getallthemes('intranet');
@@ -655,9 +788,12 @@ sub getFacets {
 
 =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.
+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. The optional 4th argument is an arrayref of
+items passed to the C<execute()> call. It is designed to bind
+parameters to any placeholders in your SQL.
 
   my $query = '
 SELECT itemnumber,
@@ -677,12 +813,12 @@ SELECT itemnumber,
 =cut
 
 sub get_infos_of {
-    my ( $query, $key_name, $value_name ) = @_;
+    my ( $query, $key_name, $value_name, $bind_params ) = @_;
 
     my $dbh = C4::Context->dbh;
 
     my $sth = $dbh->prepare($query);
-    $sth->execute();
+    $sth->execute( @$bind_params );
 
     my %infos_of;
     while ( my $row = $sth->fetchrow_hashref ) {
@@ -750,37 +886,73 @@ SELECT lib,
     return \%notforloan_label_of;
 }
 
+=head2 displayServers
+
+=over 4
+
+my $servers = displayServers();
+
+my $servers = displayServers( $position );
+
+my $servers = displayServers( $position, $type );
+
+=back
+
+displayServers returns a listref of hashrefs, each containing
+information about available z3950 servers. Each hashref has a format
+like:
+
+    {
+      'checked'    => 'checked',
+      'encoding'   => 'MARC-8'
+      'icon'       => undef,
+      'id'         => 'LIBRARY OF CONGRESS',
+      'label'      => '',
+      'name'       => 'server',
+      'opensearch' => '',
+      'value'      => 'z3950.loc.gov:7090/',
+      'zed'        => 1,
+    },
+
+
+=cut
+
 sub displayServers {
     my ( $position, $type ) = @_;
-    my $dbh    = C4::Context->dbh;
-    my $strsth = "SELECT * FROM z3950servers where 1";
-    $strsth .= " AND position=\"$position\"" if ($position);
-    $strsth .= " AND type=\"$type\""         if ($type);
+    my $dbh = C4::Context->dbh;
+
+    my $strsth = 'SELECT * FROM z3950servers';
+    my @where_clauses;
+    my @bind_params;
+
+    if ($position) {
+        push @bind_params,   $position;
+        push @where_clauses, ' position = ? ';
+    }
+
+    if ($type) {
+        push @bind_params,   $type;
+        push @where_clauses, ' type = ? ';
+    }
+
+    # reassemble where clause from where clause pieces
+    if (@where_clauses) {
+        $strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
+    }
+
     my $rq = $dbh->prepare($strsth);
-    $rq->execute;
+    $rq->execute(@bind_params);
     my @primaryserverloop;
 
     while ( my $data = $rq->fetchrow_hashref ) {
-        my %cell;
-        $cell{label} = $data->{'description'};
-        $cell{id}    = $data->{'name'};
-        $cell{value} =
-            $data->{host}
-          . ( $data->{port} ? ":" . $data->{port} : "" ) . "/"
-          . $data->{database}
-          if ( $data->{host} );
-        $cell{checked} = $data->{checked};
         push @primaryserverloop,
-          {
-            label => $data->{description},
-            id    => $data->{name},
-            name  => "server",
-            value => $data->{host} . ":"
-              . $data->{port} . "/"
-              . $data->{database},
-            encoding   => ($data->{encoding}?$data->{encoding}:"iso-5426"),
-            checked    => "checked",
-            icon       => $data->{icon},
+          { label    => $data->{description},
+            id       => $data->{name},
+            name     => "server",
+            value    => $data->{host} . ":" . $data->{port} . "/" . $data->{database},
+            encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ),
+            checked  => "checked",
+            icon     => $data->{icon},
             zed        => $data->{type} eq 'zed',
             opensearch => $data->{type} eq 'opensearch'
           };
@@ -850,28 +1022,51 @@ sub GetAuthorisedValues {
     return \@results; #$data;
 }
 
+=head2 GetAuthorisedValueCategories
+
+$auth_categories = GetAuthorisedValueCategories();
+
+Return an arrayref of all of the available authorised
+value categories.
+
+=cut
+
+sub GetAuthorisedValueCategories {
+    my $dbh = C4::Context->dbh;
+    my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category");
+    $sth->execute;
+    my @results;
+    while (my $category = $sth->fetchrow_array) {
+        push @results, $category;
+    }
+    return \@results;
+}
+
 =head2 GetKohaAuthorisedValues
        
-       Takes $dbh , $kohafield as parameters.
-       returns hashref of authvalCode => liblibrarian
-       or undef if no authvals defined for kohafield.
+       Takes $kohafield, $fwcode as parameters.
+       Returns hashref of Code => description
+       Returns undef 
+         if no authorised value category is defined for the kohafield.
 
 =cut
 
 sub GetKohaAuthorisedValues {
-  my ($kohafield,$fwcode) = @_;
+  my ($kohafield,$fwcode,$codedvalue) = @_;
   $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=? ");
-    $sth->execute($avcode);
+       my $sth = $dbh->prepare("select authorised_value, lib from authorised_values where category=? ");
+       $sth->execute($avcode);
        while ( my ($val, $lib) = $sth->fetchrow_array ) { 
                $values{$val}= $lib;
        }
+       return \%values;
+  } else {
+       return undef;
   }
-  return \%values;
 }
 
 =head2 GetManagedTagSubfields
@@ -917,6 +1112,30 @@ ORDER BY marc_subfield_structure.tagfield, tagsubfield|);
   return $data;
 }
 
+=head2 display_marc_indicators
+
+=over 4
+
+# field is a MARC::Field object
+my $display_form = C4::Koha::display_marc_indicators($field);
+
+=back
+
+Generate a display form of the indicators of a variable
+MARC field, replacing any blanks with '#'.
+
+=cut
+
+sub display_marc_indicators {
+    my $field = shift;
+    my $indicators = '';
+    if ($field->tag() >= 10) {
+        $indicators = $field->indicator(1) . $field->indicator(2);
+        $indicators =~ s/ /#/g;
+    }
+    return $indicators;
+}
+
 1;
 
 __END__