use strict;
#use warnings; FIXME - Bug 2505
+
use C4::Context;
-use C4::Output;
-use URI::Split qw(uri_split);
+use C4::Branch qw(GetBranchesCount);
+use Koha::DateUtils qw(dt_from_string);
use Memoize;
+use DateTime::Format::MySQL;
use Business::ISBN;
+use autouse 'Data::Dumper' => qw(Dumper);
+use DBI qw(:sql_types);
-use vars qw($VERSION @ISA @EXPORT $DEBUG);
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $DEBUG);
BEGIN {
- $VERSION = 3.01;
+ $VERSION = 3.07.00.049;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(
&subfield_is_koha_internal_p
&GetPrinters &GetPrinter
&GetItemTypes &getitemtypeinfo
- &GetCcodes
&GetSupportName &GetSupportList
&get_itemtypeinfos_of
&getframeworks &getframeworkinfo
&getitemtypeimagelocation
&GetAuthorisedValues
&GetAuthorisedValueCategories
+ &IsAuthorisedValueCategory
&GetKohaAuthorisedValues
&GetKohaAuthorisedValuesFromField
&GetKohaAuthorisedValueLib
&GetAuthorisedValueByCode
&GetKohaImageurlFromAuthorisedValues
&GetAuthValCode
+ &AddAuthorisedValue
&GetNormalizedUPC
&GetNormalizedISBN
&GetNormalizedEAN
&GetNormalizedOCLCNumber
&xml_escape
+ &GetVariationsOfISBN
+ &GetVariationsOfISBNs
+ &NormalizeISBN
+
$DEBUG
);
$DEBUG = 0;
+@EXPORT_OK = qw( GetDailyQuote );
}
# expensive functions
}
# FIXME.. this should be moved to a MARC-specific module
-sub subfield_is_koha_internal_p ($) {
+sub subfield_is_koha_internal_p {
my ($subfield) = @_;
# We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
=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>
+ <select name="itemtype" id="itemtype">
+ <option value=""></option>
+ [% FOREACH itemtypeloo IN itemtypeloop %]
+ [% IF ( itemtypeloo.selected ) %]
+ <option value="[% itemtypeloo.itemtype %]" selected="selected">[% itemtypeloo.description %]</option>
+ [% ELSE %]
+ <option value="[% itemtypeloo.itemtype %]">[% itemtypeloo.description %]</option>
+ [% END %]
+ [% END %]
+ </select>
=cut
sub GetSupportList{
my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
- if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
+ if (!$advanced_search_types or $advanced_search_types =~ /itemtypes/) {
my $query = qq|
SELECT *
FROM itemtypes
}
=head2 GetItemTypes
- $itemtypes = &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
=cut
sub GetItemTypes {
+ my ( %params ) = @_;
+ my $style = defined( $params{'style'} ) ? $params{'style'} : 'hash';
# returns a reference to a hash of references to itemtypes...
my %itemtypes;
|;
my $sth = $dbh->prepare($query);
$sth->execute;
- while ( my $IT = $sth->fetchrow_hashref ) {
- $itemtypes{ $IT->{'itemtype'} } = $IT;
+
+ if ( $style eq 'hash' ) {
+ while ( my $IT = $sth->fetchrow_hashref ) {
+ $itemtypes{ $IT->{'itemtype'} } = $IT;
+ }
+ return ( \%itemtypes );
+ } else {
+ return $sth->fetchall_arrayref({});
}
- return ( \%itemtypes );
}
sub get_itemtypeinfos_of {
return get_infos_of( $query, 'itemtype', undef, \@itemtypes );
}
-# this is temporary until we separate collection codes and item types
-sub GetCcodes {
- my $count = 0;
- my @results;
- my $dbh = C4::Context->dbh;
- my $sth =
- $dbh->prepare(
- "SELECT * FROM authorised_values ORDER BY authorised_value");
- $sth->execute;
- while ( my $data = $sth->fetchrow_hashref ) {
- if ( $data->{category} eq "CCODE" ) {
- $count++;
- $results[$count] = $data;
-
- #warn "data: $data";
- }
- }
- $sth->finish;
- return ( $count, @results );
-}
-
=head2 getauthtypes
$authtypes = &getauthtypes();
=head2 getitemtypeinfo
- $itemtype = &getitemtype($itemtype);
+ $itemtype = &getitemtypeinfo($itemtype, [$interface]);
-Returns information about an itemtype.
+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) = @_;
+ my ($itemtype, $interface) = @_;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("select * from itemtypes where itemtype=?");
$sth->execute($itemtype);
my $res = $sth->fetchrow_hashref;
- $res->{imageurl} = getitemtypeimagelocation( 'intranet', $res->{imageurl} );
+ $res->{imageurl} = getitemtypeimagelocation( ( ( defined $interface && $interface eq 'opac' ) ? 'opac' : 'intranet' ), $res->{imageurl} );
return $res;
}
if ($src eq 'intranet') {
return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg';
} else {
- return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('template') . '/itemtypeimg';
+ return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
}
}
if ($src eq 'intranet') {
return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg';
} else {
- return '/opac-tmpl' . '/' . C4::Context->preference('template') . '/itemtypeimg';
+ return '/opac-tmpl' . '/' . C4::Context->preference('opacthemes') . '/itemtypeimg';
}
}
-sub getitemtypeimagelocation($$) {
+sub getitemtypeimagelocation {
my ( $src, $image ) = @_;
return '' if ( !$image );
+ require URI::Split;
- my $scheme = ( uri_split( $image ) )[0];
+ my $scheme = ( URI::Split::uri_split( $image ) )[0];
return $image if ( $scheme );
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;
+ warn $imagesubdir if $DEBUG;
my @imagelist = (); # hashrefs of image info
my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) );
my $imagesetactive = 0;
=cut
-sub GetPrinter ($$) {
+sub GetPrinter {
my ( $query, $printers ) = @_; # get printer for this query from printers
my $printer = $query->param('printer');
my %cookie = $query->cookie('userenv');
opendir D, "$htdocs";
my @dirlist = readdir D;
foreach my $directory (@dirlist) {
+ next if $directory eq 'lib';
-d "$htdocs/$directory/en" and push @themes, $directory;
}
return @themes;
if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
$facets = [
{
- link_value => 'su-to',
- label_value => 'Topics',
- tags =>
- [ '600', '601', '602', '603', '604', '605', '606', '610' ],
- subfield => 'a',
+ idx => 'su-to',
+ label => 'Topics',
+ tags => [ qw/ 600ab 601ab 602a 604at 605a 606ax 610a / ],
+ sep => ' - ',
},
{
- link_value => 'su-geo',
- label_value => 'Places',
- tags => ['651'],
- subfield => 'a',
+ idx => 'su-geo',
+ label => 'Places',
+ tags => [ qw/ 607a / ],
+ sep => ' - ',
},
{
- link_value => 'su-ut',
- label_value => 'Titles',
- tags => [ '500', '501', '502', '503', '504', ],
- subfield => 'a',
+ idx => 'su-ut',
+ label => 'Titles',
+ tags => [ qw/ 500a 501a 503a / ],
+ sep => ', ',
},
{
- link_value => 'au',
- label_value => 'Authors',
- tags => [ '700', '701', '702', ],
- subfield => 'a',
+ idx => 'au',
+ label => 'Authors',
+ tags => [ qw/ 700ab 701ab 702ab / ],
+ sep => C4::Context->preference("UNIMARCAuthorsFacetsSeparator"),
},
{
- link_value => 'se',
- label_value => 'Series',
- tags => ['225'],
- subfield => 'a',
+ idx => 'se',
+ label => 'Series',
+ tags => [ qw/ 225a / ],
+ sep => ', ',
},
+ {
+ idx => 'location',
+ label => 'Location',
+ tags => [ qw/ 995e / ],
+ }
];
- my $library_facet;
-
- $library_facet = {
- link_value => 'branch',
- label_value => 'Libraries',
- tags => [ '995', ],
- subfield => 'b',
- expanded => '1',
- };
- push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
+ unless ( C4::Context->preference("singleBranchMode")
+ || GetBranchesCount() == 1 )
+ {
+ my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
+ if ( $DisplayLibraryFacets eq 'both'
+ || $DisplayLibraryFacets eq 'holding' )
+ {
+ push(
+ @$facets,
+ {
+ idx => 'holdingbranch',
+ label => 'HoldingLibrary',
+ tags => [qw / 995b /],
+ }
+ );
+ }
+
+ if ( $DisplayLibraryFacets eq 'both'
+ || $DisplayLibraryFacets eq 'home' )
+ {
+ push(
+ @$facets,
+ {
+ idx => 'homebranch',
+ label => 'HomeLibrary',
+ tags => [qw / 995a /],
+ }
+ );
+ }
+ }
}
else {
$facets = [
{
- link_value => 'su-to',
- label_value => 'Topics',
- tags => ['650'],
- subfield => 'a',
+ idx => 'su-to',
+ label => 'Topics',
+ tags => [ qw/ 650a / ],
+ sep => '--',
},
-
# {
- # link_value => 'su-na',
- # label_value => 'People and Organizations',
- # tags => ['600', '610', '611'],
- # subfield => 'a',
+ # idx => 'su-na',
+ # label => 'People and Organizations',
+ # tags => [ qw/ 600a 610a 611a / ],
+ # sep => 'a',
# },
{
- link_value => 'su-geo',
- label_value => 'Places',
- tags => ['651'],
- subfield => 'a',
+ idx => 'su-geo',
+ label => 'Places',
+ tags => [ qw/ 651a / ],
+ sep => '--',
+ },
+ {
+ idx => 'su-ut',
+ label => 'Titles',
+ tags => [ qw/ 630a / ],
+ sep => '--',
+ },
+ {
+ idx => 'au',
+ label => 'Authors',
+ tags => [ qw/ 100a 110a 700a / ],
+ sep => ', ',
},
{
- link_value => 'su-ut',
- label_value => 'Titles',
- tags => ['630'],
- subfield => 'a',
+ idx => 'se',
+ label => 'Series',
+ tags => [ qw/ 440a 490a / ],
+ sep => ', ',
},
{
- link_value => 'au',
- label_value => 'Authors',
- tags => [ '100', '110', '700', ],
- subfield => 'a',
+ idx => 'itype',
+ label => 'ItemTypes',
+ tags => [ qw/ 952y 942c / ],
+ sep => ', ',
},
{
- link_value => 'se',
- label_value => 'Series',
- tags => [ '440', '490', ],
- subfield => 'a',
+ idx => 'location',
+ label => 'Location',
+ tags => [ qw / 952c / ],
},
];
- my $library_facet;
- $library_facet = {
- link_value => 'branch',
- label_value => 'Libraries',
- tags => [ '952', ],
- subfield => 'b',
- expanded => '1',
- };
- push @$facets, $library_facet unless C4::Context->preference("singleBranchMode");
+
+ unless ( C4::Context->preference("singleBranchMode")
+ || GetBranchesCount() == 1 )
+ {
+ my $DisplayLibraryFacets = C4::Context->preference('DisplayLibraryFacets');
+ if ( $DisplayLibraryFacets eq 'both'
+ || $DisplayLibraryFacets eq 'holding' )
+ {
+ push(
+ @$facets,
+ {
+ idx => 'holdingbranch',
+ label => 'HoldingLibrary',
+ tags => [qw / 952b /],
+ }
+ );
+ }
+
+ if ( $DisplayLibraryFacets eq 'both'
+ || $DisplayLibraryFacets eq 'home' )
+ {
+ push(
+ @$facets,
+ {
+ idx => 'homebranch',
+ label => 'HomeLibrary',
+ tags => [qw / 952a /],
+ }
+ );
+ }
+ }
}
return $facets;
}
{
'checked' => 'checked',
- 'encoding' => 'MARC-8'
+ 'encoding' => 'utf8',
'icon' => undef,
'id' => 'LIBRARY OF CONGRESS',
'label' => '',
'name' => 'server',
'opensearch' => '',
- 'value' => 'z3950.loc.gov:7090/',
+ 'value' => 'lx2.loc.gov:210/',
'zed' => 1,
},
=cut
sub GetAuthorisedValues {
- my ($category,$selected,$opac) = @_;
- my @results;
+ my ( $category, $selected, $opac ) = @_;
+ my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
+ 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 $query = qq{
+ SELECT *
+ FROM authorised_values
+ };
+ $query .= qq{
+ LEFT JOIN authorised_values_branches ON ( id = av_id )
+ } if $branch_limit;
+ my @where_strings;
+ my @where_args;
+ if($category) {
+ push @where_strings, "category = ?";
+ push @where_args, $category;
+ }
+ if($branch_limit) {
+ push @where_strings, "( branchcode = ? OR branchcode IS NULL )";
+ push @where_args, $branch_limit;
+ }
+ if(@where_strings > 0) {
+ $query .= " WHERE " . join(" AND ", @where_strings);
+ }
+ $query .= " GROUP BY lib";
+ $query .= ' ORDER BY category, ' . (
+ $opac ? 'COALESCE(lib_opac, lib)'
+ : 'lib, lib_opac'
+ );
+
my $sth = $dbh->prepare($query);
- $sth->execute;
- while (my $data=$sth->fetchrow_hashref) {
- 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;
+
+ $sth->execute( @where_args );
+ while (my $data=$sth->fetchrow_hashref) {
+ if ( defined $selected and $selected eq $data->{authorised_value} ) {
+ $data->{selected} = 1;
+ }
+ else {
+ $data->{selected} = 0;
+ }
+
+ if ($opac && $data->{lib_opac}) {
+ $data->{lib} = $data->{lib_opac};
+ }
+ push @results, $data;
+ }
+ $sth->finish;
+ return \@results;
}
=head2 GetAuthorisedValueCategories
return \@results;
}
+=head2 IsAuthorisedValueCategory
+
+ $is_auth_val_category = IsAuthorisedValueCategory($category);
+
+Returns whether a given category name is a valid one
+
+=cut
+
+sub IsAuthorisedValueCategory {
+ my $category = shift;
+ my $query = '
+ SELECT category
+ FROM authorised_values
+ WHERE BINARY category=?
+ LIMIT 1
+ ';
+ my $sth = C4::Context->dbh->prepare($query);
+ $sth->execute($category);
+ $sth->fetchrow ? return 1
+ : return 0;
+}
+
=head2 GetAuthorisedValueByCode
-$authhorised_value = GetAuthorisedValueByCode( $category, $authvalcode );
+$authorised_value = GetAuthorisedValueByCode( $category, $authvalcode, $opac );
Return the lib attribute from authorised_values from the row identified
by the passed category and code
=cut
sub GetAuthorisedValueByCode {
- my ( $category, $authvalcode ) = @_;
+ my ( $category, $authvalcode, $opac ) = @_;
+ my $field = $opac ? 'lib_opac' : 'lib';
my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("SELECT lib FROM authorised_values WHERE category=? AND authorised_value =?");
+ my $sth = $dbh->prepare("SELECT $field FROM authorised_values WHERE category=? AND authorised_value =?");
$sth->execute( $category, $authvalcode );
while ( my $data = $sth->fetchrow_hashref ) {
- return $data->{'lib'};
+ return $data->{ $field };
}
}
}
return \%values;
} else {
- return undef;
+ return;
}
}
}
return \%values;
} else {
- return undef;
+ return;
}
}
return $value;
}
+=head2 AddAuthorisedValue
+
+ AddAuthorisedValue($category, $authorised_value, $lib, $lib_opac, $imageurl);
+
+Create a new authorised value.
+
+=cut
+
+sub AddAuthorisedValue {
+ my ($category, $authorised_value, $lib, $lib_opac, $imageurl) = @_;
+
+ my $dbh = C4::Context->dbh;
+ my $query = qq{
+ INSERT INTO authorised_values (category, authorised_value, lib, lib_opac, imageurl)
+ VALUES (?,?,?,?,?)
+ };
+ my $sth = $dbh->prepare($query);
+ $sth->execute($category, $authorised_value, $lib, $lib_opac, $imageurl);
+}
+
=head2 display_marc_indicators
my $display_form = C4::Koha::display_marc_indicators($field);
my ($record,$marcflavour) = @_;
my (@fields,$upc);
- if ($marcflavour eq 'MARC21') {
- @fields = $record->field('024');
+ if ($marcflavour eq 'UNIMARC') {
+ @fields = $record->field('072');
foreach my $field (@fields) {
- my $indicator = $field->indicator(1);
my $upc = _normalize_match_point($field->subfield('a'));
- if ($indicator == 1 and $upc ne '') {
+ if ($upc ne '') {
return $upc;
}
}
+
}
- else { # assume unimarc if not marc21
- @fields = $record->field('072');
+ else { # assume marc21 if not unimarc
+ @fields = $record->field('024');
foreach my $field (@fields) {
+ my $indicator = $field->indicator(1);
my $upc = _normalize_match_point($field->subfield('a'));
- if ($upc ne '') {
+ if ($indicator == 1 and $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.
+# ISBN13 are converted into ISBN10. This is required to get some book cover images.
sub GetNormalizedISBN {
my ($isbn,$record,$marcflavour) = @_;
my @fields;
$isbn =~ s/(.*)( \| )(.*)/$1/;
return _isbn_cleanup($isbn);
}
- return undef unless $record;
+ return unless $record;
- if ($marcflavour eq 'MARC21') {
- @fields = $record->field('020');
+ if ($marcflavour eq 'UNIMARC') {
+ @fields = $record->field('010');
foreach my $field (@fields) {
- $isbn = $field->subfield('a');
+ my $isbn = $field->subfield('a');
if ($isbn) {
return _isbn_cleanup($isbn);
} else {
- return undef;
+ return;
}
}
}
- else { # assume unimarc if not marc21
- @fields = $record->field('010');
+ else { # assume marc21 if not unimarc
+ @fields = $record->field('020');
foreach my $field (@fields) {
- my $isbn = $field->subfield('a');
+ $isbn = $field->subfield('a');
if ($isbn) {
return _isbn_cleanup($isbn);
} else {
- return undef;
+ return;
}
}
}
-
}
sub GetNormalizedEAN {
my ($record,$marcflavour) = @_;
my (@fields,$ean);
- if ($marcflavour eq 'MARC21') {
- @fields = $record->field('024');
+ if ($marcflavour eq 'UNIMARC') {
+ @fields = $record->field('073');
foreach my $field (@fields) {
- my $indicator = $field->indicator(1);
$ean = _normalize_match_point($field->subfield('a'));
- if ($indicator == 3 and $ean ne '') {
+ if ($ean ne '') {
return $ean;
}
}
}
- else { # assume unimarc if not marc21
- @fields = $record->field('073');
+ else { # assume marc21 if not unimarc
+ @fields = $record->field('024');
foreach my $field (@fields) {
+ my $indicator = $field->indicator(1);
$ean = _normalize_match_point($field->subfield('a'));
- if ($ean ne '') {
+ if ($indicator == 3 and $ean ne '') {
return $ean;
}
}
my ($record,$marcflavour) = @_;
my (@fields,$oclc);
- if ($marcflavour eq 'MARC21') {
+ if ($marcflavour eq 'UNIMARC') {
+ # TODO: add UNIMARC fields
+ }
+ else { # assume marc21 if not unimarc
@fields = $record->field('035');
foreach my $field (@fields) {
$oclc = $field->subfield('a');
$oclc =~ s/\(OCoLC\)//;
return $oclc;
} else {
- return undef;
+ return;
}
}
}
- else { # TODO: add UNIMARC fields
+}
+
+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 {
}
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([]);
+ my ($isbn) = @_;
+ return NormalizeISBN(
+ {
+ isbn => $isbn,
+ format => 'ISBN-10',
+ strip_hyphens => 1,
}
+ ) if $isbn;
+}
+
+=head2 NormalizedISBN
+
+ my $isbns = NormalizedISBN({
+ isbn => $isbn,
+ strip_hyphens => [0,1],
+ format => ['ISBN-10', 'ISBN-13']
+ });
+
+ Returns an isbn validated by Business::ISBN.
+ Optionally strips hyphens and/or forces the isbn
+ to be of the specified format.
+
+ If the string cannot be validated as an isbn,
+ it returns nothing.
+
+=cut
+
+sub NormalizeISBN {
+ my ($params) = @_;
+
+ my $string = $params->{isbn};
+ my $strip_hyphens = $params->{strip_hyphens};
+ my $format = $params->{format};
+
+ return unless $string;
+
+ my $isbn = Business::ISBN->new($string);
+
+ if ( $isbn && $isbn->is_valid() ) {
+
+ if ( $format eq 'ISBN-10' ) {
+ $isbn = $isbn->as_isbn10();
+ }
+ elsif ( $format eq 'ISBN-13' ) {
+ $isbn = $isbn->as_isbn13();
+ }
+
+ if ($strip_hyphens) {
+ $string = $isbn->as_string( [] );
+ } else {
+ $string = $isbn->as_string();
+ }
+
+ return $string;
}
- return;
+}
+
+=head2 GetVariationsOfISBN
+
+ my @isbns = GetVariationsOfISBN( $isbn );
+
+ Returns a list of varations of the given isbn in
+ both ISBN-10 and ISBN-13 formats, with and without
+ hyphens.
+
+ In a scalar context, the isbns are returned as a
+ string delimited by ' | '.
+
+=cut
+
+sub GetVariationsOfISBN {
+ my ($isbn) = @_;
+
+ return unless $isbn;
+
+ my @isbns;
+
+ push( @isbns, NormalizeISBN({ isbn => $isbn }) );
+ 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 }) );
+ push( @isbns, NormalizeISBN({ isbn => $isbn, format => 'ISBN-13', strip_hyphens => 1 }) );
+
+ # Strip out any "empty" strings from the array
+ @isbns = grep { defined($_) && $_ =~ /\S/ } @isbns;
+
+ return wantarray ? @isbns : join( " | ", @isbns );
+}
+
+=head2 GetVariationsOfISBNs
+
+ my @isbns = GetVariationsOfISBNs( @isbns );
+
+ Returns a list of varations of the given isbns in
+ both ISBN-10 and ISBN-13 formats, with and without
+ hyphens.
+
+ In a scalar context, the isbns are returned as a
+ string delimited by ' | '.
+
+=cut
+
+sub GetVariationsOfISBNs {
+ my (@isbns) = @_;
+
+ @isbns = map { GetVariationsOfISBN( $_ ) } @isbns;
+
+ return wantarray ? @isbns : join( " | ", @isbns );
}
1;
projects / koha_fer / blobdiff