# 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);
+use Memoize;
use vars qw($VERSION @ISA @EXPORT $DEBUG);
&GetPrinters &GetPrinter
&GetItemTypes &getitemtypeinfo
&GetCcodes
+ &GetSupportName &GetSupportList
&get_itemtypeinfos_of
&getframeworks &getframeworkinfo
&getauthtypes &getauthtype
&getFacets
&displayServers
&getnbpages
- &getitemtypeimagesrcfromurl
&get_infos_of
&get_notforloan_label_of
&getitemtypeimagedir
&getitemtypeimagesrc
+ &getitemtypeimagelocation
&GetAuthorisedValues
&GetAuthorisedValueCategories
&GetKohaAuthorisedValues
+ &GetKohaAuthorisedValuesFromField
&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
+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
-=over 2
-
=cut
+
=head2 slashifyDate
$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
=head2 DisplayISBN
- my $string = DisplayISBN( $isbn );
+ my $string = DisplayISBN( $isbn );
=cut
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();
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|
=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>
</select>
<input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
<input type="submit" value="OK" class="button">
-</form>
+ </form>
=cut
=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" -->
</select>
<input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
<input type="submit" value="OK" class="button">
-</form>
-
+ </form>
=cut
$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
-
-=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;
-
+ 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
+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
=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
=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
=head2 GetPrinter
-$printer = GetPrinter( $query, $printers );
+ $printer = GetPrinter( $query, $printers );
=cut
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.
return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
}
-=item getallthemes
+=head2 getallthemes
(@themes) = &getallthemes('opac');
(@themes) = &getallthemes('intranet');
return \%notforloan_label_of;
}
+=head2 displayServers
+
+ 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
+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 $dbh = C4::Context->dbh;
my $strsth = 'SELECT * FROM z3950servers';
my @where_clauses;
my @bind_params;
- if ( $position ) {
- push @bind_params, $position;
+ if ($position) {
+ push @bind_params, $position;
push @where_clauses, ' position = ? ';
}
- if ( $type ) {
- push @bind_params, $type;
+ if ($type) {
+ push @bind_params, $type;
push @where_clauses, ' type = ? ';
}
- if ( @where_clauses ) {
+ # reassemble where clause from where clause pieces
+ if (@where_clauses) {
$strsth .= ' WHERE ' . join( ' AND ', @where_clauses );
}
my $rq = $dbh->prepare($strsth);
- $rq->execute( @bind_params );
+ $rq->execute(@bind_params);
my @primaryserverloop;
while ( my $data = $rq->fetchrow_hashref ) {
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'
};
return \@primaryserverloop;
}
-sub displaySecondaryServers {
-
-# my $secondary_servers_loop = [
-# { inner_sup_servers_loop => [
-# {label => "Google", id=>"GOOG", value=>"google",icon => "google.ico",opensearch => "1"},
-# {label => "Yahoo", id=>"YAH", value=>"yahoo", icon =>"yahoo.ico", zed => "1"},
-# {label => "Worldcat", id=>"WCT", value=>"worldcat", icon => "worldcat.gif", zed => "1"},
-# {label => "Library of Congress", id=>"LOC", name=> "server", value=>"z3950.loc.gov:7090/Voyager", icon =>"loc.ico", zed => "1"},
-# ],
-# },
-# ];
- return; #$secondary_servers_loop;
-}
-
=head2 GetAuthValCode
-$authvalcode = GetAuthValCode($kohafield,$frameworkcode);
+ $authvalcode = GetAuthValCode($kohafield,$frameworkcode);
=cut
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);
+ $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'authorised_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).
+
+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 $count = 0;
+ 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;
- }
- $results[$count] = $data;
- $count++;
+ 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;
=head2 GetAuthorisedValueCategories
-$auth_categories = GetAuthorisedValueCategories();
+ $auth_categories = GetAuthorisedValueCategories();
Return an arrayref of all of the available authorised
value categories.
}
=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 {
}
}
-=head2 GetManagedTagSubfields
-
-=over 4
-
-$res = GetManagedTagSubfields();
+=head2 GetKohaAuthorisedValuesFromField
-=back
+Takes $field, $subfield, $fwcode as parameters.
-Returns a reference to a big hash of hash, with the Marc structure fro the given frameworkcode
+If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist.
+$subfield can be undefined
-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.
+Returns hashref of Code => description
-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.
+Returns undef if no authorised value category is defined for the given field and subfield
=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;
+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
-=over 4
-
-# 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 '#'.
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__
projects / koha_fer / blobdiff