X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FKoha.pm;h=681d6ff38f89717842cee387cea144059c081f0f;hb=9d6d641d1f8b77271800f43bc027b651f9aea52b;hp=7f66c236018047953e3cd90201f4c4354774aad9;hpb=8f436a50759ae4ca64f85ac5035a933a6d094e3f;p=srvgit diff --git a/C4/Koha.pm b/C4/Koha.pm index 7f66c23601..681d6ff38f 100644 --- a/C4/Koha.pm +++ b/C4/Koha.pm @@ -20,57 +20,45 @@ package C4::Koha; # along with Koha; if not, see . -use strict; -#use warnings; FIXME - Bug 2505 +use Modern::Perl; use C4::Context; use Koha::Caches; -use Koha::DateUtils qw(dt_from_string); use Koha::AuthorisedValues; use Koha::Libraries; use Koha::MarcSubfieldStructures; -use DateTime::Format::MySQL; use Business::ISBN; use Business::ISSN; use autouse 'Data::cselectall_arrayref' => qw(Dumper); -use DBI qw(:sql_types); -use vars qw(@ISA @EXPORT @EXPORT_OK $DEBUG); +our (@ISA, @EXPORT_OK); BEGIN { - require Exporter; - @ISA = qw(Exporter); - @EXPORT = qw( - &GetPrinters &GetPrinter - &GetItemTypes &getitemtypeinfo - &GetItemTypesCategorized &GetItemTypesByCategory - &getframeworkinfo - &getallthemes - &getFacets - &getnbpages - &get_infos_of - &get_notforloan_label_of - &getitemtypeimagedir - &getitemtypeimagesrc - &getitemtypeimagelocation - &GetAuthorisedValues - &GetAuthorisedValueCategories - &GetNormalizedUPC - &GetNormalizedISBN - &GetNormalizedEAN - &GetNormalizedOCLCNumber - &xml_escape - - &GetVariationsOfISBN - &GetVariationsOfISBNs - &NormalizeISBN - &GetVariationsOfISSN - &GetVariationsOfISSNs - &NormalizeISSN - - $DEBUG - ); - $DEBUG = 0; -@EXPORT_OK = qw( GetDailyQuote ); + require Exporter; + @ISA = qw(Exporter); + @EXPORT_OK = qw( + GetItemTypesCategorized + getallthemes + getFacets + getImageSets + getnbpages + getitemtypeimagedir + getitemtypeimagesrc + getitemtypeimagelocation + GetAuthorisedValues + GetNormalizedUPC + GetNormalizedISBN + GetNormalizedEAN + GetNormalizedOCLCNumber + xml_escape + + GetVariationsOfISBN + GetVariationsOfISBNs + NormalizeISBN + GetVariationsOfISSN + GetVariationsOfISSNs + NormalizeISSN + + ); } =head1 NAME @@ -89,90 +77,6 @@ Koha.pm provides many functions for Koha scripts. =cut -=head2 GetItemTypes - - $itemtypes = &GetItemTypes( style => $style ); - -Returns information about existing itemtypes. - -Params: - style: either 'array' or 'hash', defaults to 'hash'. - 'array' returns an arrayref, - 'hash' return a hashref with the itemtype value as the key - -build a HTML select with the following code : - -=head3 in PERL SCRIPT - - my $itemtypes = GetItemTypes; - my @itemtypesloop; - foreach my $thisitemtype (sort keys %$itemtypes) { - my $selected = 1 if $thisitemtype eq $itemtype; - my %row =(value => $thisitemtype, - selected => $selected, - description => $itemtypes->{$thisitemtype}->{'description'}, - ); - push @itemtypesloop, \%row; - } - $template->param(itemtypeloop => \@itemtypesloop); - -=head3 in TEMPLATE - -
- - "> - -
- -=cut - -sub GetItemTypes { - my ( %params ) = @_; - my $style = defined( $params{'style'} ) ? $params{'style'} : 'hash'; - - require C4::Languages; - my $language = C4::Languages::getlanguage(); - # returns a reference to a hash of references to itemtypes... - my $dbh = C4::Context->dbh; - my $query = q| - SELECT - itemtypes.itemtype, - itemtypes.description, - itemtypes.rentalcharge, - itemtypes.notforloan, - itemtypes.imageurl, - itemtypes.summary, - itemtypes.checkinmsg, - itemtypes.checkinmsgtype, - itemtypes.sip_media_type, - itemtypes.hideinopac, - itemtypes.searchcategory, - COALESCE( localization.translation, itemtypes.description ) AS translated_description - FROM itemtypes - LEFT JOIN localization ON itemtypes.itemtype = localization.code - AND localization.entity = 'itemtypes' - AND localization.lang = ? - ORDER BY itemtype - |; - my $sth = $dbh->prepare($query); - $sth->execute( $language ); - - if ( $style eq 'hash' ) { - my %itemtypes; - while ( my $IT = $sth->fetchrow_hashref ) { - $itemtypes{ $IT->{'itemtype'} } = $IT; - } - return ( \%itemtypes ); - } else { - return [ sort { lc $a->{translated_description} cmp lc $b->{translated_description} } @{ $sth->fetchall_arrayref( {} ) } ]; - } -} - =head2 GetItemTypesCategorized $categories = GetItemTypesCategorized(); @@ -191,7 +95,7 @@ sub GetItemTypesCategorized { SELECT itemtype, description, imageurl, hideinopac, 0 as 'iscat' FROM itemtypes WHERE ISNULL(searchcategory) or length(searchcategory) = 0 UNION SELECT DISTINCT searchcategory AS `itemtype`, - authorised_values.lib_opac AS description, + COALESCE(authorised_values.lib_opac,authorised_values.lib) AS description, authorised_values.imageurl AS imageurl, hideinopac, 1 as 'iscat' FROM itemtypes @@ -199,7 +103,7 @@ sub GetItemTypesCategorized { WHERE searchcategory > '' and hideinopac=1 UNION SELECT DISTINCT searchcategory AS `itemtype`, - authorised_values.lib_opac AS description, + COALESCE(authorised_values.lib_opac,authorised_values.lib) AS description, authorised_values.imageurl AS imageurl, hideinopac, 1 as 'iscat' FROM itemtypes @@ -209,81 +113,6 @@ sub GetItemTypesCategorized { return ($dbh->selectall_hashref($query,'itemtype')); } -=head2 GetItemTypesByCategory - - @results = GetItemTypesByCategory( $searchcategory ); - -Returns the itemtype code of all itemtypes included in a searchcategory. - -=cut - -sub GetItemTypesByCategory { - my ($category) = @_; - my $count = 0; - my @results; - my $dbh = C4::Context->dbh; - my $query = qq|SELECT itemtype FROM itemtypes WHERE searchcategory=?|; - my $tmp=$dbh->selectcol_arrayref($query,undef,$category); - return @$tmp; -} - -=head2 getframeworkinfo - - $frameworkinfo = &getframeworkinfo($frameworkcode); - -Returns information about an frameworkcode. - -=cut - -sub getframeworkinfo { - my ($frameworkcode) = @_; - my $dbh = C4::Context->dbh; - my $sth = - $dbh->prepare("select * from biblio_framework where frameworkcode=?"); - $sth->execute($frameworkcode); - my $res = $sth->fetchrow_hashref; - return $res; -} - -=head2 getitemtypeinfo - - $itemtype = &getitemtypeinfo($itemtype, [$interface]); - -Returns information about an itemtype. The optional $interface argument -sets which interface ('opac' or 'intranet') to return the imageurl for. -Defaults to intranet. - -=cut - -sub getitemtypeinfo { - my ($itemtype, $interface) = @_; - my $dbh = C4::Context->dbh; - require C4::Languages; - my $language = C4::Languages::getlanguage(); - my $it = $dbh->selectrow_hashref(q| - SELECT - itemtypes.itemtype, - itemtypes.description, - itemtypes.rentalcharge, - itemtypes.notforloan, - itemtypes.imageurl, - itemtypes.summary, - itemtypes.checkinmsg, - itemtypes.checkinmsgtype, - itemtypes.sip_media_type, - COALESCE( localization.translation, itemtypes.description ) AS translated_description - FROM itemtypes - LEFT JOIN localization ON itemtypes.itemtype = localization.code - AND localization.entity = 'itemtypes' - AND localization.lang = ? - WHERE itemtypes.itemtype = ? - |, undef, $language, $itemtype ); - - $it->{imageurl} = getitemtypeimagelocation( ( ( defined $interface && $interface eq 'opac' ) ? 'opac' : 'intranet' ), $it->{imageurl} ); - - return $it; -} - =head2 getitemtypeimagedir my $directory = getitemtypeimagedir( 'opac' ); @@ -419,7 +248,6 @@ sub getImageSets { my @imagesets = (); # list of hasrefs of image set data to pass to template my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} ); foreach my $imagesubdir ( @subdirectories ) { - warn $imagesubdir if $DEBUG; my @imagelist = (); # hashrefs of image info my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) ); my $imagesetactive = 0; @@ -441,45 +269,6 @@ sub getImageSets { return \@imagesets; } -=head2 GetPrinters - - $printers = &GetPrinters(); - @queues = keys %$printers; - -Returns information about existing printer queues. - -C<$printers> is a reference-to-hash whose keys are the print queues -defined in the printers table of the Koha database. The values are -references-to-hash, whose keys are the fields in the printers table. - -=cut - -sub GetPrinters { - my %printers; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("select * from printers"); - $sth->execute; - while ( my $printer = $sth->fetchrow_hashref ) { - $printers{ $printer->{'printqueue'} } = $printer; - } - return ( \%printers ); -} - -=head2 GetPrinter - - $printer = GetPrinter( $query, $printers ); - -=cut - -sub GetPrinter { - my ( $query, $printers ) = @_; # get printer for this query from printers - my $printer = $query->param('printer'); - my %cookie = $query->cookie('userenv'); - ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' ); - ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] ); - return $printer; -} - =head2 getnbpages Returns the number of pages to display in a pagination bar, given the number @@ -538,12 +327,6 @@ sub getFacets { sep => ' - ', }, { - idx => 'su-ut', - label => 'Titles', - tags => [ qw/ 500a 501a 503a / ], - sep => ', ', - }, - { idx => 'au', label => 'Authors', tags => [ qw/ 700ab 701ab 702ab / ], @@ -559,6 +342,11 @@ sub getFacets { idx => 'location', label => 'Location', tags => [ qw/ 995e / ], + }, + { + idx => 'ccode', + label => 'CollectionCodes', + tags => [ qw / 099t 955h / ], } ]; @@ -641,6 +429,11 @@ sub getFacets { label => 'Location', tags => [ qw / 952c / ], }, + { + idx => 'ccode', + label => 'CollectionCodes', + tags => [ qw / 9528 / ], + } ]; unless ( Koha::Libraries->search->count == 1 ) @@ -676,106 +469,6 @@ sub getFacets { return $facets; } -=head2 get_infos_of - -Return a href where a key is associated to a href. You give a query, -the name of the key among the fields returned by the query. If you -also give as third argument the name of the value, the function -returns a href of scalar. The optional 4th argument is an arrayref of -items passed to the C call. It is designed to bind -parameters to any placeholders in your SQL. - - my $query = ' -SELECT itemnumber, - notforloan, - barcode - FROM items -'; - - # generic href of any information on the item, href of href. - my $iteminfos_of = get_infos_of($query, 'itemnumber'); - print $iteminfos_of->{$itemnumber}{barcode}; - - # specific information, href of scalar - my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode'); - print $barcode_of_item->{$itemnumber}; - -=cut - -sub get_infos_of { - my ( $query, $key_name, $value_name, $bind_params ) = @_; - - my $dbh = C4::Context->dbh; - - my $sth = $dbh->prepare($query); - $sth->execute( @$bind_params ); - - my %infos_of; - while ( my $row = $sth->fetchrow_hashref ) { - if ( defined $value_name ) { - $infos_of{ $row->{$key_name} } = $row->{$value_name}; - } - else { - $infos_of{ $row->{$key_name} } = $row; - } - } - $sth->finish; - - return \%infos_of; -} - -=head2 get_notforloan_label_of - - my $notforloan_label_of = get_notforloan_label_of(); - -Each authorised value of notforloan (information available in items and -itemtypes) is link to a single label. - -Returns a href where keys are authorised values and values are corresponding -labels. - - foreach my $authorised_value (keys %{$notforloan_label_of}) { - printf( - "authorised_value: %s => %s\n", - $authorised_value, - $notforloan_label_of->{$authorised_value} - ); - } - -=cut - -# FIXME - why not use GetAuthorisedValues ?? -# -sub get_notforloan_label_of { - my $dbh = C4::Context->dbh; - - my $query = ' -SELECT authorised_value - FROM marc_subfield_structure - WHERE kohafield = \'items.notforloan\' - LIMIT 0, 1 -'; - my $sth = $dbh->prepare($query); - $sth->execute(); - my ($statuscode) = $sth->fetchrow_array(); - - $query = ' -SELECT lib, - authorised_value - FROM authorised_values - WHERE category = ? -'; - $sth = $dbh->prepare($query); - $sth->execute($statuscode); - my %notforloan_label_of; - while ( my $row = $sth->fetchrow_hashref ) { - $notforloan_label_of{ $row->{authorised_value} } = $row->{lib}; - } - $sth->finish; - - return \%notforloan_label_of; -} - =head2 GetAuthorisedValues $authvalues = GetAuthorisedValues([$category]); @@ -843,26 +536,6 @@ sub GetAuthorisedValues { return \@results; } -=head2 GetAuthorisedValueCategories - - $auth_categories = GetAuthorisedValueCategories(); - -Return an arrayref of all of the available authorised -value categories. - -=cut - -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 (defined (my $category = $sth->fetchrow_array) ) { - push @results, $category; - } - return \@results; -} - =head2 xml_escape my $escaped_string = C4::Koha::xml_escape($string); @@ -996,7 +669,7 @@ sub GetNormalizedOCLCNumber { my @fields = $marcrecord->field('035'); foreach my $field (@fields) { my $oclc = $field->subfield('a'); - if ($oclc =~ /OCoLC/) { + if ($oclc && $oclc =~ /OCoLC/) { $oclc =~ s/\(OCoLC\)//; return $oclc; } @@ -1007,115 +680,6 @@ sub GetNormalizedOCLCNumber { return } -sub GetAuthvalueDropbox { - my ( $authcat, $default ) = @_; - my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : ""; - my $dbh = C4::Context->dbh; - - my $query = qq{ - SELECT * - FROM authorised_values - }; - $query .= qq{ - LEFT JOIN authorised_values_branches ON ( id = av_id ) - } if $branch_limit; - $query .= qq{ - WHERE category = ? - }; - $query .= " AND ( branchcode = ? OR branchcode IS NULL )" if $branch_limit; - $query .= " GROUP BY lib ORDER BY category, lib, lib_opac"; - my $sth = $dbh->prepare($query); - $sth->execute( $authcat, $branch_limit ? $branch_limit : () ); - - - my $option_list = []; - my @authorised_values = ( q{} ); - while (my $av = $sth->fetchrow_hashref) { - push @{$option_list}, { - value => $av->{authorised_value}, - label => $av->{lib}, - default => ($default eq $av->{authorised_value}), - }; - } - - if ( @{$option_list} ) { - return $option_list; - } - return; -} - - -=head2 GetDailyQuote($opts) - -Takes a hashref of options - -Currently supported options are: - -'id' An exact quote id -'random' Select a random quote -noop When no option is passed in, this sub will return the quote timestamped for the current day - -The function returns an anonymous hash following this format: - - { - 'source' => 'source-of-quote', - 'timestamp' => 'timestamp-value', - 'text' => 'text-of-quote', - 'id' => 'quote-id' - }; - -=cut - -# This is definitely a candidate for some sort of caching once we finally settle caching/persistence issues... -# at least for default option - -sub GetDailyQuote { - my %opts = @_; - my $dbh = C4::Context->dbh; - my $query = ''; - my $sth = undef; - my $quote = undef; - if ($opts{'id'}) { - $query = 'SELECT * FROM quotes WHERE id = ?'; - $sth = $dbh->prepare($query); - $sth->execute($opts{'id'}); - $quote = $sth->fetchrow_hashref(); - } - elsif ($opts{'random'}) { - # Fall through... we also return a random quote as a catch-all if all else fails - } - else { - $query = 'SELECT * FROM quotes WHERE timestamp LIKE CONCAT(CURRENT_DATE,\'%\') ORDER BY timestamp DESC LIMIT 0,1'; - $sth = $dbh->prepare($query); - $sth->execute(); - $quote = $sth->fetchrow_hashref(); - } - unless ($quote) { # if there are not matches, choose a random quote - # get a list of all available quote ids - $sth = C4::Context->dbh->prepare('SELECT count(*) FROM quotes;'); - $sth->execute; - my $range = ($sth->fetchrow_array)[0]; - # chose a random id within that range if there is more than one quote - my $offset = int(rand($range)); - # grab it - $query = 'SELECT * FROM quotes ORDER BY id LIMIT 1 OFFSET ?'; - $sth = C4::Context->dbh->prepare($query); - # see http://www.perlmonks.org/?node_id=837422 for why - # we're being verbose and using bind_param - $sth->bind_param(1, $offset, SQL_INTEGER); - $sth->execute(); - $quote = $sth->fetchrow_hashref(); - # update the timestamp for that quote - $query = 'UPDATE quotes SET timestamp = ? WHERE id = ?'; - $sth = C4::Context->dbh->prepare($query); - $sth->execute( - DateTime::Format::MySQL->format_datetime( dt_from_string() ), - $quote->{'id'} - ); - } - return $quote; -} - sub _normalize_match_point { my $match_point = shift; (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/; @@ -1135,9 +699,9 @@ sub _isbn_cleanup { ) if $isbn; } -=head2 NormalizedISBN +=head2 NormalizeISBN - my $isbns = NormalizedISBN({ + my $isbns = NormalizeISBN({ isbn => $isbn, strip_hyphens => [0,1], format => ['ISBN-10', 'ISBN-13'] @@ -1148,7 +712,9 @@ sub _isbn_cleanup { to be of the specified format. If the string cannot be validated as an isbn, - it returns nothing. + it returns nothing unless return_invalid param is passed. + + #FIXME This routine (and others?) should be moved to Koha::Util::Normalize =cut @@ -1157,7 +723,8 @@ sub NormalizeISBN { my $string = $params->{isbn}; my $strip_hyphens = $params->{strip_hyphens}; - my $format = $params->{format}; + my $format = $params->{format} || q{}; + my $return_invalid = $params->{return_invalid}; return unless $string; @@ -1166,7 +733,7 @@ sub NormalizeISBN { if ( $isbn && $isbn->is_valid() ) { if ( $format eq 'ISBN-10' ) { - $isbn = $isbn->as_isbn10(); + $isbn = $isbn->as_isbn10(); } elsif ( $format eq 'ISBN-13' ) { $isbn = $isbn->as_isbn13(); @@ -1180,7 +747,10 @@ sub NormalizeISBN { } return $string; + } elsif ( $return_invalid ) { + return $string; } + } =head2 GetVariationsOfISBN @@ -1203,7 +773,7 @@ sub GetVariationsOfISBN { my @isbns; - push( @isbns, NormalizeISBN({ isbn => $isbn }) ); + push( @isbns, NormalizeISBN({ isbn => $isbn, return_invalid => 1 }) ); push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10' }) ); push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13' }) ); push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-10', strip_hyphens => 1 }) ); @@ -1324,32 +894,6 @@ sub GetVariationsOfISSNs { return wantarray ? @issns : join( " | ", @issns ); } - -=head2 IsKohaFieldLinked - - my $is_linked = IsKohaFieldLinked({ - kohafield => $kohafield, - frameworkcode => $frameworkcode, - }); - - Return 1 if the field is linked - -=cut - -sub IsKohaFieldLinked { - my ( $params ) = @_; - my $kohafield = $params->{kohafield}; - my $frameworkcode = $params->{frameworkcode} || ''; - my $dbh = C4::Context->dbh; - my $is_linked = $dbh->selectcol_arrayref( q| - SELECT COUNT(*) - FROM marc_subfield_structure - WHERE frameworkcode = ? - AND kohafield = ? - |,{}, $frameworkcode, $kohafield ); - return $is_linked->[0]; -} - 1; __END__