Correcting C4::VirtualShelves::ShelfPossibleAction to handle the case where the staff...
[koha_fer] / C4 / Koha.pm
index 40c3fcf..65822aa 100644 (file)
@@ -17,15 +17,46 @@ 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 C4::Output;
-our ($VERSION,@ISA,@EXPORT);
 
-$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
+use vars qw($VERSION @ISA @EXPORT $DEBUG);
+
+BEGIN {
+       $VERSION = 3.01;
+       require Exporter;
+       @ISA    = qw(Exporter);
+       @EXPORT = qw(
+               &slashifyDate
+               &DisplayISBN
+               &subfield_is_koha_internal_p
+               &GetPrinters &GetPrinter
+               &GetItemTypes &getitemtypeinfo
+               &GetCcodes
+               &get_itemtypeinfos_of
+               &getframeworks &getframeworkinfo
+               &getauthtypes &getauthtype
+               &getallthemes
+               &getFacets
+               &displayServers
+               &getnbpages
+               &getitemtypeimagesrcfromurl
+               &get_infos_of
+               &get_notforloan_label_of
+               &getitemtypeimagedir
+               &getitemtypeimagesrc
+               &GetAuthorisedValues
+               &GetAuthorisedValueCategories
+               &GetKohaAuthorisedValues
+               &GetAuthValCode
+               &GetManagedTagSubfields
+
+               $DEBUG
+       );
+       $DEBUG = 0;
+}
 
 =head1 NAME
 
@@ -45,39 +76,6 @@ $VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map
 =over 2
 
 =cut
-
-@ISA    = qw(Exporter);
-@EXPORT = qw(
-  &slashifyDate
-  &DisplayISBN
-  &subfield_is_koha_internal_p
-  &GetPrinters &GetPrinter
-  &GetItemTypes &getitemtypeinfo
-  &GetCcodes
-  &GetAuthItemlost
-  &GetAuthItembinding
-  &get_itemtypeinfos_of
-  &getframeworks &getframeworkinfo
-  &getauthtypes &getauthtype
-  &getallthemes
-  &getFacets
-  &displayServers
-  &getnbpages
-  &getitemtypeimagesrcfromurl
-  &get_infos_of
-  &get_notforloan_label_of
-  &getitemtypeimagedir
-  &getitemtypeimagesrc
-  &GetAuthorisedValues
-  &FixEncoding
-  &GetKohaAuthorisedValues
-  &GetManagedTagSubfields
-
-  $DEBUG
-  );
-
-my $DEBUG = 0;
-
 =head2 slashifyDate
 
   $slash_date = &slashifyDate($dash_date);
@@ -266,6 +264,7 @@ sub get_itemtypeinfos_of {
     my $query = '
 SELECT itemtype,
        description,
+       imageurl,
        notforloan
   FROM itemtypes
   WHERE itemtype IN (' . join( ',', map( { "'" . $_ . "'" } @itemtypes ) ) . ')
@@ -295,36 +294,6 @@ sub GetCcodes {
     return ( $count, @results );
 }
 
-=head2
-
-grab itemlost authorized values
-
-=cut
-
-sub GetAuthItemlost {
-    my $itemlost = shift;
-    my $count    = 0;
-    my @results;
-    my $dbh = C4::Context->dbh;
-    my $sth =
-      $dbh->prepare(
-        "SELECT * FROM authorised_values ORDER BY authorised_value");
-    $sth->execute;
-    while ( my $data = $sth->fetchrow_hashref ) {
-        if ( $data->{category} eq "ITEMLOST" ) {
-            $count++;
-            if ( $itemlost eq $data->{'authorised_value'} ) {
-                $data->{'selected'} = 1;
-            }
-            $results[$count] = $data;
-
-            #warn "data: $data";
-        }
-    }
-    $sth->finish;
-    return ( $count, @results );
-}
-
 =head2 getauthtypes
 
   $authtypes = &getauthtypes();
@@ -486,16 +455,155 @@ 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 {
-    return C4::Context->opachtdocs . '/'
-      . C4::Context->preference('template')
-      . '/itemtypeimg';
+       my $src = shift;
+        $src = 'opac' unless defined $src;
+
+       if ($src eq 'intranet') {
+               return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
+       }
+       else {
+               return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('template') . '/itemtypeimg';
+       }
 }
 
 sub getitemtypeimagesrc {
-    return '/opac-tmpl' . '/'
-      . C4::Context->preference('template')
-      . '/itemtypeimg';
+        my $src = shift;
+       if ($src eq 'intranet') {
+               return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
+       } 
+       else {
+               return '/opac-tmpl' . '/' . C4::Context->preference('template') . '/itemtypeimg';
+       }
+}
+
+=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
@@ -612,14 +720,18 @@ sub getFacets {
                 tags        => ['225'],
                 subfield    => 'a',
             },
-            {
+            ];
+
+            my $library_facet;
+
+            $library_facet = {
                 link_value  => 'branch',
-                label_value => 'Branches',
+                label_value => 'Libraries',
                 tags        => [ '995', ],
                 subfield    => 'b',
                 expanded    => '1',
-            },
-        ];
+            };
+            push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
     }
     else {
         $facets = [
@@ -660,14 +772,16 @@ sub getFacets {
                 tags        => [ '440', '490', ],
                 subfield    => 'a',
             },
-            {
+            ];
+            my $library_facet;
+            $library_facet = {
                 link_value  => 'branch',
-                label_value => 'Branches',
+                label_value => 'Libraries',
                 tags        => [ '952', ],
                 subfield    => 'b',
                 expanded    => '1',
-            },
-        ];
+            };
+            push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
     }
     return $facets;
 }
@@ -737,6 +851,8 @@ labels.
 
 =cut
 
+# FIXME - why not use GetAuthorisedValues ??
+#
 sub get_notforloan_label_of {
     my $dbh = C4::Context->dbh;
 
@@ -795,6 +911,7 @@ sub displayServers {
             value => $data->{host} . ":"
               . $data->{port} . "/"
               . $data->{database},
+            encoding   => ($data->{encoding}?$data->{encoding}:"iso-5426"),
             checked    => "checked",
             icon       => $data->{icon},
             zed        => $data->{type} eq 'zed',
@@ -818,6 +935,22 @@ sub displaySecondaryServers {
     return;    #$secondary_servers_loop;
 }
 
+=head2 GetAuthValCode
+
+$authvalcode = GetAuthValCode($kohafield,$frameworkcode);
+
+=cut
+
+sub GetAuthValCode {
+       my ($kohafield,$fwcode) = @_;
+       my $dbh = C4::Context->dbh;
+       $fwcode='' unless $fwcode;
+       my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?');
+       $sth->execute($kohafield,$fwcode);
+       my ($authvalcode) = $sth->fetchrow_array;
+       return $authvalcode;
+}
+
 =head2 GetAuthorisedValues
 
 $authvalues = GetAuthorisedValues($category);
@@ -830,91 +963,71 @@ Set C<$category> on input args if you want to limits your query to this one. Thi
 =cut
 
 sub GetAuthorisedValues {
-    my $category = shift;
+    my ($category,$selected) = @_;
+       my $count = 0;
+       my @results;
     my $dbh      = C4::Context->dbh;
     my $query    = "SELECT * FROM authorised_values";
     $query .= " WHERE category = '" . $category . "'" if $category;
 
     my $sth = $dbh->prepare($query);
     $sth->execute;
-    my $data = $sth->fetchall_arrayref({});
-    return $data;
+       while (my $data=$sth->fetchrow_hashref) {
+               if ($selected eq $data->{'authorised_value'} ) {
+                       $data->{'selected'} = 1;
+               }
+               $results[$count] = $data;
+               $count++;
+       }
+    #my $data = $sth->fetchall_arrayref({});
+    return \@results; #$data;
 }
 
-=item fixEncoding
+=head2 GetAuthorisedValueCategories
 
-  $marcrecord = &fixEncoding($marcblob);
+$auth_categories = GetAuthorisedValueCategories();
 
-Returns a well encoded marcrecord.
+Return an arrayref of all of the available authorised
+value categories.
 
 =cut
-sub FixEncoding {
-  my $marc=shift;
-  my $record = MARC::Record->new_from_usmarc($marc);
-  if (C4::Context->preference("MARCFLAVOUR") eq "UNIMARC"){
-    use Encode::Guess;
-    my $targetcharset="utf8" if (C4::Context->preference("TemplateEncoding") eq "utf-8");
-    $targetcharset="latin1" if (C4::Context->preference("TemplateEncoding") eq "iso-8859-1");
-    my $decoder = guess_encoding($marc, qw/utf8 latin1/);
-#     die $decoder unless ref($decoder);
-    if (ref($decoder)) {
-        my $newRecord=MARC::Record->new();
-        foreach my $field ($record->fields()){
-        if ($field->tag()<'010'){
-            $newRecord->insert_grouped_field($field);
-        } else {
-            my $newField;
-            my $createdfield=0;
-            foreach my $subfield ($field->subfields()){
-            if ($createdfield){
-                if (($newField->tag eq '100')) {
-                    substr($subfield->[1],26,2,"0103") if ($targetcharset eq "latin1");
-                    substr($subfield->[1],26,4,"5050") if ($targetcharset eq "utf8");
-                }
-                map {C4::Biblio::char_decode($_,"UNIMARC")} @$subfield;
-                $newField->add_subfields($subfield->[0]=>$subfield->[1]);
-            } else {
-                map {C4::Biblio::char_decode($_,"UNIMARC")} @$subfield;
-                $newField=MARC::Field->new($field->tag(),$field->indicator(1),$field->indicator(2),$subfield->[0]=>$subfield->[1]);
-                $createdfield=1;
-            }
-            }
-            $newRecord->insert_grouped_field($newField);
-        }
-        }
-    #     warn $newRecord->as_formatted(); 
-        return $newRecord;
-    } else {
-        return $record;
+
+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;
     }
-  } else {
-    return $record;
-  }
+    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) = @_;
+  my ($kohafield,$fwcode,$codedvalue) = @_;
+  $fwcode='' unless $fwcode;
   my %values;
   my $dbh = C4::Context->dbh;
-  my $sthnflstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=?');
-  $sthnflstatus->execute($kohafield);
-  my $authorised_valuecode = $sthnflstatus->fetchrow;
-  if ($authorised_valuecode) {  
-    $sthnflstatus = $dbh->prepare("select authorised_value, lib from authorised_values where category=? ");
-    $sthnflstatus->execute($authorised_valuecode);
-    while ( my ($val, $lib) = $sthnflstatus->fetchrow_array ) { 
-      $values{$val}= $lib;
-    }
+  my $avcode = GetAuthValCode($kohafield,$fwcode);
+  if ($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
@@ -923,13 +1036,18 @@ sub GetKohaAuthorisedValues {
 
 $res = GetManagedTagSubfields();
 
+=back
+
 Returns a reference to a big hash of hash, with the Marc structure fro the given frameworkcode
-$forlibrarian  :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
-$frameworkcode : the framework code to read
 
-=back
+NOTE: This function is used only by the (incomplete) bulk editing feature.  Since
+that feature currently does not deal with items and biblioitems changes 
+correctly, those tags are specifically excluded from the list prepared
+by this function.
 
-=back
+For future reference, if a bulk item editing feature is implemented at some point, it
+needs some design thought -- for example, circulation status fields should not 
+be changed willy-nilly.
 
 =cut
 
@@ -945,12 +1063,40 @@ FROM marc_subfield_structure
     ON marc_tag_structure.tagfield = marc_subfield_structure.tagfield
     AND marc_tag_structure.frameworkcode = marc_subfield_structure.frameworkcode
 WHERE marc_subfield_structure.tab>=0
-ORDER BY tagsubfield|);
+AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield like 'items.%')
+AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield = 'biblioitems.itemtype')
+AND marc_subfield_structure.kohafield <> 'biblio.biblionumber'
+AND marc_subfield_structure.kohafield <>  'biblioitems.biblioitemnumber'
+ORDER BY marc_subfield_structure.tagfield, tagsubfield|);
   $rq->execute;
   my $data=$rq->fetchall_arrayref({});
   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__