#
# This file is part of Koha.
#
-# Koha is free software; you can redistribute it and/or modify it under the
-# terms of the GNU General Public License as published by the Free Software
-# Foundation; either version 2 of the License, or (at your option) any later
-# version.
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
#
-# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
-# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY 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.,
-# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
-use strict;
-use warnings;
+use Modern::Perl;
+
+use C4::Auth qw(haspermission);
+use C4::Context;
use C4::Dates qw(format_date format_date_in_iso);
+use DateTime;
use Date::Calc qw(:all);
use POSIX qw(strftime);
use C4::Biblio;
use C4::Log; # logaction
use C4::Debug;
+use C4::Serials::Frequency;
+use C4::Serials::Numberpattern;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+# Define statuses
+use constant {
+ EXPECTED => 1,
+ ARRIVED => 2,
+ LATE => 3,
+ MISSING => 4,
+ MISSING_NEVER_RECIEVED => 41,
+ MISSING_SOLD_OUT => 42,
+ MISSING_DAMAGED => 43,
+ MISSING_LOST => 44,
+ NOT_ISSUED => 5,
+ DELETED => 6,
+ CLAIMED => 7,
+ STOPPED => 8,
+};
+
+use constant MISSING_STATUSES => (
+ MISSING, MISSING_NEVER_RECIEVED,
+ MISSING_SOLD_OUT, MISSING_DAMAGED,
+ MISSING_LOST
+);
+
BEGIN {
$VERSION = 3.07.00.049; # set version for version checking
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(
- &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions
+ &NewSubscription &ModSubscription &DelSubscription
&GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
&SearchSubscriptions
&GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
&HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
+ &GetSubscriptionHistoryFromSubscriptionId
- &GetNextSeq &NewIssue &ItemizeSerials &GetSerials
+ &GetNextSeq &GetSeq &NewIssue &ItemizeSerials &GetSerials
&GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
- &ReNewSubscription &GetLateIssues &GetLateOrMissingIssues
+ &ReNewSubscription &GetLateOrMissingIssues
&GetSerialInformation &AddItem2Serial
&PrepareSerialsData &GetNextExpected &ModNextExpected
&CountIssues
HasItems
&GetSubscriptionsFromBorrower
+ &subscriptionCurrentlyOnOrder
);
}
sub GetSuppliersWithLateIssues {
my $dbh = C4::Context->dbh;
+ my $statuses = join(',', ( LATE, MISSING_STATUSES, CLAIMED ) );
my $query = qq|
- SELECT DISTINCT id, name
+ SELECT DISTINCT id, name
FROM subscription
LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
WHERE id > 0
AND (
(planneddate < now() AND serial.status=1)
- OR serial.STATUS = 3 OR serial.STATUS = 4
+ OR serial.STATUS IN ( $statuses )
)
AND subscription.closed = 0
ORDER BY name|;
return $dbh->selectall_arrayref($query, { Slice => {} });
}
-=head2 GetLateIssues
-
-@issuelist = GetLateIssues($supplierid)
+=head2 GetSubscriptionHistoryFromSubscriptionId
-this function selects late issues from the database
+$history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
-return :
-the issuelist as an array. Each element of this array contains a hashi_ref containing
-name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
+This function returns the subscription history as a hashref
=cut
-sub GetLateIssues {
- my ($supplierid) = @_;
- my $dbh = C4::Context->dbh;
- my $sth;
- if ($supplierid) {
- my $query = qq|
- SELECT name,title,planneddate,serialseq,serial.subscriptionid
- FROM subscription
- LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
- LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
- LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
- WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
- AND subscription.aqbooksellerid=?
- AND subscription.closed = 0
- ORDER BY title
- |;
- $sth = $dbh->prepare($query);
- $sth->execute($supplierid);
- } else {
- my $query = qq|
- SELECT name,title,planneddate,serialseq,serial.subscriptionid
- FROM subscription
- LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
- LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
- LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
- WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
- AND subscription.closed = 0
- ORDER BY title
- |;
- $sth = $dbh->prepare($query);
- $sth->execute;
- }
- my @issuelist;
- my $last_title;
- my $odd = 0;
- while ( my $line = $sth->fetchrow_hashref ) {
- $odd++ unless $line->{title} eq $last_title;
- $line->{title} = "" if $line->{title} eq $last_title;
- $last_title = $line->{title} if ( $line->{title} );
- $line->{planneddate} = format_date( $line->{planneddate} );
- push @issuelist, $line;
- }
- return @issuelist;
-}
-
-=head2 GetSubscriptionHistoryFromSubscriptionId
-
-$sth = GetSubscriptionHistoryFromSubscriptionId()
-this function prepares the SQL request and returns the statement handle
-After this function, don't forget to execute it by using $sth->execute($subscriptionid)
+sub GetSubscriptionHistoryFromSubscriptionId {
+ my ($subscriptionid) = @_;
-=cut
+ return unless $subscriptionid;
-sub GetSubscriptionHistoryFromSubscriptionId {
my $dbh = C4::Context->dbh;
my $query = qq|
SELECT *
FROM subscriptionhistory
WHERE subscriptionid = ?
|;
- return $dbh->prepare($query);
+ my $sth = $dbh->prepare($query);
+ $sth->execute($subscriptionid);
+ my $results = $sth->fetchrow_hashref;
+ $sth->finish;
+
+ return $results;
}
=head2 GetSerialStatusFromSerialId
my ($serialid) = @_;
my $dbh = C4::Context->dbh;
my $query = qq|
- SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid |;
- if ( C4::Context->preference('IndependantBranches')
- && C4::Context->userenv
- && C4::Context->userenv->{'flags'} != 1
- && C4::Context->userenv->{'branch'} ) {
- $query .= "
- , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
- }
- $query .= qq|
+ SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
WHERE serialid = ?
|;
$data->{ "status" . $data->{'serstatus'} } = 1;
$data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
$data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
+ $data->{cannotedit} = not can_edit_subscription( $data );
return $data;
}
sub AddItem2Serial {
my ( $serialid, $itemnumber ) = @_;
+
+ return unless ($serialid and $itemnumber);
+
my $dbh = C4::Context->dbh;
my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
$rq->execute( $serialid, $itemnumber );
sub UpdateClaimdateIssues {
my ( $serialids, $date ) = @_;
+
+ return unless ($serialids);
+
my $dbh = C4::Context->dbh;
$date = strftime( "%Y-%m-%d", localtime ) unless ($date);
my $query = "
- UPDATE serial SET claimdate = ?, status = 7
- WHERE serialid in (" . join( ",", map { '?' } @$serialids ) . ")";
+ UPDATE serial
+ SET claimdate = ?,
+ status = ?,
+ claims_count = claims_count + 1
+ WHERE serialid in (" . join( ",", map { '?' } @$serialids ) . ")
+ ";
my $rq = $dbh->prepare($query);
- $rq->execute($date, @$serialids);
+ $rq->execute($date, CLAIMED, @$serialids);
return $rq->rows;
}
this function returns the subscription which has $subscriptionid as id.
return :
a hashref. This hash containts
-subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
+subscription, subscriptionhistory, aqbooksellers.name, biblio.title
=cut
subscriptionhistory.*,
aqbooksellers.name AS aqbooksellername,
biblio.title AS bibliotitle,
- subscription.biblionumber as bibnum);
- if ( C4::Context->preference('IndependantBranches')
- && C4::Context->userenv
- && C4::Context->userenv->{'flags'} != 1
- && C4::Context->userenv->{'branch'} ) {
- $query .= "
- , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
- }
- $query .= qq(
+ subscription.biblionumber as bibnum
FROM subscription
LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
WHERE subscription.subscriptionid = ?
);
- # if (C4::Context->preference('IndependantBranches') &&
- # C4::Context->userenv &&
- # C4::Context->userenv->{'flags'} != 1){
- # # $debug and warn "flags: ".C4::Context->userenv->{'flags'};
- # $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
- # }
$debug and warn "query : $query\nsubsid :$subscriptionid";
my $sth = $dbh->prepare($query);
$sth->execute($subscriptionid);
- return $sth->fetchrow_hashref;
+ my $subscription = $sth->fetchrow_hashref;
+ $subscription->{cannotedit} = not can_edit_subscription( $subscription );
+ return $subscription;
}
=head2 GetFullSubscription
sub GetFullSubscription {
my ($subscriptionid) = @_;
+
+ return unless ($subscriptionid);
+
my $dbh = C4::Context->dbh;
my $query = qq|
SELECT serial.serialid,
aqbooksellers.name as aqbooksellername,
biblio.title as bibliotitle,
subscription.branchcode AS branchcode,
- subscription.subscriptionid AS subscriptionid |;
- if ( C4::Context->preference('IndependantBranches')
- && C4::Context->userenv
- && C4::Context->userenv->{'flags'} != 1
- && C4::Context->userenv->{'branch'} ) {
- $query .= "
- , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
- }
- $query .= qq|
+ subscription.subscriptionid AS subscriptionid
FROM serial
LEFT JOIN subscription ON
(serial.subscriptionid=subscription.subscriptionid )
$debug and warn "GetFullSubscription query: $query";
my $sth = $dbh->prepare($query);
$sth->execute($subscriptionid);
- return $sth->fetchall_arrayref( {} );
+ my $subscriptions = $sth->fetchall_arrayref( {} );
+ for my $subscription ( @$subscriptions ) {
+ $subscription->{cannotedit} = not can_edit_subscription( $subscription );
+ }
+ return $subscriptions;
}
=head2 PrepareSerialsData
sub PrepareSerialsData {
my ($lines) = @_;
+
+ return unless ($lines);
+
my %tmpresults;
my $year;
my @res;
foreach my $subs (@{$lines}) {
for my $datefield ( qw(publisheddate planneddate) ) {
- # handle both undef and undef returned as 0000-00-00
- if (!defined $subs->{$datefield} or $subs->{$datefield}=~m/^00/) {
- $subs->{$datefield} = 'XXX';
- }
- else {
- $subs->{$datefield} = format_date( $subs->{$datefield} );
+ # handle 0000-00-00 dates
+ if (defined $subs->{$datefield} and $subs->{$datefield} =~ m/^00/) {
+ $subs->{$datefield} = undef;
}
}
$subs->{ "status" . $subs->{'status'} } = 1;
- $subs->{"checked"} = $subs->{'status'} =~ /1|3|4|7/;
+ if ( grep { $_ == $subs->{status} } ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) ) {
+ $subs->{"checked"} = 1;
+ }
if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
$year = $subs->{'year'};
sub GetSubscriptionsFromBiblionumber {
my ($biblionumber) = @_;
+
+ return unless ($biblionumber);
+
my $dbh = C4::Context->dbh;
my $query = qq(
SELECT subscription.*,
$subs->{ "periodicity" . $subs->{periodicity} } = 1;
$subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
$subs->{ "status" . $subs->{'status'} } = 1;
- $subs->{'cannotedit'} =
- ( C4::Context->preference('IndependantBranches')
- && C4::Context->userenv
- && C4::Context->userenv->{flags} % 2 != 1
- && C4::Context->userenv->{branch}
- && $subs->{branchcode}
- && ( C4::Context->userenv->{branch} ne $subs->{branchcode} ) );
if ( $subs->{enddate} eq '0000-00-00' ) {
$subs->{enddate} = '';
}
$subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
$subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
+ $subs->{cannotedit} = not can_edit_subscription( $subs );
push @res, $subs;
}
return \@res;
year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
biblio.title as bibliotitle,
subscription.branchcode AS branchcode,
- subscription.subscriptionid AS subscriptionid|;
- if ( C4::Context->preference('IndependantBranches')
- && C4::Context->userenv
- && C4::Context->userenv->{'flags'} != 1
- && C4::Context->userenv->{'branch'} ) {
- $query .= "
- , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
- }
-
- $query .= qq|
+ subscription.subscriptionid AS subscriptionid
FROM serial
LEFT JOIN subscription ON
(serial.subscriptionid=subscription.subscriptionid)
|;
my $sth = $dbh->prepare($query);
$sth->execute($biblionumber);
- return $sth->fetchall_arrayref( {} );
-}
-
-=head2 GetSubscriptions
-
-@results = GetSubscriptions($title,$ISSN,$ean,$biblionumber);
-this function gets all subscriptions which have title like $title,ISSN like $ISSN,EAN like $ean and biblionumber like $biblionumber.
-return:
-a table of hashref. Each hash containt the subscription.
-
-=cut
-
-sub GetSubscriptions {
- my ( $string, $issn, $ean, $biblionumber ) = @_;
-
- #return unless $title or $ISSN or $biblionumber;
- my $dbh = C4::Context->dbh;
- my $sth;
- my $sql = qq(
- SELECT subscription.*, subscriptionhistory.*, biblio.title,biblioitems.issn,biblio.biblionumber
- FROM subscription
- LEFT JOIN subscriptionhistory USING(subscriptionid)
- LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
- LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
- );
- my @bind_params;
- my $sqlwhere = q{};
- if ($biblionumber) {
- $sqlwhere = " WHERE biblio.biblionumber=?";
- push @bind_params, $biblionumber;
- }
- if ($string) {
- my @sqlstrings;
- my @strings_to_search;
- @strings_to_search = map { "%$_%" } split( / /, $string );
- foreach my $index (qw(biblio.title subscription.callnumber subscription.location subscription.notes subscription.internalnotes)) {
- push @bind_params, @strings_to_search;
- my $tmpstring = "AND $index LIKE ? " x scalar(@strings_to_search);
- $debug && warn "$tmpstring";
- $tmpstring =~ s/^AND //;
- push @sqlstrings, $tmpstring;
- }
- $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "((" . join( ") OR (", @sqlstrings ) . "))";
- }
- if ($issn) {
- my @sqlstrings;
- my @strings_to_search;
- @strings_to_search = map { "%$_%" } split( / /, $issn );
- foreach my $index ( qw(biblioitems.issn subscription.callnumber)) {
- push @bind_params, @strings_to_search;
- my $tmpstring = "OR $index LIKE ? " x scalar(@strings_to_search);
- $debug && warn "$tmpstring";
- $tmpstring =~ s/^OR //;
- push @sqlstrings, $tmpstring;
- }
- $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "((" . join( ") OR (", @sqlstrings ) . "))";
- }
- if ($ean) {
- my @sqlstrings;
- my @strings_to_search;
- @strings_to_search = map { "$_" } split( / /, $ean );
- foreach my $index ( qw(biblioitems.ean) ) {
- push @bind_params, @strings_to_search;
- my $tmpstring = "OR $index = ? " x scalar(@strings_to_search);
- $debug && warn "$tmpstring";
- $tmpstring =~ s/^OR //;
- push @sqlstrings, $tmpstring;
- }
- $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "((" . join( ") OR (", @sqlstrings ) . "))";
- }
-
- $sql .= "$sqlwhere ORDER BY title";
- $debug and warn "GetSubscriptions query: $sql params : ", join( " ", @bind_params );
- $sth = $dbh->prepare($sql);
- $sth->execute(@bind_params);
- my @results;
-
- while ( my $line = $sth->fetchrow_hashref ) {
- $line->{'cannotedit'} =
- ( C4::Context->preference('IndependantBranches')
- && C4::Context->userenv
- && C4::Context->userenv->{flags} % 2 != 1
- && C4::Context->userenv->{branch}
- && $line->{branchcode}
- && ( C4::Context->userenv->{branch} ne $line->{branchcode} ) );
- push @results, $line;
+ my $subscriptions = $sth->fetchall_arrayref( {} );
+ for my $subscription ( @$subscriptions ) {
+ $subscription->{cannotedit} = not can_edit_subscription( $subscription );
}
- return @results;
+ return $subscriptions;
}
=head2 SearchSubscriptions
-@results = SearchSubscriptions($args);
-$args is a hashref. Its keys can be contained: title, issn, ean, publisher, bookseller and branchcode
+ @results = SearchSubscriptions($args);
-this function gets all subscriptions which have title like $title, ISSN like $issn, EAN like $ean, publisher like $publisher, bookseller like $bookseller AND branchcode eq $branch.
+This function returns a list of hashrefs, one for each subscription
+that meets the conditions specified by the $args hashref.
-return:
-a table of hashref. Each hash containt the subscription.
+The valid search fields are:
+
+ biblionumber
+ title
+ issn
+ ean
+ callnumber
+ location
+ publisher
+ bookseller
+ branch
+ expiration_date
+ closed
+
+The expiration_date search field is special; it specifies the maximum
+subscription expiration date.
=cut
sub SearchSubscriptions {
my ( $args ) = @_;
- my $query = qq{
- SELECT subscription.*, subscriptionhistory.*, biblio.*, biblioitems.issn
+ my $query = q{
+ SELECT
+ subscription.notes AS publicnotes,
+ subscriptionhistory.*,
+ subscription.*,
+ biblio.notes AS biblionotes,
+ biblio.title,
+ biblio.author,
+ biblio.biblionumber,
+ biblioitems.issn
FROM subscription
LEFT JOIN subscriptionhistory USING(subscriptionid)
LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
push @where_strs, "biblioitems.ean LIKE ?";
push @where_args, "%$args->{ean}%";
}
+ if ( $args->{callnumber} ) {
+ push @where_strs, "subscription.callnumber LIKE ?";
+ push @where_args, "%$args->{callnumber}%";
+ }
if( $args->{publisher} ){
push @where_strs, "biblioitems.publishercode LIKE ?";
push @where_args, "%$args->{publisher}%";
push @where_strs, "subscription.branchcode = ?";
push @where_args, "$args->{branch}";
}
+ if ( $args->{location} ) {
+ push @where_strs, "subscription.location = ?";
+ push @where_args, "$args->{location}";
+ }
+ if ( $args->{expiration_date} ) {
+ push @where_strs, "subscription.enddate <= ?";
+ push @where_args, "$args->{expiration_date}";
+ }
if( defined $args->{closed} ){
push @where_strs, "subscription.closed = ?";
push @where_args, "$args->{closed}";
$query .= " WHERE " . join(" AND ", @where_strs);
}
+ $query .= " ORDER BY " . $args->{orderby} if $args->{orderby};
+
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare($query);
$sth->execute(@where_args);
my $results = $sth->fetchall_arrayref( {} );
$sth->finish;
+ for my $subscription ( @$results ) {
+ $subscription->{cannotedit} = not can_edit_subscription( $subscription );
+ $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
+ }
+
return @$results;
}
sub GetSerials {
my ( $subscriptionid, $count ) = @_;
+
+ return unless $subscriptionid;
+
my $dbh = C4::Context->dbh;
# status = 2 is "arrived"
my $counter = 0;
$count = 5 unless ($count);
my @serials;
+ my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES, NOT_ISSUED ) );
my $query = "SELECT serialid,serialseq, status, publisheddate, planneddate,notes, routingnotes
FROM serial
- WHERE subscriptionid = ? AND status NOT IN (2,4,5)
+ WHERE subscriptionid = ? AND status NOT IN ( $statuses )
ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
my $sth = $dbh->prepare($query);
$sth->execute($subscriptionid);
$query = "SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
FROM serial
WHERE subscriptionid = ?
- AND (status in (2,4,5))
+ AND status IN ( $statuses )
ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
";
$sth = $dbh->prepare($query);
=head2 GetSerials2
-@serials = GetSerials2($subscriptionid,$status);
+@serials = GetSerials2($subscriptionid,$statuses);
this function returns every serial waited for a given subscription
as well as the number of issues registered in the database (all types)
this number is used to see if a subscription can be deleted (=it must have only 1 issue)
+$statuses is an arrayref of statuses and is mandatory.
+
=cut
sub GetSerials2 {
- my ( $subscription, $status ) = @_;
+ my ( $subscription, $statuses ) = @_;
+
+ return unless ($subscription and @$statuses);
+
+ my $statuses_string = join ',', @$statuses;
+
my $dbh = C4::Context->dbh;
my $query = qq|
SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
FROM serial
- WHERE subscriptionid=$subscription AND status IN ($status)
+ WHERE subscriptionid=$subscription AND status IN ($statuses_string)
ORDER BY publisheddate,serialid DESC
|;
$debug and warn "GetSerials2 query: $query";
$line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
# Format dates for display
for my $datefield ( qw( planneddate publisheddate ) ) {
- if ($line->{$datefield} =~m/^00/) {
+ if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
$line->{$datefield} = q{};
}
else {
sub GetLatestSerials {
my ( $subscriptionid, $limit ) = @_;
+
+ return unless ($subscriptionid and $limit);
+
my $dbh = C4::Context->dbh;
- # status = 2 is "arrived"
- my $strsth = "SELECT serialid,serialseq, status, planneddate, notes
+ my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
+ my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
FROM serial
WHERE subscriptionid = ?
- AND (status =2 or status=4)
+ AND status IN ($statuses)
ORDER BY publisheddate DESC LIMIT 0,$limit
";
my $sth = $dbh->prepare($strsth);
while ( my $line = $sth->fetchrow_hashref ) {
$line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
$line->{"planneddate"} = format_date( $line->{"planneddate"} );
+ $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
push @serials, $line;
}
sub GetDistributedTo {
my $dbh = C4::Context->dbh;
my $distributedto;
- my $subscriptionid = @_;
+ my ($subscriptionid) = @_;
+
+ return unless ($subscriptionid);
+
my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
my $sth = $dbh->prepare($query);
$sth->execute($subscriptionid);
=head2 GetNextSeq
-GetNextSeq($val)
-$val is a hashref containing all the attributes of the table 'subscription'
+ my (
+ $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
+ $newinnerloop1, $newinnerloop2, $newinnerloop3
+ ) = GetNextSeq( $subscription, $pattern, $planneddate );
+
+$subscription is a hashref containing all the attributes of the table
+'subscription'.
+$pattern is a hashref containing all the attributes of the table
+'subscription_numberpatterns'.
+$planneddate is a C4::Dates object.
This function get the next issue for the subscription given on input arg
-return:
-a list containing all the input params updated.
=cut
-# sub GetNextSeq {
-# my ($val) =@_;
-# my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
-# $calculated = $val->{numberingmethod};
-# # calculate the (expected) value of the next issue recieved.
-# $newlastvalue1 = $val->{lastvalue1};
-# # check if we have to increase the new value.
-# $newinnerloop1 = $val->{innerloop1}+1;
-# $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
-# $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
-# $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
-# $calculated =~ s/\{X\}/$newlastvalue1/g;
-#
-# $newlastvalue2 = $val->{lastvalue2};
-# # check if we have to increase the new value.
-# $newinnerloop2 = $val->{innerloop2}+1;
-# $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
-# $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
-# $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
-# $calculated =~ s/\{Y\}/$newlastvalue2/g;
-#
-# $newlastvalue3 = $val->{lastvalue3};
-# # check if we have to increase the new value.
-# $newinnerloop3 = $val->{innerloop3}+1;
-# $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
-# $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
-# $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
-# $calculated =~ s/\{Z\}/$newlastvalue3/g;
-# return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
-# }
-
sub GetNextSeq {
- my ($val) = @_;
- my ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3 );
- my $pattern = $val->{numberpattern};
- my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
- my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
- $calculated = $val->{numberingmethod};
- $newlastvalue1 = $val->{lastvalue1};
- $newlastvalue2 = $val->{lastvalue2};
- $newlastvalue3 = $val->{lastvalue3};
- $newlastvalue1 = $val->{lastvalue1};
-
- # check if we have to increase the new value.
- $newinnerloop1 = $val->{innerloop1} + 1;
- $newinnerloop1 = 0 if ( $newinnerloop1 >= $val->{every1} );
- $newlastvalue1 += $val->{add1} if ( $newinnerloop1 < 1 ); # <1 to be true when 0 or empty.
- $newlastvalue1 = $val->{setto1} if ( $newlastvalue1 > $val->{whenmorethan1} ); # reset counter if needed.
- $calculated =~ s/\{X\}/$newlastvalue1/g;
-
- $newlastvalue2 = $val->{lastvalue2};
-
- # check if we have to increase the new value.
- $newinnerloop2 = $val->{innerloop2} + 1;
- $newinnerloop2 = 0 if ( $newinnerloop2 >= $val->{every2} );
- $newlastvalue2 += $val->{add2} if ( $newinnerloop2 < 1 ); # <1 to be true when 0 or empty.
- $newlastvalue2 = $val->{setto2} if ( $newlastvalue2 > $val->{whenmorethan2} ); # reset counter if needed.
- if ( $pattern == 6 ) {
- if ( $val->{hemisphere} == 2 ) {
- my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
- $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
- } else {
- my $newlastvalue2seq = $seasons[$newlastvalue2];
- $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
+ my ($subscription, $pattern, $planneddate) = @_;
+
+ return unless ($subscription and $pattern);
+
+ my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
+ $newinnerloop1, $newinnerloop2, $newinnerloop3 );
+ my $count = 1;
+
+ if ($subscription->{'skip_serialseq'}) {
+ my @irreg = split /;/, $subscription->{'irregularity'};
+ if(@irreg > 0) {
+ my $irregularities = {};
+ $irregularities->{$_} = 1 foreach(@irreg);
+ my $issueno = GetFictiveIssueNumber($subscription, $planneddate) + 1;
+ while($irregularities->{$issueno}) {
+ $count++;
+ $issueno++;
+ }
}
- } else {
- $calculated =~ s/\{Y\}/$newlastvalue2/g;
}
- $newlastvalue3 = $val->{lastvalue3};
+ my $numberingmethod = $pattern->{numberingmethod};
+ my $calculated = "";
+ if ($numberingmethod) {
+ $calculated = $numberingmethod;
+ my $locale = $subscription->{locale};
+ $newlastvalue1 = $subscription->{lastvalue1} || 0;
+ $newlastvalue2 = $subscription->{lastvalue2} || 0;
+ $newlastvalue3 = $subscription->{lastvalue3} || 0;
+ $newinnerloop1 = $subscription->{innerloop1} || 0;
+ $newinnerloop2 = $subscription->{innerloop2} || 0;
+ $newinnerloop3 = $subscription->{innerloop3} || 0;
+ my %calc;
+ foreach(qw/X Y Z/) {
+ $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
+ }
- # check if we have to increase the new value.
- $newinnerloop3 = $val->{innerloop3} + 1;
- $newinnerloop3 = 0 if ( $newinnerloop3 >= $val->{every3} );
- $newlastvalue3 += $val->{add3} if ( $newinnerloop3 < 1 ); # <1 to be true when 0 or empty.
- $newlastvalue3 = $val->{setto3} if ( $newlastvalue3 > $val->{whenmorethan3} ); # reset counter if needed.
- $calculated =~ s/\{Z\}/$newlastvalue3/g;
+ for(my $i = 0; $i < $count; $i++) {
+ if($calc{'X'}) {
+ # check if we have to increase the new value.
+ $newinnerloop1 += 1;
+ if ($newinnerloop1 >= $pattern->{every1}) {
+ $newinnerloop1 = 0;
+ $newlastvalue1 += $pattern->{add1};
+ }
+ # reset counter if needed.
+ $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
+ }
+ if($calc{'Y'}) {
+ # check if we have to increase the new value.
+ $newinnerloop2 += 1;
+ if ($newinnerloop2 >= $pattern->{every2}) {
+ $newinnerloop2 = 0;
+ $newlastvalue2 += $pattern->{add2};
+ }
+ # reset counter if needed.
+ $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
+ }
+ if($calc{'Z'}) {
+ # check if we have to increase the new value.
+ $newinnerloop3 += 1;
+ if ($newinnerloop3 >= $pattern->{every3}) {
+ $newinnerloop3 = 0;
+ $newlastvalue3 += $pattern->{add3};
+ }
+ # reset counter if needed.
+ $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
+ }
+ }
+ if($calc{'X'}) {
+ my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
+ $calculated =~ s/\{X\}/$newlastvalue1string/g;
+ }
+ if($calc{'Y'}) {
+ my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
+ $calculated =~ s/\{Y\}/$newlastvalue2string/g;
+ }
+ if($calc{'Z'}) {
+ my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
+ $calculated =~ s/\{Z\}/$newlastvalue3string/g;
+ }
+ }
- return ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3 );
+ return ($calculated,
+ $newlastvalue1, $newlastvalue2, $newlastvalue3,
+ $newinnerloop1, $newinnerloop2, $newinnerloop3);
}
=head2 GetSeq
-$calculated = GetSeq($val)
-$val is a hashref containing all the attributes of the table 'subscription'
+$calculated = GetSeq($subscription, $pattern)
+$subscription is a hashref containing all the attributes of the table 'subscription'
+$pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
this function transforms {X},{Y},{Z} to 150,0,0 for example.
return:
-the sequence in integer format
+the sequence in string format
=cut
sub GetSeq {
- my ($val) = @_;
- my $pattern = $val->{numberpattern};
- my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
- my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
- my $calculated = $val->{numberingmethod};
- my $x = $val->{'lastvalue1'};
- $calculated =~ s/\{X\}/$x/g;
- my $newlastvalue2 = $val->{'lastvalue2'};
-
- if ( $pattern == 6 ) {
- if ( $val->{hemisphere} == 2 ) {
- my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
- $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
- } else {
- my $newlastvalue2seq = $seasons[$newlastvalue2];
- $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
- }
- } else {
- $calculated =~ s/\{Y\}/$newlastvalue2/g;
- }
- my $z = $val->{'lastvalue3'};
- $calculated =~ s/\{Z\}/$z/g;
+ my ($subscription, $pattern) = @_;
+
+ return unless ($subscription and $pattern);
+
+ my $locale = $subscription->{locale};
+
+ my $calculated = $pattern->{numberingmethod};
+
+ my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
+ $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
+ $calculated =~ s/\{X\}/$newlastvalue1/g;
+
+ my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
+ $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
+ $calculated =~ s/\{Y\}/$newlastvalue2/g;
+
+ my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
+ $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
+ $calculated =~ s/\{Z\}/$newlastvalue3/g;
return $calculated;
}
sub GetExpirationDate {
my ( $subscriptionid, $startdate ) = @_;
+
+ return unless ($subscriptionid);
+
my $dbh = C4::Context->dbh;
my $subscription = GetSubscription($subscriptionid);
my $enddate;
# we don't do the same test if the subscription is based on X numbers or on X weeks/months
$enddate = $startdate || $subscription->{startdate};
my @date = split( /-/, $enddate );
+
return if ( scalar(@date) != 3 || not check_date(@date) );
- if ( ( $subscription->{periodicity} % 16 ) > 0 ) {
+
+ my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
+ if ( $frequency and $frequency->{unit} ) {
# If Not Irregular
if ( my $length = $subscription->{numberlength} ) {
#calculate the date of the last issue.
for ( my $i = 1 ; $i <= $length ; $i++ ) {
- $enddate = GetNextDate( $enddate, $subscription );
+ $enddate = GetNextDate( $subscription, $enddate );
}
} elsif ( $subscription->{monthlength} ) {
if ( $$subscription{startdate} ) {
my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
$enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
}
+ } else {
+ $enddate = $subscription->{enddate};
}
return $enddate;
} else {
- return;
+ return $subscription->{enddate};
}
}
sub CountSubscriptionFromBiblionumber {
my ($biblionumber) = @_;
+
+ return unless ($biblionumber);
+
my $dbh = C4::Context->dbh;
my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
my $sth = $dbh->prepare($query);
=cut
sub ModSubscriptionHistory {
- my ( $subscriptionid, $histstartdate, $enddate, $recievedlist, $missinglist, $opacnote, $librariannote ) = @_;
+ my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
+
+ return unless ($subscriptionid);
+
my $dbh = C4::Context->dbh;
my $query = "UPDATE subscriptionhistory
SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
WHERE subscriptionid=?
";
my $sth = $dbh->prepare($query);
- $recievedlist =~ s/^; //;
- $missinglist =~ s/^; //;
- $opacnote =~ s/^; //;
- $sth->execute( $histstartdate, $enddate, $recievedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
+ $receivedlist =~ s/^; // if $receivedlist;
+ $missinglist =~ s/^; // if $missinglist;
+ $opacnote =~ s/^; // if $opacnote;
+ $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
return $sth->rows;
}
sub ModSerialStatus {
my ( $serialid, $serialseq, $planneddate, $publisheddate, $status, $notes ) = @_;
+ return unless ($serialid);
+
#It is a usual serial
# 1st, get previous status :
my $dbh = C4::Context->dbh;
- my $query = "SELECT subscriptionid,status FROM serial WHERE serialid=?";
+ my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity
+ FROM serial, subscription
+ WHERE serial.subscriptionid=subscription.subscriptionid
+ AND serialid=?";
my $sth = $dbh->prepare($query);
$sth->execute($serialid);
- my ( $subscriptionid, $oldstatus ) = $sth->fetchrow;
+ my ( $subscriptionid, $oldstatus, $periodicity ) = $sth->fetchrow;
+ my $frequency = GetSubscriptionFrequency($periodicity);
# change status & update subscriptionhistory
my $val;
- if ( $status == 6 ) {
- DelIssue( {'serialid'=>$serialid, 'subscriptionid'=>$subscriptionid,'serialseq'=>$serialseq} );
- }
- else {
- my $query =
-'UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?';
+ if ( $status == DELETED ) {
+ DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
+ } else {
+
+ my $query = 'UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?';
$sth = $dbh->prepare($query);
$sth->execute( $serialseq, $publisheddate, $planneddate, $status, $notes, $serialid );
$query = "SELECT * FROM subscription WHERE subscriptionid = ?";
$sth = $dbh->prepare($query);
$sth->execute($subscriptionid);
my ( $missinglist, $recievedlist ) = $sth->fetchrow;
- if ( $status == 2 ) {
+ if ( $status == ARRIVED || ($oldstatus == ARRIVED && $status != ARRIVED) ) {
$recievedlist .= "; $serialseq"
- unless ( index( "$recievedlist", "$serialseq" ) >= 0 );
+ if ($recievedlist !~ /(^|;)\s*$serialseq(?=;|$)/);
+ }
+
+ # in case serial has been previously marked as missing
+ if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
+ $missinglist=~ s/(^|;)\s*$serialseq(?=;|$)//g;
}
- # warn "missinglist : $missinglist serialseq :$serialseq, ".index("$missinglist","$serialseq");
$missinglist .= "; $serialseq"
- if ( $status == 4
- and not index( "$missinglist", "$serialseq" ) >= 0 );
+ if ( ( grep { $_ == $status } ( MISSING_STATUSES ) ) && ( $missinglist !~/(^|;)\s*$serialseq(?=;|$)/ ) );
$missinglist .= "; not issued $serialseq"
- if ( $status == 5
- and index( "$missinglist", "$serialseq" ) >= 0 );
+ if ( $status == NOT_ISSUED && $missinglist !~ /(^|;)\s*$serialseq(?=;|$)/ );
+
$query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
$sth = $dbh->prepare($query);
$recievedlist =~ s/^; //;
}
# create new waited entry if needed (ie : was a "waited" and has changed)
- if ( $oldstatus == 1 && $status != 1 ) {
- my $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
- $sth = $dbh->prepare($query);
- $sth->execute($subscriptionid);
- my $val = $sth->fetchrow_hashref;
+ if ( $oldstatus == EXPECTED && $status != EXPECTED ) {
+ my $subscription = GetSubscription($subscriptionid);
+ my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
# next issue number
my (
$newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
$newinnerloop1, $newinnerloop2, $newinnerloop3
- ) = GetNextSeq($val);
+ )
+ = GetNextSeq( $subscription, $pattern, $publisheddate );
# next date (calculated from actual date & frequency parameters)
- my $nextpublisheddate = GetNextDate( $publisheddate, $val );
- NewIssue( $newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextpublisheddate, $nextpublisheddate );
+ my $nextpublisheddate = GetNextDate($subscription, $publisheddate, 1);
+ my $nextpubdate = $nextpublisheddate;
+ NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate );
$query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
WHERE subscriptionid = ?";
$sth = $dbh->prepare($query);
$sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
-# check if an alert must be sent... (= a letter is defined & status became "arrived"
- if ( $val->{letter} && $status == 2 && $oldstatus != 2 ) {
+ # check if an alert must be sent... (= a letter is defined & status became "arrived"
+ if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
require C4::Letters;
- C4::Letters::SendAlerts( 'issue', $val->{subscriptionid}, $val->{letter} );
+ C4::Letters::SendAlerts( 'issue', $subscription->{subscriptionid}, $subscription->{letter} );
}
}
+
return;
}
$nextexepected = {
serialid => int
- planneddate => C4::Dates object
+ planneddate => ISO date
}
=cut
sub GetNextExpected {
my ($subscriptionid) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare('SELECT serialid, planneddate FROM serial WHERE subscriptionid=? AND status=?');
-
- # Each subscription has only one 'expected' issue, with serial.status==1.
- $sth->execute( $subscriptionid, 1 );
- my ( $nextissue ) = $sth->fetchrow_hashref;
- if( !$nextissue){
- $sth = $dbh->prepare('SELECT serialid,planneddate FROM serial WHERE subscriptionid = ? ORDER BY planneddate DESC LIMIT 1');
- $sth->execute( $subscriptionid );
- $nextissue = $sth->fetchrow_hashref;
+
+ my $dbh = C4::Context->dbh;
+ my $query = qq{
+ SELECT *
+ FROM serial
+ WHERE subscriptionid = ?
+ AND status = ?
+ LIMIT 1
+ };
+ my $sth = $dbh->prepare($query);
+
+ # Each subscription has only one 'expected' issue.
+ $sth->execute( $subscriptionid, EXPECTED );
+ my $nextissue = $sth->fetchrow_hashref;
+ if ( !$nextissue ) {
+ $query = qq{
+ SELECT *
+ FROM serial
+ WHERE subscriptionid = ?
+ ORDER BY publisheddate DESC
+ LIMIT 1
+ };
+ $sth = $dbh->prepare($query);
+ $sth->execute($subscriptionid);
+ $nextissue = $sth->fetchrow_hashref;
}
- if (!defined $nextissue->{planneddate}) {
- # or should this default to 1st Jan ???
- $nextissue->{planneddate} = strftime('%Y-%m-%d',localtime);
+ foreach(qw/planneddate publisheddate/) {
+ if ( !defined $nextissue->{$_} ) {
+ # or should this default to 1st Jan ???
+ $nextissue->{$_} = strftime( '%Y-%m-%d', localtime );
+ }
+ $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
+ ? $nextissue->{$_}
+ : undef;
}
- $nextissue->{planneddate} = C4::Dates->new($nextissue->{planneddate},'iso');
- return $nextissue;
+ return $nextissue;
}
=head2 ModNextExpected
Update the planneddate for the current expected issue of the subscription.
This will modify all future prediction results.
-C<$date> is a C4::Dates object.
+C<$date> is an ISO date.
returns 0
#FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
- # Each subscription has only one 'expected' issue, with serial.status==1.
- $sth->execute( $date->output('iso'), $date->output('iso'), $subscriptionid, 1 );
+ # Each subscription has only one 'expected' issue.
+ $sth->execute( $date, $date, $subscriptionid, EXPECTED );
return 0;
}
+=head2 GetSubscriptionIrregularities
+
+=over 4
+
+=item @irreg = &GetSubscriptionIrregularities($subscriptionid);
+get the list of irregularities for a subscription
+
+=back
+
+=cut
+
+sub GetSubscriptionIrregularities {
+ my $subscriptionid = shift;
+
+ return unless $subscriptionid;
+
+ my $dbh = C4::Context->dbh;
+ my $query = qq{
+ SELECT irregularity
+ FROM subscription
+ WHERE subscriptionid = ?
+ };
+ my $sth = $dbh->prepare($query);
+ $sth->execute($subscriptionid);
+
+ my ($result) = $sth->fetchrow_array;
+ my @irreg = split /;/, $result;
+
+ return @irreg;
+}
+
=head2 ModSubscription
this function modifies a subscription. Put all new values on input args.
=cut
sub ModSubscription {
- my ($auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate, $periodicity, $firstacquidate,
- $dow, $irregularity, $numberpattern, $numberlength, $weeklength, $monthlength, $add1, $every1,
- $whenmorethan1, $setto1, $lastvalue1, $innerloop1, $add2, $every2, $whenmorethan2, $setto2,
- $lastvalue2, $innerloop2, $add3, $every3, $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
- $numberingmethod, $status, $biblionumber, $callnumber, $notes, $letter, $hemisphere, $manualhistory,
- $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate, $subscriptionid
+ my (
+ $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
+ $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
+ $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
+ $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
+ $biblionumber, $callnumber, $notes, $letter, $manualhistory,
+ $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
+ $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq
) = @_;
- # warn $irregularity;
my $dbh = C4::Context->dbh;
my $query = "UPDATE subscription
- SET librarian=?, branchcode=?,aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
- periodicity=?,firstacquidate=?,dow=?,irregularity=?, numberpattern=?, numberlength=?,weeklength=?,monthlength=?,
- add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
- add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
- add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
- numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?,
- letter=?, hemisphere=?,manualhistory=?,internalnotes=?,serialsadditems=?,
- staffdisplaycount = ?,opacdisplaycount = ?, graceperiod = ?, location = ?
- ,enddate=?
- WHERE subscriptionid = ?";
-
- #warn "query :".$query;
+ SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?,
+ startdate=?, periodicity=?, firstacquidate=?, irregularity=?,
+ numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?,
+ lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?,
+ lastvalue3=?, innerloop3=?, status=?, biblionumber=?,
+ callnumber=?, notes=?, letter=?, manualhistory=?,
+ internalnotes=?, serialsadditems=?, staffdisplaycount=?,
+ opacdisplaycount=?, graceperiod=?, location = ?, enddate=?,
+ skip_serialseq=?
+ WHERE subscriptionid = ?";
+
my $sth = $dbh->prepare($query);
$sth->execute(
$auser, $branchcode, $aqbooksellerid, $cost,
$aqbudgetid, $startdate, $periodicity, $firstacquidate,
- $dow, "$irregularity", $numberpattern, $numberlength,
- $weeklength, $monthlength, $add1, $every1,
- $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
- $add2, $every2, $whenmorethan2, $setto2,
- $lastvalue2, $innerloop2, $add3, $every3,
- $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
- $numberingmethod, $status, $biblionumber, $callnumber,
- $notes, $letter, $hemisphere, ( $manualhistory ? $manualhistory : 0 ),
+ $irregularity, $numberpattern, $locale, $numberlength,
+ $weeklength, $monthlength, $lastvalue1, $innerloop1,
+ $lastvalue2, $innerloop2, $lastvalue3, $innerloop3,
+ $status, $biblionumber, $callnumber, $notes,
+ $letter, ($manualhistory ? $manualhistory : 0),
$internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
- $graceperiod, $location, $enddate, $subscriptionid
+ $graceperiod, $location, $enddate, $skip_serialseq,
+ $subscriptionid
);
my $rows = $sth->rows;
=head2 NewSubscription
$subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
- $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
- $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
- $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
- $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
- $numberingmethod, $status, $notes, $serialsadditems,
- $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate);
+ $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
+ $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
+ $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
+ $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
+ $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq);
Create a new subscription with value given on input args.
=cut
sub NewSubscription {
- my ($auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber, $startdate, $periodicity,
- $dow, $numberlength, $weeklength, $monthlength, $add1, $every1, $whenmorethan1, $setto1,
- $lastvalue1, $innerloop1, $add2, $every2, $whenmorethan2, $setto2, $lastvalue2, $innerloop2,
- $add3, $every3, $whenmorethan3, $setto3, $lastvalue3, $innerloop3, $numberingmethod, $status,
- $notes, $letter, $firstacquidate, $irregularity, $numberpattern, $callnumber, $hemisphere, $manualhistory,
- $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate
+ my (
+ $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
+ $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
+ $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
+ $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
+ $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
+ $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
+ $location, $enddate, $skip_serialseq
) = @_;
my $dbh = C4::Context->dbh;
#save subscription (insert into database)
my $query = qq|
INSERT INTO subscription
- (librarian,branchcode,aqbooksellerid,cost,aqbudgetid,biblionumber,
- startdate,periodicity,dow,numberlength,weeklength,monthlength,
- add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
- add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
- add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
- numberingmethod, status, notes, letter,firstacquidate,irregularity,
- numberpattern, callnumber, hemisphere,manualhistory,internalnotes,serialsadditems,
- staffdisplaycount,opacdisplaycount,graceperiod,location,enddate)
- VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
+ (librarian, branchcode, aqbooksellerid, cost, aqbudgetid,
+ biblionumber, startdate, periodicity, numberlength, weeklength,
+ monthlength, lastvalue1, innerloop1, lastvalue2, innerloop2,
+ lastvalue3, innerloop3, status, notes, letter, firstacquidate,
+ irregularity, numberpattern, locale, callnumber,
+ manualhistory, internalnotes, serialsadditems, staffdisplaycount,
+ opacdisplaycount, graceperiod, location, enddate, skip_serialseq)
+ VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|;
my $sth = $dbh->prepare($query);
$sth->execute(
- $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber, $startdate, $periodicity,
- $dow, $numberlength, $weeklength, $monthlength, $add1, $every1, $whenmorethan1, $setto1,
- $lastvalue1, $innerloop1, $add2, $every2, $whenmorethan2, $setto2, $lastvalue2, $innerloop2,
- $add3, $every3, $whenmorethan3, $setto3, $lastvalue3, $innerloop3, $numberingmethod, "$status",
- $notes, $letter, $firstacquidate, $irregularity, $numberpattern, $callnumber, $hemisphere, $manualhistory,
- $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate
+ $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
+ $startdate, $periodicity, $numberlength, $weeklength,
+ $monthlength, $lastvalue1, $innerloop1, $lastvalue2, $innerloop2,
+ $lastvalue3, $innerloop3, $status, $notes, $letter,
+ $firstacquidate, $irregularity, $numberpattern, $locale, $callnumber,
+ $manualhistory, $internalnotes, $serialsadditems, $staffdisplaycount,
+ $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq
);
my $subscriptionid = $dbh->{'mysql_insertid'};
- unless ($enddate){
- $enddate = GetExpirationDate($subscriptionid,$startdate);
- $query = q|
+ unless ($enddate) {
+ $enddate = GetExpirationDate( $subscriptionid, $startdate );
+ $query = qq|
UPDATE subscription
SET enddate=?
WHERE subscriptionid=?
$sth = $dbh->prepare($query);
$sth->execute( $enddate, $subscriptionid );
}
- #then create the 1st waited number
+
+ # then create the 1st expected number
$query = qq(
INSERT INTO subscriptionhistory
- (biblionumber, subscriptionid, histstartdate, opacnote, librariannote)
- VALUES (?,?,?,?,?)
+ (biblionumber, subscriptionid, histstartdate)
+ VALUES (?,?,?)
);
$sth = $dbh->prepare($query);
- $sth->execute( $biblionumber, $subscriptionid, $startdate, $notes, $internalnotes );
+ $sth->execute( $biblionumber, $subscriptionid, $startdate);
# reread subscription to get a hash (for calculation of the 1st issue number)
- $query = qq(
- SELECT *
- FROM subscription
- WHERE subscriptionid = ?
- );
- $sth = $dbh->prepare($query);
- $sth->execute($subscriptionid);
- my $val = $sth->fetchrow_hashref;
+ my $subscription = GetSubscription($subscriptionid);
+ my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
# calculate issue number
- my $serialseq = GetSeq($val);
+ my $serialseq = GetSeq($subscription, $pattern) || q{};
$query = qq|
INSERT INTO serial
(serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
VALUES (?,?,?,?,?,?)
|;
$sth = $dbh->prepare($query);
- $sth->execute( "$serialseq", $subscriptionid, $biblionumber, 1, $firstacquidate, $firstacquidate );
+ $sth->execute( $serialseq, $subscriptionid, $biblionumber, EXPECTED, $firstacquidate, $firstacquidate );
logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
#set serial flag on biblio if not already set.
my $bib = GetBiblio($biblionumber);
- if ( !$bib->{'serial'} ) {
+ if ( $bib and !$bib->{'serial'} ) {
my $record = GetMarcBiblio($biblionumber);
my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $bib->{'frameworkcode'} );
if ($tag) {
# renew subscription
$query = qq|
UPDATE subscription
- SET startdate=?,numberlength=?,weeklength=?,monthlength=?
+ SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
WHERE subscriptionid=?
|;
$sth = $dbh->prepare($query);
my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate, $publisheddate, $notes ) = @_;
### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
+ return unless ($subscriptionid);
+
my $dbh = C4::Context->dbh;
my $query = qq|
INSERT INTO serial
$sth->execute($subscriptionid);
my ( $missinglist, $recievedlist ) = $sth->fetchrow;
- if ( $status == 2 ) {
+ if ( $status == ARRIVED ) {
### TODO Add a feature that improves recognition and description.
### As such count (serialseq) i.e. : N18,2(N19),N20
### Would use substr and index But be careful to previous presence of ()
$recievedlist .= "; $serialseq" unless (index($recievedlist,$serialseq)>0);
}
- if ( $status == 4 ) {
+ if ( grep {/^$status$/} ( MISSING_STATUSES ) ) {
$missinglist .= "; $serialseq" unless (index($missinglist,$serialseq)>0);
}
$query = qq|
sub ItemizeSerials {
my ( $serialid, $info ) = @_;
+
+ return unless ($serialid);
+
my $now = POSIX::strftime( "%Y-%m-%d", localtime );
my $dbh = C4::Context->dbh;
# Getting end of subscription date
my ($subscriptionid) = @_;
+
+ return unless ($subscriptionid);
+
my $dbh = C4::Context->dbh;
my $subscription = GetSubscription($subscriptionid);
my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
sub HasSubscriptionExpired {
my ($subscriptionid) = @_;
+
+ return unless ($subscriptionid);
+
my $dbh = C4::Context->dbh;
my $subscription = GetSubscription($subscriptionid);
- if ( ( $subscription->{periodicity} % 16 ) > 0 ) {
+ my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
+ if ( $frequency and $frequency->{unit} ) {
my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
if (!defined $expirationdate) {
$expirationdate = q{};
|| ( !$res ) );
return 0;
} else {
+ # Irregular
if ( $subscription->{'numberlength'} ) {
my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
return 1 if ( $countreceived > $subscription->{'numberlength'} );
@issuelist = GetLateMissingIssues($supplierid,$serialid)
-this function selects missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
+this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
return :
the issuelist as an array of hash refs. Each element of this array contains
sub GetLateOrMissingIssues {
my ( $supplierid, $serialid, $order ) = @_;
+
+ return unless ( $supplierid or $serialid );
+
my $dbh = C4::Context->dbh;
my $sth;
my $byserial = '';
} else {
$order = "title";
}
+ my $missing_statuses_string = join ',', (MISSING_STATUSES);
if ($supplierid) {
$sth = $dbh->prepare(
"SELECT
serialid, aqbooksellerid, name,
- biblio.title, planneddate, serialseq,
- serial.status, serial.subscriptionid, claimdate,
+ biblio.title, biblioitems.issn, planneddate, serialseq,
+ serial.status, serial.subscriptionid, claimdate, claims_count,
subscription.branchcode
- FROM serial
- LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
+ FROM serial
+ LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
+ LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
- WHERE subscription.subscriptionid = serial.subscriptionid
- AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3 OR serial.STATUS = 7))
+ WHERE subscription.subscriptionid = serial.subscriptionid
+ AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
AND subscription.aqbooksellerid=$supplierid
$byserial
ORDER BY $order"
);
} else {
$sth = $dbh->prepare(
- "SELECT
+ "SELECT
serialid, aqbooksellerid, name,
biblio.title, planneddate, serialseq,
- serial.status, serial.subscriptionid, claimdate,
+ serial.status, serial.subscriptionid, claimdate, claims_count,
subscription.branchcode
- FROM serial
- LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
+ FROM serial
+ LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
- WHERE subscription.subscriptionid = serial.subscriptionid
- AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3 OR serial.STATUS = 7))
+ WHERE subscription.subscriptionid = serial.subscriptionid
+ AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
$byserial
ORDER BY $order"
);
}
- $sth->execute;
+ $sth->execute( EXPECTED, LATE, CLAIMED );
my @issuelist;
while ( my $line = $sth->fetchrow_hashref ) {
if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
+ $line->{planneddateISO} = $line->{planneddate};
$line->{planneddate} = format_date( $line->{planneddate} );
}
if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
+ $line->{claimdateISO} = $line->{claimdate};
$line->{claimdate} = format_date( $line->{claimdate} );
}
$line->{"status".$line->{status}} = 1;
sub removeMissingIssue {
my ( $sequence, $subscriptionid ) = @_;
+
+ return unless ($sequence and $subscriptionid);
+
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
$sth->execute($subscriptionid);
sub updateClaim {
my ($serialid) = @_;
my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare(
- "UPDATE serial SET claimdate = now()
- WHERE serialid = ?
- "
- );
- $sth->execute($serialid);
+ $dbh->do(q|
+ UPDATE serial
+ SET claimdate = NOW(),
+ claims_count = claims_count + 1
+ WHERE serialid = ?
+ |, {}, $serialid );
return;
}
sub check_routing {
my ($subscriptionid) = @_;
+
+ return unless ($subscriptionid);
+
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare(
"SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
sub addroutingmember {
my ( $borrowernumber, $subscriptionid ) = @_;
+
+ return unless ($borrowernumber and $subscriptionid);
+
my $rank;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
my $dbh = C4::Context->dbh;
my $subscription = GetSubscription($subscriptionid);
my $per = $subscription->{'periodicity'};
- if ($per && $per % 16 > 0){
- my $expirationdate = GetExpirationDate($subscriptionid);
+ my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
+ if ($frequency and $frequency->{unit}){
+
+ my $expirationdate = GetExpirationDate($subscriptionid);
+
my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
- my @res;
- if (defined $res) {
- @res=split (/-/,$res);
- @res=Date::Calc::Today if ($res[0]*$res[1]==0);
- } else { # default an undefined value
- @res=Date::Calc::Today;
+ my $nextdate = GetNextDate($subscription, $res);
+
+ # only compare dates if both dates exist.
+ if ($nextdate and $expirationdate) {
+ if(Date::Calc::Delta_Days(
+ split( /-/, $nextdate ),
+ split( /-/, $expirationdate )
+ ) <= 0) {
+ return 1;
+ }
}
- my @endofsubscriptiondate=split(/-/,$expirationdate);
- my @per_list = (0, 7, 7, 14, 21, 31, 62, 93, 93, 190, 365, 730, 0, 124, 0, 0);
- my @datebeforeend;
- @datebeforeend = Add_Delta_Days( $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
- - (3 * $per_list[$per])) if (@endofsubscriptiondate && $endofsubscriptiondate[0]*$endofsubscriptiondate[1]*$endofsubscriptiondate[2]);
- return 1 if ( @res &&
- (@datebeforeend &&
- Delta_Days($res[0],$res[1],$res[2],
- $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) &&
- (@endofsubscriptiondate &&
- Delta_Days($res[0],$res[1],$res[2],
- $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
- return 0;
+
} elsif ($subscription->{numberlength}>0) {
return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
}
+
return 0;
}
return ( $count, @routinglist );
}
+
+=head2 GetFictiveIssueNumber
+
+$issueno = GetFictiveIssueNumber($subscription, $publishedate);
+
+Get the position of the issue published at $publisheddate, considering the
+first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
+This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
+issue is declared as 'irregular' (will be skipped at receipt), the next issue number
+will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
+depending on how many rows are in serial table.
+The issue number calculation is based on subscription frequency, first acquisition
+date, and $publisheddate.
+
+=cut
+
+sub GetFictiveIssueNumber {
+ my ($subscription, $publisheddate) = @_;
+
+ my $frequency = GetSubscriptionFrequency($subscription->{'periodicity'});
+ my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
+ my $issueno = 0;
+
+ if($unit) {
+ my ($year, $month, $day) = split /-/, $publisheddate;
+ my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{'firstacquidate'};
+ my $wkno;
+ my $delta;
+
+ if($unit eq 'day') {
+ $delta = Delta_Days($fa_year, $fa_month, $fa_day, $year, $month, $day);
+ } elsif($unit eq 'week') {
+ ($wkno, $year) = Week_of_Year($year, $month, $day);
+ my ($fa_wkno, $fa_yr) = Week_of_Year($fa_year, $fa_month, $fa_day);
+ $delta = ($fa_yr == $year) ? ($wkno - $fa_wkno) : ( ($year-$fa_yr-1)*52 + (52-$fa_wkno+$wkno) );
+ } elsif($unit eq 'month') {
+ $delta = ($fa_year == $year)
+ ? ($month - $fa_month)
+ : ( ($year-$fa_year-1)*12 + (12-$fa_month+$month) );
+ } elsif($unit eq 'year') {
+ $delta = $year - $fa_year;
+ }
+ if($frequency->{'unitsperissue'} == 1) {
+ $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
+ } else {
+ # Assuming issuesperunit == 1
+ $issueno = int( ($delta + $frequency->{'unitsperissue'}) / $frequency->{'unitsperissue'} );
+ }
+ }
+ return $issueno;
+}
+
=head2 GetNextDate
-$resultdate = GetNextDate($planneddate,$subscription)
+$resultdate = GetNextDate($publisheddate,$subscription)
-this function it takes the planneddate and will return the next issue's date and will skip dates if there
-exists an irregularity
-- eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
+this function it takes the publisheddate and will return the next issue's date
+and will skip dates if there exists an irregularity.
+$publisheddate has to be an ISO date
+$subscription is a hashref containing at least 'periodicity', 'firstacquidate', 'irregularity', and 'countissuesperunit'
+$updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
+- eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
skipped then the returned date will be 2007-05-10
return :
-$resultdate - then next date in the sequence
+$resultdate - then next date in the sequence (ISO date)
-Return 0 if periodicity==0
+Return undef if subscription is irregular
=cut
sub GetNextDate {
- my ( $planneddate, $subscription ) = @_;
- my @irreg = split( /\,/, $subscription->{irregularity} );
+ my ( $subscription, $publisheddate, $updatecount ) = @_;
- #date supposed to be in ISO.
+ return unless $subscription and $publisheddate;
- my ( $year, $month, $day ) = split( /-/, $planneddate );
- $month = 1 unless ($month);
- $day = 1 unless ($day);
- my @resultdate;
+ my $freqdata = GetSubscriptionFrequency($subscription->{'periodicity'});
- # warn "DOW $dayofweek";
- if ( $subscription->{periodicity} % 16 == 0 ) { # 'without regularity' || 'irregular'
- return 0;
- }
+ if ($freqdata->{'unit'}) {
+ my ( $year, $month, $day ) = split /-/, $publisheddate;
- # daily : n / week
- # Since we're interpreting irregularity here as which days of the week to skip an issue,
- # renaming this pattern from 1/day to " n / week ".
- if ( $subscription->{periodicity} == 1 ) {
- my $dayofweek = eval { Day_of_Week( $year, $month, $day ) };
- if ($@) { warn "year month day : $year $month $day $subscription->{subscriptionid} : $@"; }
- else {
- for ( my $i = 0 ; $i < @irreg ; $i++ ) {
- $dayofweek = 0 if ( $dayofweek == 7 );
- if ( in_array( ( $dayofweek + 1 ), @irreg ) ) {
- ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 1 );
- $dayofweek++;
- }
+ # Process an irregularity Hash
+ # Suppose that irregularities are stored in a string with this structure
+ # irreg1;irreg2;irreg3
+ # where irregX is the number of issue which will not be received
+ # (the first issue takes the number 1, the 2nd the number 2 and so on)
+ my %irregularities;
+ if ( $subscription->{irregularity} ) {
+ my @irreg = split /;/, $subscription->{'irregularity'} ;
+ foreach my $irregularity (@irreg) {
+ $irregularities{$irregularity} = 1;
}
- @resultdate = Add_Delta_Days( $year, $month, $day, 1 );
}
- }
- # 1 week
- if ( $subscription->{periodicity} == 2 ) {
- my ( $wkno, $year ) = eval { Week_of_Year( $year, $month, $day ) };
- if ($@) { warn "year month day : $year $month $day $subscription->{subscriptionid} : $@"; }
- else {
- for ( my $i = 0 ; $i < @irreg ; $i++ ) {
-
- #FIXME: if two consecutive irreg, do we only skip one?
- if ( $irreg[$i] == ( ( $wkno != 51 ) ? ( $wkno + 1 ) % 52 : 52 ) ) {
- ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 7 );
- $wkno = ( ( $wkno != 51 ) ? ( $wkno + 1 ) % 52 : 52 );
+ # Get the 'fictive' next issue number
+ # It is used to check if next issue is an irregular issue.
+ my $issueno = GetFictiveIssueNumber($subscription, $publisheddate) + 1;
+
+ # Then get the next date
+ my $unit = lc $freqdata->{'unit'};
+ if ($unit eq 'day') {
+ while ($irregularities{$issueno}) {
+ if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
+ ($year,$month,$day) = Add_Delta_Days($year,$month, $day , $freqdata->{'unitsperissue'} );
+ $subscription->{'countissuesperunit'} = 1;
+ } else {
+ $subscription->{'countissuesperunit'}++;
}
+ $issueno++;
}
- @resultdate = Add_Delta_Days( $year, $month, $day, 7 );
- }
- }
-
- # 1 / 2 weeks
- if ( $subscription->{periodicity} == 3 ) {
- my ( $wkno, $year ) = eval { Week_of_Year( $year, $month, $day ) };
- if ($@) { warn "year month day : $year $month $day $subscription->{subscriptionid} : $@"; }
- else {
- for ( my $i = 0 ; $i < @irreg ; $i++ ) {
- if ( $irreg[$i] == ( ( $wkno != 50 ) ? ( $wkno + 2 ) % 52 : 52 ) ) {
- ### BUGFIX was previously +1 ^
- ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 14 );
- $wkno = ( ( $wkno != 50 ) ? ( $wkno + 2 ) % 52 : 52 );
- }
+ if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
+ ($year,$month,$day) = Add_Delta_Days($year,$month, $day , $freqdata->{"unitsperissue"} );
+ $subscription->{'countissuesperunit'} = 1;
+ } else {
+ $subscription->{'countissuesperunit'}++;
}
- @resultdate = Add_Delta_Days( $year, $month, $day, 14 );
}
- }
-
- # 1 / 3 weeks
- if ( $subscription->{periodicity} == 4 ) {
- my ( $wkno, $year ) = eval { Week_of_Year( $year, $month, $day ) };
- if ($@) { warn "année mois jour : $year $month $day $subscription->{subscriptionid} : $@"; }
- else {
- for ( my $i = 0 ; $i < @irreg ; $i++ ) {
- if ( $irreg[$i] == ( ( $wkno != 49 ) ? ( $wkno + 3 ) % 52 : 52 ) ) {
- ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 21 );
- $wkno = ( ( $wkno != 49 ) ? ( $wkno + 3 ) % 52 : 52 );
+ elsif ($unit eq 'week') {
+ my ($wkno, $yr) = Week_of_Year($year, $month, $day);
+ while ($irregularities{$issueno}) {
+ if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
+ $subscription->{'countissuesperunit'} = 1;
+ $wkno += $freqdata->{"unitsperissue"};
+ if($wkno > 52){
+ $wkno = $wkno % 52;
+ $yr++;
+ }
+ my $dow = Day_of_Week($year, $month, $day);
+ ($year,$month,$day) = Monday_of_Week($wkno, $yr);
+ if($freqdata->{'issuesperunit'} == 1) {
+ ($year, $month, $day) = Add_Delta_Days($year, $month, $day, $dow - 1);
+ }
+ } else {
+ $subscription->{'countissuesperunit'}++;
}
+ $issueno++;
}
- @resultdate = Add_Delta_Days( $year, $month, $day, 21 );
- }
- }
- my $tmpmonth = $month;
- if ( $year && $month && $day ) {
- if ( $subscription->{periodicity} == 5 ) {
- for ( my $i = 0 ; $i < @irreg ; $i++ ) {
- if ( $irreg[$i] == ( ( $tmpmonth != 11 ) ? ( $tmpmonth + 1 ) % 12 : 12 ) ) {
- ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 1, 0 );
- $tmpmonth = ( ( $tmpmonth != 11 ) ? ( $tmpmonth + 1 ) % 12 : 12 );
+ if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
+ $subscription->{'countissuesperunit'} = 1;
+ $wkno += $freqdata->{"unitsperissue"};
+ if($wkno > 52){
+ $wkno = $wkno % 52 ;
+ $yr++;
}
- }
- @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 1, 0 );
- }
- if ( $subscription->{periodicity} == 6 ) {
- for ( my $i = 0 ; $i < @irreg ; $i++ ) {
- if ( $irreg[$i] == ( ( $tmpmonth != 10 ) ? ( $tmpmonth + 2 ) % 12 : 12 ) ) {
- ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 2, 0 );
- $tmpmonth = ( ( $tmpmonth != 10 ) ? ( $tmpmonth + 2 ) % 12 : 12 );
+ my $dow = Day_of_Week($year, $month, $day);
+ ($year,$month,$day) = Monday_of_Week($wkno, $yr);
+ if($freqdata->{'issuesperunit'} == 1) {
+ ($year, $month, $day) = Add_Delta_Days($year, $month, $day, $dow - 1);
}
+ } else {
+ $subscription->{'countissuesperunit'}++;
}
- @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 2, 0 );
}
- if ( $subscription->{periodicity} == 7 ) {
- for ( my $i = 0 ; $i < @irreg ; $i++ ) {
- if ( $irreg[$i] == ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 ) ) {
- ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 );
- $tmpmonth = ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 );
+ elsif ($unit eq 'month') {
+ while ($irregularities{$issueno}) {
+ if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
+ $subscription->{'countissuesperunit'} = 1;
+ ($year,$month,$day) = Add_Delta_YM($year,$month,$day, 0,$freqdata->{"unitsperissue"});
+ unless($freqdata->{'issuesperunit'} == 1) {
+ $day = 1; # Jumping to the first day of month, because we don't know what day is expected
+ }
+ } else {
+ $subscription->{'countissuesperunit'}++;
}
+ $issueno++;
}
- @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 );
- }
- if ( $subscription->{periodicity} == 8 ) {
- for ( my $i = 0 ; $i < @irreg ; $i++ ) {
- if ( $irreg[$i] == ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 ) ) {
- ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 );
- $tmpmonth = ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 );
+ if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
+ $subscription->{'countissuesperunit'} = 1;
+ ($year,$month,$day) = Add_Delta_YM($year,$month,$day, 0,$freqdata->{"unitsperissue"});
+ unless($freqdata->{'issuesperunit'} == 1) {
+ $day = 1; # Jumping to the first day of month, because we don't know what day is expected
}
+ } else {
+ $subscription->{'countissuesperunit'}++;
}
- @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 );
}
- if ( $subscription->{periodicity} == 13 ) {
- for ( my $i = 0 ; $i < @irreg ; $i++ ) {
- if ( $irreg[$i] == ( ( $tmpmonth != 8 ) ? ( $tmpmonth + 4 ) % 12 : 12 ) ) {
- ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 4, 0 );
- $tmpmonth = ( ( $tmpmonth != 8 ) ? ( $tmpmonth + 4 ) % 12 : 12 );
+ elsif ($unit eq 'year') {
+ while ($irregularities{$issueno}) {
+ if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
+ $subscription->{'countissuesperunit'} = 1;
+ ($year,$month,$day) = Add_Delta_YM($year,$month,$day, $freqdata->{"unitsperissue"},0);
+ unless($freqdata->{'issuesperunit'} == 1) {
+ # Jumping to the first day of year, because we don't know what day is expected
+ $month = 1;
+ $day = 1;
+ }
+ } else {
+ $subscription->{'countissuesperunit'}++;
}
+ $issueno++;
}
- @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 4, 0 );
- }
- if ( $subscription->{periodicity} == 9 ) {
- for ( my $i = 0 ; $i < @irreg ; $i++ ) {
- if ( $irreg[$i] == ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 ) ) {
- ### BUFIX Seems to need more Than One ?
- ( $year, $month, $day ) = Add_Delta_YM( $year, $month, $day, 0, 6 );
- $tmpmonth = ( ( $tmpmonth != 6 ) ? ( $tmpmonth + 6 ) % 12 : 12 );
+ if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
+ $subscription->{'countissuesperunit'} = 1;
+ ($year,$month,$day) = Add_Delta_YM($year,$month,$day, $freqdata->{"unitsperissue"},0);
+ unless($freqdata->{'issuesperunit'} == 1) {
+ # Jumping to the first day of year, because we don't know what day is expected
+ $month = 1;
+ $day = 1;
}
+ } else {
+ $subscription->{'countissuesperunit'}++;
}
- @resultdate = Add_Delta_YM( $year, $month, $day, 0, 6 );
- }
- if ( $subscription->{periodicity} == 10 ) {
- @resultdate = Add_Delta_YM( $year, $month, $day, 1, 0 );
}
- if ( $subscription->{periodicity} == 11 ) {
- @resultdate = Add_Delta_YM( $year, $month, $day, 2, 0 );
+ if ($updatecount){
+ my $dbh = C4::Context->dbh;
+ my $query = qq{
+ UPDATE subscription
+ SET countissuesperunit = ?
+ WHERE subscriptionid = ?
+ };
+ my $sth = $dbh->prepare($query);
+ $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
}
+ return sprintf("%04d-%02d-%02d", $year, $month, $day);
}
- my $resultdate = sprintf( "%04d-%02d-%02d", $resultdate[0], $resultdate[1], $resultdate[2] );
+}
+
+=head2 _numeration
+
+ $string = &_numeration($value,$num_type,$locale);
+
+_numeration returns the string corresponding to $value in the num_type
+num_type can take :
+ -dayname
+ -monthname
+ -season
+=cut
- return "$resultdate";
+#'
+
+sub _numeration {
+ my ($value, $num_type, $locale) = @_;
+ $value ||= 0;
+ $num_type //= '';
+ $locale ||= 'en';
+ my $string;
+ if ( $num_type =~ /^dayname$/ ) {
+ # 1970-11-01 was a Sunday
+ $value = $value % 7;
+ my $dt = DateTime->new(
+ year => 1970,
+ month => 11,
+ day => $value + 1,
+ locale => $locale,
+ );
+ $string = $dt->strftime("%A");
+ } elsif ( $num_type =~ /^monthname$/ ) {
+ $value = $value % 12;
+ my $dt = DateTime->new(
+ year => 1970,
+ month => $value + 1,
+ locale => $locale,
+ );
+ $string = $dt->strftime("%B");
+ } elsif ( $num_type =~ /^season$/ ) {
+ my @seasons= qw( Spring Summer Fall Winter );
+ $value = $value % 4;
+ $string = $seasons[$value];
+ } else {
+ $string = $value;
+ }
+
+ return $string;
}
=head2 is_barcode_in_use
my ( $subscriptionid ) = @_;
return unless $subscriptionid;
my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare( qq{
+ my $sth = $dbh->prepare( q{
UPDATE subscription
SET closed = 1
WHERE subscriptionid = ?
$sth->execute( $subscriptionid );
# Set status = missing when status = stopped
- $sth = $dbh->prepare( qq{
+ $sth = $dbh->prepare( q{
UPDATE serial
- SET status = 8
+ SET status = ?
WHERE subscriptionid = ?
- AND status = 1
+ AND status = ?
} );
- $sth->execute( $subscriptionid );
+ $sth->execute( STOPPED, $subscriptionid, EXPECTED );
}
=head2 ReopenSubscription
my ( $subscriptionid ) = @_;
return unless $subscriptionid;
my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare( qq{
+ my $sth = $dbh->prepare( q{
UPDATE subscription
SET closed = 0
WHERE subscriptionid = ?
$sth->execute( $subscriptionid );
# Set status = expected when status = stopped
- $sth = $dbh->prepare( qq{
+ $sth = $dbh->prepare( q{
UPDATE serial
- SET status = 1
+ SET status = ?
WHERE subscriptionid = ?
- AND status = 8
+ AND status = ?
} );
- $sth->execute( $subscriptionid );
+ $sth->execute( EXPECTED, $subscriptionid, STOPPED );
+}
+
+=head2 subscriptionCurrentlyOnOrder
+
+ $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
+
+Return 1 if subscription is currently on order else 0.
+
+=cut
+
+sub subscriptionCurrentlyOnOrder {
+ my ( $subscriptionid ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query = qq|
+ SELECT COUNT(*) FROM aqorders
+ WHERE subscriptionid = ?
+ AND datereceived IS NULL
+ AND datecancellationprinted IS NULL
+ |;
+ my $sth = $dbh->prepare( $query );
+ $sth->execute($subscriptionid);
+ return $sth->fetchrow_array;
+}
+
+=head2 can_edit_subscription
+
+ $can = can_edit_subscription( $subscriptionid[, $userid] );
+
+Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
+
+=cut
+
+sub can_edit_subscription {
+ my ( $subscription, $userid ) = @_;
+ return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
+}
+
+=head2 can_show_subscription
+
+ $can = can_show_subscription( $subscriptionid[, $userid] );
+
+Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
+
+=cut
+
+sub can_show_subscription {
+ my ( $subscription, $userid ) = @_;
+ return _can_do_on_subscription( $subscription, $userid, '*' );
+}
+
+sub _can_do_on_subscription {
+ my ( $subscription, $userid, $permission ) = @_;
+ return 0 unless C4::Context->userenv;
+ my $flags = C4::Context->userenv->{flags};
+ $userid ||= C4::Context->userenv->{'id'};
+
+ if ( C4::Context->preference('IndependentBranches') ) {
+ return 1
+ if C4::Context->IsSuperLibrarian()
+ or
+ C4::Auth::haspermission( $userid, { serials => 'superserials' } )
+ or (
+ C4::Auth::haspermission( $userid,
+ { serials => $permission } )
+ and ( not defined $subscription->{branchcode}
+ or $subscription->{branchcode} eq ''
+ or $subscription->{branchcode} eq
+ C4::Context->userenv->{'branch'} )
+ );
+ }
+ else {
+ return 1
+ if C4::Context->IsSuperLibrarian()
+ or
+ C4::Auth::haspermission( $userid, { serials => 'superserials' } )
+ or C4::Auth::haspermission(
+ $userid, { serials => $permission }
+ ),
+ ;
+ }
+ return 0;
}
1;