AuthoritiesMarc.pm Improvements
[koha.git] / C4 / Koha.pm
index 401dd9c..3589010 100644 (file)
@@ -21,6 +21,7 @@ package C4::Koha;
 use strict;
 use C4::Context;
 use C4::Output;
+use URI::Split qw(uri_split);
 
 use vars qw($VERSION @ISA @EXPORT $DEBUG);
 
@@ -42,17 +43,19 @@ 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;
@@ -73,9 +76,8 @@ BEGIN {
 
 =head1 FUNCTIONS
 
-=over 2
-
 =cut
+
 =head2 slashifyDate
 
   $slash_date = &slashifyDate($dash_date);
@@ -243,7 +245,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 +443,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 +465,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 +646,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 +659,7 @@ sub getnbpages {
     return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
 }
 
-=item getallthemes
+=head2 getallthemes
 
   (@themes) = &getallthemes('opac');
   (@themes) = &getallthemes('intranet');
@@ -887,37 +887,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'
           };
@@ -957,18 +993,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";
@@ -980,8 +1014,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;
@@ -1034,49 +1067,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
@@ -1101,6 +1091,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__