use Memoize to cache results of GetAuthorisedValues
[koha.git] / C4 / Koha.pm
index 846af3e..05e3074 100644 (file)
@@ -21,6 +21,8 @@ package C4::Koha;
 use strict;
 use C4::Context;
 use C4::Output;
+use URI::Split qw(uri_split);
+use Memoize;
 
 use vars qw($VERSION @ISA @EXPORT $DEBUG);
 
@@ -42,22 +44,28 @@ BEGIN {
                &getFacets
                &displayServers
                &getnbpages
-               &getitemtypeimagesrcfromurl
                &get_infos_of
                &get_notforloan_label_of
                &getitemtypeimagedir
                &getitemtypeimagesrc
+               &getitemtypeimagelocation
                &GetAuthorisedValues
                &GetAuthorisedValueCategories
                &GetKohaAuthorisedValues
                &GetAuthValCode
-               &GetManagedTagSubfields
+               &GetNormalizedUPC
+               &GetNormalizedISBN
+               &GetNormalizedEAN
+               &GetNormalizedOCLCNumber
 
                $DEBUG
        );
        $DEBUG = 0;
 }
 
+# expensive functions
+memoize('GetAuthorisedValues');
+
 =head1 NAME
 
     C4::Koha - Perl Module containing convenience functions for Koha scripts
@@ -73,9 +81,8 @@ BEGIN {
 
 =head1 FUNCTIONS
 
-=over 2
-
 =cut
+
 =head2 slashifyDate
 
   $slash_date = &slashifyDate($dash_date);
@@ -243,7 +250,7 @@ build a HTML select with the following code :
 
 sub GetItemTypes {
 
-    # returns a reference to a hash of references to branches...
+    # returns a reference to a hash of references to itemtypes...
     my %itemtypes;
     my $dbh   = C4::Context->dbh;
     my $query = qq|
@@ -441,21 +448,11 @@ sub getitemtypeinfo {
     $sth->execute($itemtype);
     my $res = $sth->fetchrow_hashref;
 
-    $res->{imageurl} = getitemtypeimagesrcfromurl( $res->{imageurl} );
+    $res->{imageurl} = getitemtypeimagelocation( 'intranet', $res->{imageurl} );
 
     return $res;
 }
 
-sub getitemtypeimagesrcfromurl {
-    my ($imageurl) = @_;
-
-    if ( defined $imageurl and $imageurl !~ m/^http/ ) {
-        $imageurl = getitemtypeimagesrc() . '/' . $imageurl;
-    }
-
-    return $imageurl;
-}
-
 =head2 getitemtypeimagedir
 
 =over
@@ -473,27 +470,35 @@ returns the full path to the appropriate directory containing images.
 =cut
 
 sub getitemtypeimagedir {
-       my $src = shift;
-        $src = 'opac' unless defined $src;
-
+       my $src = shift || 'opac';
        if ($src eq 'intranet') {
                return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
-       }
-       else {
+       } else {
                return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('template') . '/itemtypeimg';
        }
 }
 
 sub getitemtypeimagesrc {
-        my $src = shift;
+       my $src = shift || 'opac';
        if ($src eq 'intranet') {
                return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
-       } 
-       else {
+       } else {
                return '/opac-tmpl' . '/' . C4::Context->preference('template') . '/itemtypeimg';
        }
 }
 
+sub getitemtypeimagelocation($$) {
+       my ( $src, $image ) = @_;
+
+       return '' if ( !$image );
+
+       my $scheme = ( uri_split( $image ) )[0];
+
+       return $image if ( $scheme );
+
+       return getitemtypeimagesrc( $src ) . '/' . $image;
+}
+
 =head3 _getImagesFromDirectory
 
   Find all of the image files in a directory in the filesystem
@@ -646,7 +651,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.
@@ -659,7 +664,7 @@ sub getnbpages {
     return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
 }
 
-=item getallthemes
+=head2 getallthemes
 
   (@themes) = &getallthemes('opac');
   (@themes) = &getallthemes('intranet');
@@ -993,18 +998,16 @@ sub GetAuthValCode {
 
 =head2 GetAuthorisedValues
 
-$authvalues = GetAuthorisedValues($category);
+$authvalues = GetAuthorisedValues([$category], [$selected]);
 
-this function get all authorised values from 'authosied_value' table into a reference to array which
-each value containt an hashref.
+This function returns all authorised values from the'authosied_value' table in a reference to array of hashrefs.
 
-Set C<$category> on input args if you want to limits your query to this one. This params is not mandatory.
+C<$category> returns authorised values for just one category (optional).
 
 =cut
 
 sub GetAuthorisedValues {
     my ($category,$selected) = @_;
-       my $count = 0;
        my @results;
     my $dbh      = C4::Context->dbh;
     my $query    = "SELECT * FROM authorised_values";
@@ -1016,8 +1019,7 @@ sub GetAuthorisedValues {
                if ($selected eq $data->{'authorised_value'} ) {
                        $data->{'selected'} = 1;
                }
-               $results[$count] = $data;
-               $count++;
+        push @results, $data;
        }
     #my $data = $sth->fetchall_arrayref({});
     return \@results; #$data;
@@ -1070,49 +1072,6 @@ sub GetKohaAuthorisedValues {
   }
 }
 
-=head2 GetManagedTagSubfields
-
-=over 4
-
-$res = GetManagedTagSubfields();
-
-=back
-
-Returns a reference to a big hash of hash, with the Marc structure fro the given frameworkcode
-
-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.
-
-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
-
-sub GetManagedTagSubfields{
-  my $dbh=C4::Context->dbh;
-  my $rq=$dbh->prepare(qq|
-SELECT 
-  DISTINCT CONCAT( marc_subfield_structure.tagfield, tagsubfield ) AS tagsubfield, 
-  marc_subfield_structure.liblibrarian as subfielddesc, 
-  marc_tag_structure.liblibrarian as tagdesc
-FROM marc_subfield_structure
-  LEFT JOIN marc_tag_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
-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
@@ -1137,6 +1096,133 @@ sub display_marc_indicators {
     return $indicators;
 }
 
+sub GetNormalizedUPC {
+ my ($record,$marcflavour) = @_;
+    my (@fields,$upc);
+
+    if ($marcflavour eq 'MARC21') {
+        @fields = $record->field('024');
+        foreach my $field (@fields) {
+            my $indicator = $field->indicator(1);
+            my $upc = _normalize_match_point($field->subfield('a'));
+            if ($indicator == 1 and $upc ne '') {
+                return $upc;
+            }
+        }
+    }
+    else { # assume unimarc if not marc21
+        @fields = $record->field('072');
+        foreach my $field (@fields) {
+            my $upc = _normalize_match_point($field->subfield('a'));
+            if ($upc ne '') {
+                return $upc;
+            }
+        }
+    }
+}
+
+# Normalizes and returns the first valid ISBN found in the record
+sub GetNormalizedISBN {
+    my ($isbn,$record,$marcflavour) = @_;
+    my @fields;
+    if ($isbn) {
+        return _isbn_cleanup($isbn);
+    }
+    return undef unless $record;
+
+    if ($marcflavour eq 'MARC21') {
+        @fields = $record->field('020');
+        foreach my $field (@fields) {
+            $isbn = $field->subfield('a');
+            if ($isbn) {
+                return _isbn_cleanup($isbn);
+            } else {
+                return undef;
+            }
+        }
+    }
+    else { # assume unimarc if not marc21
+        @fields = $record->field('010');
+        foreach my $field (@fields) {
+            my $isbn = $field->subfield('a');
+            if ($isbn) {
+                return _isbn_cleanup($isbn);
+            } else {
+                return undef;
+            }
+        }
+    }
+
+}
+
+sub GetNormalizedEAN {
+    my ($record,$marcflavour) = @_;
+    my (@fields,$ean);
+
+    if ($marcflavour eq 'MARC21') {
+        @fields = $record->field('024');
+        foreach my $field (@fields) {
+            my $indicator = $field->indicator(1);
+            $ean = _normalize_match_point($field->subfield('a'));
+            if ($indicator == 3 and $ean ne '') {
+                return $ean;
+            }
+        }
+    }
+    else { # assume unimarc if not marc21
+        @fields = $record->field('073');
+        foreach my $field (@fields) {
+            $ean = _normalize_match_point($field->subfield('a'));
+            if ($ean ne '') {
+                return $ean;
+            }
+        }
+    }
+}
+sub GetNormalizedOCLCNumber {
+    my ($record,$marcflavour) = @_;
+    my (@fields,$oclc);
+
+    if ($marcflavour eq 'MARC21') {
+        @fields = $record->field('035');
+        foreach my $field (@fields) {
+            $oclc = $field->subfield('a');
+            if ($oclc =~ /OCoLC/) {
+                $oclc =~ s/\(OCoLC\)//;
+                return $oclc;
+            } else {
+                return undef;
+            }
+        }
+    }
+    else { # TODO: add UNIMARC fields
+    }
+}
+
+sub _normalize_match_point {
+    my $match_point = shift;
+    (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/;
+    $normalized_match_point =~ s/-//g;
+
+    return $normalized_match_point;
+}
+
+sub _isbn_cleanup ($) {
+    my $normalized_isbn = shift;
+    $normalized_isbn =~ s/-//g;
+    $normalized_isbn =~/([0-9x]{1,})/i;
+    $normalized_isbn = $1;
+    if (
+        $normalized_isbn =~ /\b(\d{13})\b/ or
+        $normalized_isbn =~ /\b(\d{12})\b/i or
+        $normalized_isbn =~ /\b(\d{10})\b/ or
+        $normalized_isbn =~ /\b(\d{9}X)\b/i
+    ) { 
+        return $1;
+    }
+    return undef;
+}
+
 1;
 
 __END__