X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FKoha.pm;h=2bdcc284b8f40e2efc6ff263f47c60e6628d76d9;hb=2c470899b3f0191b9597d713e895b9240fe1d137;hp=401dd9c9859f65ce124897381856eccc8d964aae;hpb=8b679f8d814974f5ddd4a410474267af2fa30fe5;p=koha_gimpoz diff --git a/C4/Koha.pm b/C4/Koha.pm index 401dd9c985..2bdcc284b8 100644 --- a/C4/Koha.pm +++ b/C4/Koha.pm @@ -1,6 +1,7 @@ package C4::Koha; # Copyright 2000-2002 Katipo Communications +# Parts Copyright 2010 Nelsonville Public Library # # This file is part of Koha. # @@ -13,14 +14,18 @@ package C4::Koha; # 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 Business::ISBN; use vars qw($VERSION @ISA @EXPORT $DEBUG); @@ -30,11 +35,11 @@ BEGIN { @ISA = qw(Exporter); @EXPORT = qw( &slashifyDate - &DisplayISBN &subfield_is_koha_internal_p &GetPrinters &GetPrinter &GetItemTypes &getitemtypeinfo &GetCcodes + &GetSupportName &GetSupportList &get_itemtypeinfos_of &getframeworks &getframeworkinfo &getauthtypes &getauthtype @@ -42,46 +47,53 @@ BEGIN { &getFacets &displayServers &getnbpages - &getitemtypeimagesrcfromurl &get_infos_of &get_notforloan_label_of &getitemtypeimagedir &getitemtypeimagesrc + &getitemtypeimagelocation &GetAuthorisedValues &GetAuthorisedValueCategories &GetKohaAuthorisedValues + &GetKohaAuthorisedValuesFromField + &GetKohaAuthorisedValueLib &GetAuthValCode - &GetManagedTagSubfields + &GetNormalizedUPC + &GetNormalizedISBN + &GetNormalizedEAN + &GetNormalizedOCLCNumber + &xml_escape $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 @@ -93,106 +105,6 @@ sub slashifyDate { return ("$dateOut[2]/$dateOut[1]/$dateOut[0]"); } - -=head2 DisplayISBN - - my $string = DisplayISBN( $isbn ); - -=cut - -sub DisplayISBN { - my ($isbn) = @_; - if (length ($isbn)<13){ - my $seg1; - if ( substr( $isbn, 0, 1 ) <= 7 ) { - $seg1 = substr( $isbn, 0, 1 ); - } - elsif ( substr( $isbn, 0, 2 ) <= 94 ) { - $seg1 = substr( $isbn, 0, 2 ); - } - elsif ( substr( $isbn, 0, 3 ) <= 995 ) { - $seg1 = substr( $isbn, 0, 3 ); - } - elsif ( substr( $isbn, 0, 4 ) <= 9989 ) { - $seg1 = substr( $isbn, 0, 4 ); - } - else { - $seg1 = substr( $isbn, 0, 5 ); - } - my $x = substr( $isbn, length($seg1) ); - my $seg2; - if ( substr( $x, 0, 2 ) <= 19 ) { - - # if(sTmp2 < 10) sTmp2 = "0" sTmp2; - $seg2 = substr( $x, 0, 2 ); - } - elsif ( substr( $x, 0, 3 ) <= 699 ) { - $seg2 = substr( $x, 0, 3 ); - } - elsif ( substr( $x, 0, 4 ) <= 8399 ) { - $seg2 = substr( $x, 0, 4 ); - } - elsif ( substr( $x, 0, 5 ) <= 89999 ) { - $seg2 = substr( $x, 0, 5 ); - } - elsif ( substr( $x, 0, 6 ) <= 9499999 ) { - $seg2 = substr( $x, 0, 6 ); - } - else { - $seg2 = substr( $x, 0, 7 ); - } - my $seg3 = substr( $x, length($seg2) ); - $seg3 = substr( $seg3, 0, length($seg3) - 1 ); - my $seg4 = substr( $x, -1, 1 ); - return "$seg1-$seg2-$seg3-$seg4"; - } else { - my $seg1; - $seg1 = substr( $isbn, 0, 3 ); - my $seg2; - if ( substr( $isbn, 3, 1 ) <= 7 ) { - $seg2 = substr( $isbn, 3, 1 ); - } - elsif ( substr( $isbn, 3, 2 ) <= 94 ) { - $seg2 = substr( $isbn, 3, 2 ); - } - elsif ( substr( $isbn, 3, 3 ) <= 995 ) { - $seg2 = substr( $isbn, 3, 3 ); - } - elsif ( substr( $isbn, 3, 4 ) <= 9989 ) { - $seg2 = substr( $isbn, 3, 4 ); - } - else { - $seg2 = substr( $isbn, 3, 5 ); - } - my $x = substr( $isbn, length($seg2) +3); - my $seg3; - if ( substr( $x, 0, 2 ) <= 19 ) { - - # if(sTmp2 < 10) sTmp2 = "0" sTmp2; - $seg3 = substr( $x, 0, 2 ); - } - elsif ( substr( $x, 0, 3 ) <= 699 ) { - $seg3 = substr( $x, 0, 3 ); - } - elsif ( substr( $x, 0, 4 ) <= 8399 ) { - $seg3 = substr( $x, 0, 4 ); - } - elsif ( substr( $x, 0, 5 ) <= 89999 ) { - $seg3 = substr( $x, 0, 5 ); - } - elsif ( substr( $x, 0, 6 ) <= 9499999 ) { - $seg3 = substr( $x, 0, 6 ); - } - else { - $seg3 = substr( $x, 0, 7 ); - } - my $seg4 = substr( $x, length($seg3) ); - $seg4 = substr( $seg4, 0, length($seg4) - 1 ); - my $seg5 = substr( $x, -1, 1 ); - return "$seg1-$seg2-$seg3-$seg4-$seg5"; - } -} - # FIXME.. this should be moved to a MARC-specific module sub subfield_is_koha_internal_p ($) { my ($subfield) = @_; @@ -204,6 +116,86 @@ sub subfield_is_koha_internal_p ($) { 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 + +
+ + "> + +
+ +=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(); @@ -243,7 +235,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| @@ -305,21 +297,21 @@ build a HTML select with the following code : =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 -
+ "> -
+ =cut @@ -367,21 +359,21 @@ build a HTML select with the following code : =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 -
+ "> -
- + =cut @@ -441,72 +432,63 @@ 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 - -=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 @@ -518,6 +500,7 @@ sub _getImagesFromDirectory { if ( opendir ( my $dh, $directoryname ) ) { my @images = grep { /\.(gif|png)$/i } readdir( $dh ); closedir $dh; + @images = sort(@images); return @images; } else { warn "unable to opendir $directoryname: $!"; @@ -527,17 +510,15 @@ sub _getImagesFromDirectory { =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 @@ -558,18 +539,20 @@ sub _getSubdirectoryNames { =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 - } +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: - 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. - } + { 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 @@ -587,10 +570,12 @@ sub getImageSets { my @imagesets = (); # list of hasrefs of image set data to pass to template my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} ); - +warn $paths->{'staff'}{'filesystem'}; foreach my $imagesubdir ( @subdirectories ) { + warn $imagesubdir; my @imagelist = (); # hashrefs of image info my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) ); + my $imagesetactive = 0; foreach my $thisimage ( @imagenames ) { push( @imagelist, { KohaImage => "$imagesubdir/$thisimage", @@ -599,8 +584,10 @@ sub getImageSets { checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0, } ); + $imagesetactive = 1 if "$imagesubdir/$thisimage" eq $checked; } push @imagesets, { imagesetname => $imagesubdir, + imagesetactive => $imagesetactive, images => \@imagelist }; } @@ -633,7 +620,7 @@ sub GetPrinters { =head2 GetPrinter -$printer = GetPrinter( $query, $printers ); + $printer = GetPrinter( $query, $printers ); =cut @@ -646,7 +633,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 +646,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 +874,66 @@ SELECT lib, 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 $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' }; @@ -925,23 +941,9 @@ sub displayServers { 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 @@ -955,33 +957,59 @@ sub GetAuthValCode { 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; @@ -989,7 +1017,7 @@ sub GetAuthorisedValues { =head2 GetAuthorisedValueCategories -$auth_categories = GetAuthorisedValueCategories(); + $auth_categories = GetAuthorisedValueCategories(); Return an arrayref of all of the available authorised value categories. @@ -1008,25 +1036,28 @@ sub GetAuthorisedValueCategories { } =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 { @@ -1034,57 +1065,82 @@ sub GetKohaAuthorisedValues { } } -=head2 GetManagedTagSubfields +=head2 GetKohaAuthorisedValuesFromField -=over 4 +Takes $field, $subfield, $fwcode as parameters. -$res = GetManagedTagSubfields(); +If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist. +$subfield can be undefined -=back +Returns hashref of Code => description -Returns a reference to a big hash of hash, with the Marc structure fro the given frameworkcode +Returns undef if no authorised value category is defined for the given field and subfield + +=cut -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. +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; + } +} -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. +=head2 xml_escape + + my $escaped_string = C4::Koha::xml_escape($string); + +Convert &, <, >, ', and " in a string to XML entities =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 xml_escape { + my $str = shift; + return '' unless defined $str; + $str =~ s/&/&/g; + $str =~ s//>/g; + $str =~ s/'/'/g; + $str =~ s/"/"/g; + return $str; } -=head2 display_marc_indicators +=head2 GetKohaAuthorisedValueLib + +Takes $category, $authorised_value as parameters. + +If $opac parameter is set to a true value, displays OPAC descriptions rather than normal ones when they exist. + +Returns authorised value description + +=cut + +sub GetKohaAuthorisedValueLib { + my ($category,$authorised_value,$opac) = @_; + my $value; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("select lib, lib_opac from authorised_values where category=? and authorised_value=?"); + $sth->execute($category,$authorised_value); + my $data = $sth->fetchrow_hashref; + $value = ($opac && $$data{'lib_opac'}) ? $$data{'lib_opac'} : $$data{'lib'}; + return $value; +} -=over 4 +=head2 display_marc_indicators -# 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 '#'. @@ -1101,6 +1157,132 @@ 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 +# ISBN13 are converted into ISBN10. This is required to get Amazon cover book. +sub GetNormalizedISBN { + my ($isbn,$record,$marcflavour) = @_; + my @fields; + if ($isbn) { + # Koha attempts to store multiple ISBNs in biblioitems.isbn, separated by " | " + # anything after " | " should be removed, along with the delimiter + $isbn =~ s/(.*)( \| )(.*)/$1/; + 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 $isbn = Business::ISBN->new( $_[0] ); + if ( $isbn ) { + $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13'; + if (defined $isbn) { + return $isbn->as_string([]); + } + } + return; +} + 1; __END__