package C4::Serials; #assumes C4/Serials.pm
# Copyright 2000-2002 Katipo Communications
#
# 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 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., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
# $Id$
use strict;
use C4::Date;
use Date::Manip;
use C4::Suggestions;
use C4::Biblio;
use C4::Search;
use C4::Letters;
require Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# set the version for version checking
$VERSION = do { my @v = '$Revision$' =~ /\d+/g;
shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
=head1 NAME
C4::Serials - Give functions for serializing.
=head1 SYNOPSIS
use C4::Serials;
=head1 DESCRIPTION
Give all XYZ functions
=head1 FUNCTIONS
=cut
@ISA = qw(Exporter);
@EXPORT = qw(
&NewSubscription &ModSubscription &DelSubscription &GetSubscriptions &GetSubscription
&CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
&GetFullSubscriptionsFromBiblionumber &GetNextSeq
&ModSubscriptionHistory &NewIssue
&GetSerials &GetLatestSerials &ModSerialStatus
&HasSubscriptionExpired &GetSubscriptionExpirationDate &ReNewSubscription
&GetSuppliersWithLateIssues &GetLateIssues &GetMissingIssues
&GetDistributedTo &SetDistributedto
&getroutinglist &delroutingmember &addroutingmember &reorder_members
&check_routing &getsupplierbyserialid &updateClaim &removeMissingIssue &abouttoexpire
&Get_Next_Date
);
=head2 GetSuppliersWithLateIssues
=over 4
%supplierlist = &GetSuppliersWithLateIssues
this function get all suppliers with late issues.
return :
the supplierlist into a hash. this hash containts id & name of the supplier
=back
=cut
sub GetSuppliersWithLateIssues {
my $dbh = C4::Context->dbh;
my $query = qq|
SELECT DISTINCT id, name
FROM subscription, serial
LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
WHERE subscription.subscriptionid = serial.subscriptionid
AND (planneddate < now() OR serial.STATUS = 3 OR serial.STATUS = 4)
|;
my $sth = $dbh->prepare($query);
$sth->execute;
my %supplierlist;
while (my ($id,$name) = $sth->fetchrow) {
$supplierlist{$id} = $name;
}
if(C4::Context->preference("RoutingSerials")){
$supplierlist{''} = "All Suppliers";
}
return %supplierlist;
}
=head2 GetLateIssues
=over 4
@issuelist = &GetLateIssues($supplierid)
this function select late issues on database
return :
the issuelist into an table. Each line of this table containts a ref to a hash which it containts
name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
=back
=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, serial, biblio
LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
WHERE subscription.subscriptionid = serial.subscriptionid
AND ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
AND subscription.aqbooksellerid=$supplierid
AND biblio.biblionumber = subscription.biblionumber
ORDER BY title
|;
$sth = $dbh->prepare($query);
} else {
my $query = qq|
SELECT name,title,planneddate,serialseq,serial.subscriptionid
FROM subscription, serial, biblio
LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
WHERE subscription.subscriptionid = serial.subscriptionid
AND ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
AND biblio.biblionumber = subscription.biblionumber
ORDER BY title
|;
$sth = $dbh->prepare($query);
}
$sth->execute;
my @issuelist;
my $last_title;
my $odd=0;
my $count=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});
$line->{'odd'} = 1 if $odd %2 ;
$count++;
push @issuelist,$line;
}
return $count,@issuelist;
}
=head2 GetSubscriptionHistoryFromSubscriptionId
=over 4
$sth = GetSubscriptionHistoryFromSubscriptionId()
this function just prepare the SQL request.
After this function, don't forget to execute it by using $sth->execute($subscriptionid)
return :
$sth = $dbh->prepare($query).
=back
=cut
sub GetSubscriptionHistoryFromSubscriptionId() {
my $dbh = C4::Context->dbh;
my $query = qq|
SELECT *
FROM subscriptionhistory
WHERE subscriptionid = ?
|;
return $dbh->prepare($query);
}
=head2 GetSerialStatusFromSerialId
=over 4
$sth = GetSerialStatusFromSerialId();
this function just prepare the SQL request.
After this function, don't forget to execute it by using $sth->execute($serialid)
return :
$sth = $dbh->prepare($query).
=back
=cut
sub GetSerialStatusFromSerialId(){
my $dbh = C4::Context->dbh;
my $query = qq|
SELECT status
FROM serial
WHERE serialid = ?
|;
return $dbh->prepare($query);
}
=head2 GetSubscription
=over 4
$subs = GetSubscription($subscriptionid)
this function get the subscription which has $subscriptionid as id.
return :
a hashref. This hash containts
subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
=back
=cut
sub GetSubscription {
my ($subscriptionid) = @_;
my $dbh = C4::Context->dbh;
my $query =qq(
SELECT subscription.*,
subscriptionhistory.*,
aqbudget.bookfundid,
aqbooksellers.name AS aqbooksellername,
biblio.title AS bibliotitle
FROM subscription
LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
WHERE subscription.subscriptionid = ?
);
my $sth = $dbh->prepare($query);
$sth->execute($subscriptionid);
my $subs = $sth->fetchrow_hashref;
return $subs;
}
=head2 GetSubscriptionsFromBiblionumber
=over 4
\@res = GetSubscriptionsFromBiblionumber($biblionumber)
this function get the subscription list. it reads on subscription table.
return :
table of subscription which has the biblionumber given on input arg.
each line of this table is a hashref. All hashes containt
planned, histstartdate,opacnote,missinglist,receivedlist,periodicity,status & enddate
=back
=cut
sub GetSubscriptionsFromBiblionumber {
my ($biblionumber) = @_;
my $dbh = C4::Context->dbh;
my $query = qq(
SELECT subscription.*,
subscriptionhistory.*,
aqbudget.bookfundid,
aqbooksellers.name AS aqbooksellername,
biblio.title AS bibliotitle
FROM subscription
LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
WHERE subscription.biblionumber = ?
);
my $sth = $dbh->prepare($query);
$sth->execute($biblionumber);
my @res;
while (my $subs = $sth->fetchrow_hashref) {
$subs->{planneddate} = format_date($subs->{planneddate});
$subs->{publisheddate} = format_date($subs->{publisheddate});
$subs->{histstartdate} = format_date($subs->{histstartdate});
$subs->{opacnote} =~ s/\n/\
/g;
$subs->{missinglist} =~ s/\n/\
/g;
$subs->{receivedlist} =~ s/\n/\
/g;
$subs->{"periodicity".$subs->{periodicity}} = 1;
$subs->{"status".$subs->{'status'}} = 1;
if ($subs->{enddate} eq '0000-00-00') {
$subs->{enddate}='';
} else {
$subs->{enddate} = format_date($subs->{enddate});
}
push @res,$subs;
}
return \@res;
}
=head2 GetFullSubscriptionsFromBiblionumber
=over 4
\@res = GetFullSubscriptionsFromBiblionumber($biblionumber)
this function read on serial table.
=back
=cut
sub GetFullSubscriptionsFromBiblionumber {
my ($biblionumber) = @_;
my $dbh = C4::Context->dbh;
my $query=qq|
SELECT serial.serialseq,
serial.planneddate,
serial.publisheddate,
serial.status,
serial.notes,
year(serial.publisheddate) AS year,
aqbudget.bookfundid,aqbooksellers.name AS aqbooksellername,
biblio.title AS bibliotitle
FROM serial
LEFT JOIN subscription ON
(serial.subscriptionid=subscription.subscriptionid AND subscription.biblionumber=serial.biblionumber)
LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
WHERE subscription.biblionumber = ?
ORDER BY year,serial.publisheddate,serial.subscriptionid,serial.planneddate
|;
my $sth = $dbh->prepare($query);
$sth->execute($biblionumber);
my @res;
my $year;
my $startdate;
my $aqbooksellername;
my $bibliotitle;
my @loopissues;
my $first;
my $previousnote="";
while (my $subs = $sth->fetchrow_hashref) {
### BUG To FIX: When there is no published date, will create many null ids!!!
if ($year and ($year==$subs->{year})){
if ($first eq 1){$first=0;}
my $temp=$res[scalar(@res)-1]->{'serials'};
push @$temp,
{'publisheddate' =>format_date($subs->{'publisheddate'}),
'planneddate' => format_date($subs->{'planneddate'}),
'serialseq' => $subs->{'serialseq'},
"status".$subs->{'status'} => 1,
'notes' => $subs->{'notes'} eq $previousnote?"":$subs->{notes},
};
} else {
$first=1 if (not $year);
$year= $subs->{'year'};
$startdate= format_date($subs->{'startdate'});
$aqbooksellername= $subs->{'aqbooksellername'};
$bibliotitle= $subs->{'bibliotitle'};
my @temp;
push @temp,
{'publisheddate' =>format_date($subs->{'publisheddate'}),
'planneddate' => format_date($subs->{'planneddate'}),
'serialseq' => $subs->{'serialseq'},
"status".$subs->{'status'} => 1,
'notes' => $subs->{'notes'} eq $previousnote?"":$subs->{notes},
};
push @res,{
'year'=>$year,
'startdate'=>$startdate,
'aqbooksellername'=>$aqbooksellername,
'bibliotitle'=>$bibliotitle,
'serials'=>\@temp,
'first'=>$first
};
}
$previousnote=$subs->{notes};
}
return \@res;
}
=head2 GetSubscriptions
=over 4
@results = GetSubscriptions($title,$ISSN,$biblionumber);
this function get all subscriptions which has title like $title,ISSN like $ISSN and biblionumber like $biblionumber.
return:
a table of hashref. Each hash containt the subscription.
=back
=cut
sub GetSubscriptions {
my ($title,$ISSN,$biblionumber) = @_;
return unless $title or $ISSN or $biblionumber;
my $dbh = C4::Context->dbh;
my $sth;
if ($biblionumber) {
my $query = qq(
SELECT subscription.subscriptionid,biblio.title,biblio.issn,subscription.notes,biblio.biblionumber
FROM subscription,biblio
WHERE biblio.biblionumber = subscription.biblionumber
AND biblio.biblionumber=?
ORDER BY title
);
$sth = $dbh->prepare($query);
$sth->execute($biblionumber);
} else {
if ($ISSN and $title){
my $query = qq|
SELECT subscription.subscriptionid,biblio.title,biblio.issn,subscription.notes,biblio.biblionumber
FROM subscription,biblio
WHERE biblio.biblionumber= subscription.biblionumber
AND (biblio.title LIKE ? or biblio.issn = ?)
ORDER BY title
|;
$sth = $dbh->prepare($query);
$sth->execute("%$title%",$ISSN);
}
else{
if ($ISSN){
my $query = qq(
SELECT subscription.subscriptionid,biblio.title,biblio.issn,subscription.notes,biblio.biblionumber
FROM subscription,biblio
WHERE biblio.biblionumber = biblioitems.biblionumber
AND biblio.biblionumber=subscription.biblionumber
AND biblioitems.issn = ?
ORDER BY title
);
$sth = $dbh->prepare($query);
$sth->execute($ISSN);
} else {
my $query = qq(
SELECT subscription.subscriptionid,biblio.title,biblio.issn,subscription.notes,biblio.biblionumber
FROM subscription,biblio
WHERE biblio.biblionumber=subscription.biblionumber
AND biblio.title LIKE ?
ORDER BY title
);
$sth = $dbh->prepare($query);
$sth->execute("%$title%");
}
}
}
my @results;
my $previoustitle="";
my $odd=1;
while (my $line = $sth->fetchrow_hashref) {
if ($previoustitle eq $line->{title}) {
$line->{title}="";
$line->{issn}="";
$line->{toggle} = 1 if $odd==1;
} else {
$previoustitle=$line->{title};
$odd=-$odd;
$line->{toggle} = 1 if $odd==1;
}
push @results, $line;
}
return @results;
}
=head2 GetSerials
=over 4
($totalissues,@serials) = GetSerials($subscriptionid);
this function get every serial not arrived 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)
=back
=cut
sub GetSerials {
my ($subscriptionid) = @_;
my $dbh = C4::Context->dbh;
my $counter=0;
my @serials;
# status = 2 is "arrived"
my $query = qq|
SELECT *
FROM serial
WHERE subscriptionid = ? AND status NOT IN (2,4,5)
|;
my $sth=$dbh->prepare($query);
$sth->execute($subscriptionid);
while(my $line = $sth->fetchrow_hashref) {
$line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
$line->{"publisheddate"} = format_date($line->{"publisheddate"});
$line->{"planneddate"} = format_date($line->{"planneddate"});
push @serials,$line;
}
# OK, now add the last 5 issues arrived/missing
my $query = qq|
SELECT *
FROM serial
WHERE subscriptionid = ?
AND (status in (2,4,5))
ORDER BY serialid DESC
|;
my $sth=$dbh->prepare($query);
$sth->execute($subscriptionid);
while((my $line = $sth->fetchrow_hashref) && $counter <5) {
$counter++;
$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;
}
my $query = qq|
SELECT count(*)
FROM serial
WHERE subscriptionid=?
|;
$sth=$dbh->prepare($query);
$sth->execute($subscriptionid);
my ($totalissues) = $sth->fetchrow;
return ($totalissues,@serials);
}
=head2 GetLatestSerials
=over 4
\@serials = GetLatestSerials($subscriptionid,$limit)
get the $limit's latest serials arrived or missing for a given subscription
return :
a ref to a table which it containts all of the latest serials stored into a hash.
=back
=cut
sub GetLatestSerials {
my ($subscriptionid,$limit) = @_;
my $dbh = C4::Context->dbh;
# status = 2 is "arrived"
my $strsth=qq(
SELECT serialid,serialseq, status, planneddate
FROM serial
WHERE subscriptionid = ?
AND (status =2 or status=4)
ORDER BY planneddate DESC LIMIT 0,$limit
);
my $sth=$dbh->prepare($strsth);
$sth->execute($subscriptionid);
my @serials;
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"});
push @serials,$line;
}
# my $query = qq|
# SELECT count(*)
# FROM serial
# WHERE subscriptionid=?
# |;
# $sth=$dbh->prepare($query);
# $sth->execute($subscriptionid);
# my ($totalissues) = $sth->fetchrow;
return \@serials;
}
=head2 GetDistributedTo
=over 4
$distributedto=GetDistributedTo($subscriptionid)
This function select the old previous value of distributedto in the database.
=back
=cut
sub GetDistributedTo {
my $dbh = C4::Context->dbh;
my $distributedto;
my $subscriptionid = @_;
my $query = qq|
SELECT distributedto
FROM subscription
WHERE subscriptionid=?
|;
my $sth = $dbh->prepare($query);
$sth->execute($subscriptionid);
return ($distributedto) = $sth->fetchrow;
}
=head2 GetNextSeq
=over 4
GetNextSeq($val)
$val is a hashref containing all the attributes of the table 'subscription'
This function get the next issue for the subscription given on input arg
return:
all the input params updated.
=back
=cut
sub GetNextSeq {
my ($val) =@_;
my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
$calculated = $val->{numberingmethod};
# calculate the (expected) value of the next issue received.
$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 New_Get_Next_Seq {
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};
if($newlastvalue3 > 0){ # if x y and z columns are used
$newlastvalue3 = $newlastvalue3+1;
if($newlastvalue3 > $val->{whenmorethan3}){
$newlastvalue3 = $val->{setto3};
$newlastvalue2++;
if($newlastvalue2 > $val->{whenmorethan2}){
$newlastvalue1++;
$newlastvalue2 = $val->{setto2};
}
}
$calculated =~ s/\{X\}/$newlastvalue1/g;
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;
}
$calculated =~ s/\{Z\}/$newlastvalue3/g;
}
if($newlastvalue2 > 0 && $newlastvalue3 < 1){ # if x and y columns are used
$newlastvalue2 = $newlastvalue2+1;
if($newlastvalue2 > $val->{whenmorethan2}){
$newlastvalue2 = $val->{setto2};
$newlastvalue1++;
}
$calculated =~ s/\{X\}/$newlastvalue1/g;
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;
}
}
if($newlastvalue1 > 0 && $newlastvalue2 < 1 && $newlastvalue3 < 1){ # if column x only
$newlastvalue1 = $newlastvalue1+1;
if($newlastvalue1 > $val->{whenmorethan1}){
$newlastvalue1 = $val->{setto2};
}
$calculated =~ s/\{X\}/$newlastvalue1/g;
}
return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3);
}
=head2 GetNextDate
=over 4
$resultdate = GetNextDate($planneddate,$subscription)
this function get the date after $planneddate.
return:
the date on ISO format.
=back
=cut
sub GetNextDate(@) {
my ($planneddate,$subscription) = @_;
my $resultdate;
if ($subscription->{periodicity} == 1) {
$resultdate=DateCalc($planneddate,"1 day");
}
if ($subscription->{periodicity} == 2) {
$resultdate=DateCalc($planneddate,"1 week");
}
if ($subscription->{periodicity} == 3) {
$resultdate=DateCalc($planneddate,"2 weeks");
}
if ($subscription->{periodicity} == 4) {
$resultdate=DateCalc($planneddate,"3 weeks");
}
if ($subscription->{periodicity} == 5) {
$resultdate=DateCalc($planneddate,"1 month");
}
if ($subscription->{periodicity} == 6) {
$resultdate=DateCalc($planneddate,"2 months");
}
if ($subscription->{periodicity} == 7) {
$resultdate=DateCalc($planneddate,"3 months");
}
if ($subscription->{periodicity} == 8) {
$resultdate=DateCalc($planneddate,"3 months");
}
if ($subscription->{periodicity} == 9) {
$resultdate=DateCalc($planneddate,"6 months");
}
if ($subscription->{periodicity} == 10) {
$resultdate=DateCalc($planneddate,"1 year");
}
if ($subscription->{periodicity} == 11) {
$resultdate=DateCalc($planneddate,"2 years");
}
return format_date_in_iso($resultdate);
}
=head2 GetSeq
=over 4
$calculated = GetSeq($val)
$val is a hashref containing all the attributes of the table 'subscription'
this function transforms {X},{Y},{Z} to 150,0,0 for example.
return:
the sequence in integer format
=back
=cut
sub GetSeq {
my ($val) =@_;
my $calculated = $val->{numberingmethod};
my $x=$val->{'lastvalue1'};
$calculated =~ s/\{X\}/$x/g;
my $y=$val->{'lastvalue2'};
$calculated =~ s/\{Y\}/$y/g;
my $z=$val->{'lastvalue3'};
$calculated =~ s/\{Z\}/$z/g;
return $calculated;
}
=head2 GetSubscriptionExpirationDate
=over 4
$sensddate = GetSubscriptionExpirationDate($subscriptionid)
this function return the expiration date for a subscription given on input args.
return
the enddate
=back
=cut
sub GetSubscriptionExpirationDate {
my ($subscriptionid) = @_;
my $dbh = C4::Context->dbh;
my $subscription = GetSubscription($subscriptionid);
my $enddate=$subscription->{startdate};
# we don't do the same test if the subscription is based on X numbers or on X weeks/months
if ($subscription->{numberlength}) {
#calculate the date of the last issue.
for (my $i=1;$i<=$subscription->{numberlength};$i++) {
$enddate = GetNextDate($enddate,$subscription);
}
}
else {
$enddate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
$enddate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
}
return $enddate;
}
=head2 CountSubscriptionFromBiblionumber
=over 4
$subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
this count the number of subscription for a biblionumber given.
return :
the number of subscriptions with biblionumber given on input arg.
=back
=cut
sub CountSubscriptionFromBiblionumber {
my ($biblionumber) = @_;
my $dbh = C4::Context->dbh;
my $query = qq|
SELECT count(*)
FROM subscription
WHERE biblionumber=?
|;
my $sth = $dbh->prepare($query);
$sth->execute($biblionumber);
my $subscriptionsnumber = $sth->fetchrow;
return $subscriptionsnumber;
}
=head2 ModSubscriptionHistory
=over 4
ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$receivedlist,$missinglist,$opacnote,$librariannote);
this function modify the history of a subscription. Put your new values on input arg.
=back
=cut
sub ModSubscriptionHistory {
my ($subscriptionid,$histstartdate,$enddate,$receivedlist,$missinglist,$opacnote,$librariannote)=@_;
my $dbh=C4::Context->dbh;
my $query = qq(
UPDATE subscriptionhistory
SET histstartdate=?,enddate=?,receivedlist=?,missinglist=?,opacnote=?,librariannote=?
WHERE subscriptionid=?
);
my $sth = $dbh->prepare($query);
$receivedlist =~ s/^,//g;
$missinglist =~ s/^,//g;
$opacnote =~ s/^,//g;
$sth->execute($histstartdate,$enddate,$receivedlist,$missinglist,$opacnote,$librariannote,$subscriptionid);
}
=head2 ModSerialStatus
=over 4
ModSerialStatus($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes)
This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
=back
=cut
sub ModSerialStatus {
my ($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes,$itemnumber)=@_;
# 1st, get previous status :
my $dbh = C4::Context->dbh;
my $query = qq|
SELECT subscriptionid,status
FROM serial
WHERE serialid=?
|;
my $sth = $dbh->prepare($query);
$sth->execute($serialid);
my ($subscriptionid,$oldstatus) = $sth->fetchrow;
# change status & update subscriptionhistory
if ($status eq 6){
DelIssue($serialseq, $subscriptionid)
} else {
my $query = qq(
UPDATE serial
SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=?,itemnumber=?
WHERE serialid = ?
);
$sth = $dbh->prepare($query);
$sth->execute($serialseq,format_date_in_iso($publisheddate),format_date_in_iso($planneddate),$status,$notes,$itemnumber,$serialid);
my $query = qq(
SELECT missinglist,receivedlist
FROM subscriptionhistory
WHERE subscriptionid=?
);
$sth = $dbh->prepare($query);
$sth->execute($subscriptionid);
my ($missinglist,$receivedlist) = $sth->fetchrow;
if ($status == 2 && $oldstatus != 2) {
$receivedlist .= ",$serialseq";
}
$missinglist .= ",$serialseq" if ($status eq 4) ;
$missinglist .= ",not issued $serialseq" if ($status eq 5);
my $query = qq(
UPDATE subscriptionhistory
SET receivedlist=?, missinglist=?
WHERE subscriptionid=?
);
$sth=$dbh->prepare($query);
$sth->execute($receivedlist,$missinglist,$subscriptionid);
}
# create new waited entry if needed (ie : was a "waited" and has changed)
if ($oldstatus eq 1 && $status ne 1) {
my $query = qq(
SELECT *
FROM subscription
WHERE subscriptionid = ?
);
$sth = $dbh->prepare($query);
$sth->execute($subscriptionid);
my $val = $sth->fetchrow_hashref;
# next issue number
my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3) = GetNextSeq($val);
# next date (calculated from actual date & frequency parameters)
my $nextplanneddate = Get_Next_Date($planneddate,$val);
my $nextpublisheddate = Get_Next_Date($publisheddate,$val);
NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextpublisheddate,$nextplanneddate,0);
my $query = qq|
UPDATE subscription
SET lastvalue1=?, lastvalue2=?, lastvalue3=?,
innerloop1=?, innerloop2=?, innerloop3=?
WHERE subscriptionid = ?
|;
$sth = $dbh->prepare($query);
$sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3,$subscriptionid);
}
}
=head2 ModSubscription
=over 4
this function modify a subscription. Put all new values on input args.
=back
=cut
sub ModSubscription {
my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$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, $biblionumber, $notes, $letter, $subscriptionid,$irregularity,$hemisphere,$callnumber,$numberpattern,$publisheddate)= @_;
my $dbh = C4::Context->dbh;
my $query = qq|
UPDATE subscription
SET librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,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=?, biblionumber=?, notes=?, letter=?,irregularity=?,hemisphere=?,callnumber=?,numberpattern=? ,publisheddate=?
WHERE subscriptionid = ?
|;
my $sth=$dbh->prepare($query);
$sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$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, $biblionumber, $notes, $letter, $irregularity,$hemisphere,$callnumber,$numberpattern,$publisheddate,$subscriptionid);
$sth->finish;
}
=head2 NewSubscription
=over 4
$subscriptionid = &NewSubscription($auser,$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)
Create a new subscription with value given on input args.
return :
the id of this new subscription
=back
=cut
sub NewSubscription {
my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
$startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
$add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
$add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
$add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
$numberingmethod, $status, $notes, $letter,$irregularity,$hemisphere,$callnumber,$numberpattern,$publisheddate) = @_;
my $dbh = C4::Context->dbh;
#save subscription (insert into database)
my $query = qq|
INSERT INTO subscription
(librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
startdate,periodicity,dow,numberlength,weeklength,monthlength,
add1,every1,whenmorethan1,setto1,lastvalue1,
add2,every2,whenmorethan2,setto2,lastvalue2,
add3,every3,whenmorethan3,setto3,lastvalue3,
numberingmethod, status, notes, letter,irregularity,hemisphere,callnumber,numberpattern,publisheddate)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|;
my $sth=$dbh->prepare($query);
$sth->execute(
$auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
format_date_in_iso($startdate),$periodicity,$dow,$numberlength,$weeklength,$monthlength,
$add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
$add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
$add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
$numberingmethod, $status, $notes, $letter,$irregularity,$hemisphere,$callnumber,$numberpattern,format_date_in_iso($publisheddate));
#then create the 1st waited number
my $subscriptionid = $dbh->{'mysql_insertid'};
my $enddate = GetSubscriptionExpirationDate($subscriptionid);
my $query = qq(
INSERT INTO subscriptionhistory
(biblionumber, subscriptionid, histstartdate, enddate, missinglist, receivedlist, opacnote, librariannote)
VALUES (?,?,?,?,?,?,?,?)
);
$sth = $dbh->prepare($query);
$sth->execute($biblionumber, $subscriptionid, format_date_in_iso($startdate), format_date_in_iso($enddate), "", "", "", $notes);
## User may have subscriptionid stored in MARC so check and fill it
my $record=XMLgetbiblio($dbh,$biblionumber);
$record=XML_xml2hash_onerecord($record);
XML_writeline( $record, "subscriptionid", $subscriptionid,"biblios" );
my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
NEWmodbiblio($dbh,$biblionumber,$record,$frameworkcode);
# reread subscription to get a hash (for calculation of the 1st issue number)
my $query = qq(
SELECT *
FROM subscription
WHERE subscriptionid = ?
);
$sth = $dbh->prepare($query);
$sth->execute($subscriptionid);
my $val = $sth->fetchrow_hashref;
# calculate issue number
my $serialseq = GetSeq($val);
my $query = qq|
INSERT INTO serial
(serialseq,subscriptionid,biblionumber,status, planneddate,publisheddate)
VALUES (?,?,?,?,?,?)
|;
$sth = $dbh->prepare($query);
$sth->execute($serialseq, $subscriptionid, $val->{'biblionumber'}, 1, format_date_in_iso($startdate),format_date_in_iso($publisheddate));
return $subscriptionid;
}
=head2 ReNewSubscription
=over 4
ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
this function renew a subscription with values given on input args.
=back
=cut
sub ReNewSubscription {
my ($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note) = @_;
my $dbh = C4::Context->dbh;
my $subscription = GetSubscription($subscriptionid);
my $record=XMLgetbiblio($dbh,$subscription->{biblionumber});
$record=XML_xml2hash_onerecord($record);
my $biblio = XMLmarc2koha_onerecord($dbh,$record,"biblios");
NewSuggestion($user,$subscription->{bibliotitle},$biblio->{author},$biblio->{publishercode},$biblio->{note},'','','','','',$subscription->{biblionumber});
# renew subscription
my $query = qq|
UPDATE subscription
SET startdate=?,numberlength=?,weeklength=?,monthlength=?
WHERE subscriptionid=?
|;
my $sth=$dbh->prepare($query);
$sth->execute(format_date_in_iso($startdate),$numberlength,$weeklength,$monthlength, $subscriptionid);
}
=head2 NewIssue
=over 4
NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate)
Create a new issue stored on the database.
Note : we have to update the receivedlist and missinglist on subscriptionhistory for this subscription.
=back
=cut
sub NewIssue {
my ($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate,$itemnumber) = @_;
my $dbh = C4::Context->dbh;
my $query = qq|
INSERT INTO serial
(serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,itemnumber)
VALUES (?,?,?,?,?,?,?)
|;
my $sth = $dbh->prepare($query);
$sth->execute($serialseq,$subscriptionid,$biblionumber,$status,format_date_in_iso($publisheddate), format_date_in_iso($planneddate),$itemnumber);
my $query = qq|
SELECT missinglist,receivedlist
FROM subscriptionhistory
WHERE subscriptionid=?
|;
$sth = $dbh->prepare($query);
$sth->execute($subscriptionid);
my ($missinglist,$receivedlist) = $sth->fetchrow;
if ($status eq 2) {
$receivedlist .= ",$serialseq";
}
if ($status eq 4) {
$missinglist .= ",$serialseq";
}
my $query = qq|
UPDATE subscriptionhistory
SET receivedlist=?, missinglist=?
WHERE subscriptionid=?
|;
$sth=$dbh->prepare($query);
$sth->execute($receivedlist,$missinglist,$subscriptionid);
}
=head2 serialchangestatus
=over 4
serialchangestatus($serialid,$serialseq,$planneddate,$status,$notes)
Change the status of a serial issue.
Note: this was the older subroutine
=back
=cut
sub serialchangestatus {
my ($serialid,$serialseq,$planneddate,$status,$notes)=@_;
# 1st, get previous status : if we change from "waited" to something else, then we will have to create a new "waited" entry
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("select subscriptionid,status from serial where serialid=?");
$sth->execute($serialid);
my ($subscriptionid,$oldstatus) = $sth->fetchrow;
# change status & update subscriptionhistory
if ($status eq 6){
delissue($serialseq, $subscriptionid)
}else{
$sth = $dbh->prepare("update serial set serialseq=?,planneddate=?,status=?,notes=? where serialid = ?");
$sth->execute($serialseq,format_date_in_iso($planneddate),$status,$notes,$serialid);
$sth = $dbh->prepare("select missinglist,receivedlist from subscriptionhistory where subscriptionid=?");
$sth->execute($subscriptionid);
my ($missinglist,$receivedlist) = $sth->fetchrow;
if ($status eq 2) {
$receivedlist .= "| $serialseq";
$receivedlist =~ s/^\| //g;
}
$missinglist .= "| $serialseq" if ($status eq 4) ;
$missinglist .= "| not issued $serialseq" if ($status eq 5);
$missinglist =~ s/^\| //g;
$sth=$dbh->prepare("update subscriptionhistory set receivedlist=?, missinglist=? where subscriptionid=?");
$sth->execute($receivedlist,$missinglist,$subscriptionid);
}
# create new waited entry if needed (ie : was a "waited" and has changed)
if ($oldstatus eq 1 && $status ne 1) {
$sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
$sth->execute($subscriptionid);
my $val = $sth->fetchrow_hashref;
# next issue number
my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3) = New_Get_Next_Seq($val);
my $nextplanneddate = Get_Next_Date($planneddate,$val);
NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextplanneddate);
$sth = $dbh->prepare("update subscription set lastvalue1=?, lastvalue2=?,lastvalue3=? where subscriptionid = ?");
$sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$subscriptionid);
}
# check if an alert must be sent... (= a letter is defined & status became "arrived"
$sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
$sth->execute($subscriptionid);
my $subscription = $sth->fetchrow_hashref;
if ($subscription->{letter} && $status eq 2) {
sendalerts('issue',$subscription->{subscriptionid},$subscription->{letter});
}
}
=head2 HasSubscriptionExpired
=over 4
1 or 0 = HasSubscriptionExpired($subscriptionid)
the subscription has expired when the next issue to arrive is out of subscription limit.
return :
1 if true, 0 if false.
=back
=cut
sub HasSubscriptionExpired {
my ($subscriptionid) = @_;
my $dbh = C4::Context->dbh;
my $subscription = GetSubscription($subscriptionid);
# we don't do the same test if the subscription is based on X numbers or on X weeks/months
if ($subscription->{numberlength} ) {
my $query = qq|
SELECT count(*)
FROM serial
WHERE subscriptionid=? AND planneddate>=?
|;
my $sth = $dbh->prepare($query);
$sth->execute($subscriptionid,$subscription->{startdate});
my $res = $sth->fetchrow;
if ($subscription->{numberlength}>=$res) {
return 0;
} else {
return 1;
}
} else {
#a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
my $query = qq|
SELECT max(planneddate)
FROM serial
WHERE subscriptionid=?
|;
my $sth = $dbh->prepare($query);
$sth->execute($subscriptionid);
my $res = ParseDate(format_date_in_iso($sth->fetchrow));
my $endofsubscriptiondate;
$endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
$endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
return 1 if ($res >= $endofsubscriptiondate);
return 0;
}
}
=head2 SetDistributedto
=over 4
SetDistributedto($distributedto,$subscriptionid);
This function update the value of distributedto for a subscription given on input arg.
=back
=cut
sub SetDistributedto {
my ($distributedto,$subscriptionid) = @_;
my $dbh = C4::Context->dbh;
my $query = qq|
UPDATE subscription
SET distributedto=?
WHERE subscriptionid=?
|;
my $sth = $dbh->prepare($query);
$sth->execute($distributedto,$subscriptionid);
}
=head2 DelSubscription
=over 4
DelSubscription($subscriptionid)
this function delete the subscription which has $subscriptionid as id.
=back
=cut
sub DelSubscription {
my ($subscriptionid,$biblionumber) = @_;
my $dbh = C4::Context->dbh;
## User may have subscriptionid stored in MARC so check and remove it
my $record=XMLgetbiblio($dbh,$biblionumber);
$record=XML_xml2hash_onerecord($record);
XML_writeline( $record, "subscriptionid", "","biblios" );
my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
NEWmodbiblio($dbh,$biblionumber,$record,$frameworkcode);
$subscriptionid=$dbh->quote($subscriptionid);
$dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
$dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
$dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
}
=head2 DelIssue
=over 4
DelIssue($serialseq,$subscriptionid)
this function delete an issue which has $serialseq and $subscriptionid given on input arg.
=back
=cut
sub DelIssue {
my ($serialseq,$subscriptionid) = @_;
my $dbh = C4::Context->dbh;
my $query = qq|
DELETE FROM serial
WHERE serialseq= ?
AND subscriptionid= ?
|;
my $sth = $dbh->prepare($query);
$sth->execute($serialseq,$subscriptionid);
}
=head2 GetMissingIssues
=over 4
($count,@issuelist) = &GetMissingIssues($supplierid,$serialid)
this function select missing issues on database - where serial.status = 4
return :
a count of the number of missing issues
the issuelist into a table. Each line of this table containts a ref to a hash which it containts
name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
=back
=cut
sub GetMissingIssues {
my ($supplierid,$serialid) = @_;
my $dbh = C4::Context->dbh;
my $sth;
my $byserial='';
if($serialid) {
$byserial = "and serialid = ".$serialid;
}
if ($supplierid) {
$sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
FROM subscription, serial, biblio
LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
WHERE subscription.subscriptionid = serial.subscriptionid AND
serial.STATUS = 4 and
subscription.aqbooksellerid=$supplierid and
biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
");
} else {
$sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
FROM subscription, serial, biblio
LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
WHERE subscription.subscriptionid = serial.subscriptionid AND
serial.STATUS =4 and
biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
");
}
$sth->execute;
my @issuelist;
my $last_title;
my $odd=0;
my $count=0;
while (my $line = $sth->fetchrow_hashref) {
$odd++ unless $line->{title} eq $last_title;
$last_title = $line->{title} if ($line->{title});
$line->{planneddate} = format_date($line->{planneddate});
$line->{claimdate} = format_date($line->{claimdate});
$line->{'odd'} = 1 if $odd %2 ;
$count++;
push @issuelist,$line;
}
return $count,@issuelist;
}
=head2 removeMissingIssue
=over 4
removeMissingIssue($subscriptionid)
this function removes an issue from being part of the missing string in
subscriptionlist.missinglist column
called when a missing issue is found from the statecollection.pl file
=back
=cut
sub removeMissingIssue {
my ($sequence,$subscriptionid) = @_;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
$sth->execute($subscriptionid);
my $data = $sth->fetchrow_hashref;
my $missinglist = $data->{'missinglist'};
my $missinglistbefore = $missinglist;
# warn $missinglist." before";
$missinglist =~ s/($sequence)//;
# warn $missinglist." after";
if($missinglist ne $missinglistbefore){
$missinglist =~ s/\|\s\|/\|/g;
$missinglist =~ s/^\| //g;
$missinglist =~ s/\|$//g;
my $sth2= $dbh->prepare("UPDATE subscriptionhistory
SET missinglist = ?
WHERE subscriptionid = ?");
$sth2->execute($missinglist,$subscriptionid);
}
}
=head2 updateClaim
=over 4
&updateClaim($serialid)
this function updates the time when a claim is issued for late/missing items
called from claims.pl file
=back
=cut
sub updateClaim {
my ($serialid) = @_;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("UPDATE serial SET claimdate = now()
WHERE serialid = ?
");
$sth->execute($serialid);
}
=head2 getsupplierbyserialid
=over 4
($result) = &getsupplierbyserialid($serialid)
this function is used to find the supplier id given a serial id
return :
hashref containing serialid, subscriptionid, and aqbooksellerid
=back
=cut
sub getsupplierbyserialid {
my ($serialid) = @_;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("SELECT serialid, serial.subscriptionid, aqbooksellerid
FROM serial, subscription
WHERE serial.subscriptionid = subscription.subscriptionid
AND serialid = ?
");
$sth->execute($serialid);
my $line = $sth->fetchrow_hashref;
my $result = $line->{'aqbooksellerid'};
return $result;
}
=head2 check_routing
=over 4
($result) = &check_routing($subscriptionid)
this function checks to see if a serial has a routing list and returns the count of routingid
used to show either an 'add' or 'edit' link
=back
=cut
sub check_routing {
my ($subscriptionid) = @_;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("SELECT count(routingid) routingids FROM subscriptionroutinglist, subscription
WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
AND subscription.subscriptionid = ? ORDER BY ranking ASC
");
$sth->execute($subscriptionid);
my $line = $sth->fetchrow_hashref;
my $result = $line->{'routingids'};
return $result;
}
=head2 addroutingmember
=over 4
&addroutingmember($bornum,$subscriptionid)
this function takes a borrowernumber and subscriptionid and add the member to the
routing list for that serial subscription and gives them a rank on the list
of either 1 or highest current rank + 1
=back
=cut
sub addroutingmember {
my ($bornum,$subscriptionid) = @_;
my $rank;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?");
$sth->execute($subscriptionid);
while(my $line = $sth->fetchrow_hashref){
if($line->{'rank'}>0){
$rank = $line->{'rank'}+1;
} else {
$rank = 1;
}
}
$sth = $dbh->prepare("INSERT INTO subscriptionroutinglist VALUES (null,?,?,?,null)");
$sth->execute($subscriptionid,$bornum,$rank);
}
=head2 reorder_members
=over 4
&reorder_members($subscriptionid,$routingid,$rank)
this function is used to reorder the routing list
it takes the routingid of the member one wants to re-rank and the rank it is to move to
- it gets all members on list puts their routingid's into an array
- removes the one in the array that is $routingid
- then reinjects $routingid at point indicated by $rank
- then update the database with the routingids in the new order
=back
=cut
sub reorder_members {
my ($subscriptionid,$routingid,$rank) = @_;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC");
$sth->execute($subscriptionid);
my @result;
while(my $line = $sth->fetchrow_hashref){
push(@result,$line->{'routingid'});
}
# To find the matching index
my $i;
my $key = -1; # to allow for 0 being a valid response
for ($i = 0; $i < @result; $i++) {
if ($routingid == $result[$i]) {
$key = $i; # save the index
last;
}
}
# if index exists in array then move it to new position
if($key > -1 && $rank > 0){
my $new_rank = $rank-1; # $new_rank is what you want the new index to be in the array
my $moving_item = splice(@result, $key, 1);
splice(@result, $new_rank, 0, $moving_item);
}
for(my $j = 0; $j < @result; $j++){
my $sth = $dbh->prepare("UPDATE subscriptionroutinglist SET ranking = '" . ($j+1) . "' WHERE routingid = '". $result[$j]."'");
$sth->execute;
}
}
=head2 delroutingmember
=over 4
&delroutingmember($routingid,$subscriptionid)
this function either deletes one member from routing list if $routingid exists otherwise
deletes all members from the routing list
=back
=cut
sub delroutingmember {
# if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
my ($routingid,$subscriptionid) = @_;
my $dbh = C4::Context->dbh;
if($routingid){
my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
$sth->execute($routingid);
reorder_members($subscriptionid,$routingid);
} else {
my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
$sth->execute($subscriptionid);
}
}
=head2 getroutinglist
=over 4
($count,@routinglist) = &getroutinglist($subscriptionid)
this gets the info from the subscriptionroutinglist for $subscriptionid
return :
a count of the number of members on routinglist
the routinglist into a table. Each line of this table containts a ref to a hash which containts
routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
=back
=cut
sub getroutinglist {
my ($subscriptionid) = @_;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("SELECT routingid, borrowernumber,
ranking, biblionumber FROM subscriptionroutinglist, subscription
WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
AND subscription.subscriptionid = ? ORDER BY ranking ASC
");
$sth->execute($subscriptionid);
my @routinglist;
my $count=0;
while (my $line = $sth->fetchrow_hashref) {
$count++;
push(@routinglist,$line);
}
return ($count,@routinglist);
}
=head2 abouttoexpire
=over 4
$result = &abouttoexpire($subscriptionid)
this function alerts you to the penultimate issue for a serial subscription
returns 1 - if this is the penultimate issue
returns 0 - if not
=back
=cut
sub abouttoexpire {
my ($subscriptionid) = @_;
my $dbh = C4::Context->dbh;
my $subscription = GetSubscription($subscriptionid);
# we don't do the same test if the subscription is based on X numbers or on X weeks/months
if ($subscription->{numberlength}) {
my $sth = $dbh->prepare("select count(*) from serial where subscriptionid=? and planneddate>=?");
$sth->execute($subscriptionid,$subscription->{startdate});
my $res = $sth->fetchrow;
# warn "length: ".$subscription->{numberlength}." vs count: ".$res;
if ($subscription->{numberlength}==$res) {
return 1;
} else {
return 0;
}
} else {
# a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
my $sth = $dbh->prepare("select max(planneddate) from serial where subscriptionid=?");
$sth->execute($subscriptionid);
my $res = ParseDate(format_date_in_iso($sth->fetchrow));
my $endofsubscriptiondate;
$endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
$endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
# warn "last: ".$endofsubscriptiondate." vs currentdate: ".$res;
my $per = $subscription->{'periodicity'};
my $x = 0;
if ($per == 1) { $x = '1 day'; }
if ($per == 2) { $x = '1 week'; }
if ($per == 3) { $x = '2 weeks'; }
if ($per == 4) { $x = '3 weeks'; }
if ($per == 5) { $x = '1 month'; }
if ($per == 6) { $x = '2 months'; }
if ($per == 7 || $per == 8) { $x = '3 months'; }
if ($per == 9) { $x = '6 months'; }
if ($per == 10) { $x = '1 year'; }
if ($per == 11) { $x = '2 years'; }
my $datebeforeend = DateCalc($endofsubscriptiondate,"- ".$x); # if ($subscription->{weeklength});
# warn "DATE BEFORE END: $datebeforeend";
return 1 if ($res >= $datebeforeend && $res < $endofsubscriptiondate);
return 0;
}
}
=head2 Get_Next_Date
=over 4
($resultdate) = &Get_Next_Date($planneddate,$subscription)
this function is an extension of GetNextDate which allows for checking for irregularity
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
skipped then the returned date will be 2007-05-10
return :
$resultdate - then next date in the sequence
=back
=cut
sub Get_Next_Date(@) {
my ($planneddate,$subscription) = @_;
my @irreg = split(/\|/,$subscription->{irregularity});
my ($year, $month, $day) = UnixDate($planneddate, "%Y", "%m", "%d");
my $dayofweek = Date_DayOfWeek($month,$day,$year);
my $resultdate;
# warn "DOW $dayofweek";
if ($subscription->{periodicity} == 1) {
for(my $i=0;$i<@irreg;$i++){
if($dayofweek == 7){ $dayofweek = 0; }
if(in_array(($dayofweek+1), @irreg)){
$planneddate = DateCalc($planneddate,"1 day");
$dayofweek++;
}
}
$resultdate=DateCalc($planneddate,"1 day");
}
if ($subscription->{periodicity} == 2) {
my $wkno = Date_WeekOfYear($month,$day,$year,1);
for(my $i = 0;$i < @irreg; $i++){
if($wkno > 52) { $wkno = 0; } # need to rollover at January
if($irreg[$i] == ($wkno+1)){
$planneddate = DateCalc($planneddate,"1 week");
$wkno++;
}
}
$resultdate=DateCalc($planneddate,"1 week");
}
if ($subscription->{periodicity} == 3) {
my $wkno = Date_WeekOfYear($month,$day,$year,1);
for(my $i = 0;$i < @irreg; $i++){
if($wkno > 52) { $wkno = 0; } # need to rollover at January
if($irreg[$i] == ($wkno+1)){
$planneddate = DateCalc($planneddate,"2 weeks");
$wkno++;
}
}
$resultdate=DateCalc($planneddate,"2 weeks");
}
if ($subscription->{periodicity} == 4) {
my $wkno = Date_WeekOfYear($month,$day,$year,1);
for(my $i = 0;$i < @irreg; $i++){
if($wkno > 52) { $wkno = 0; } # need to rollover at January
if($irreg[$i] == ($wkno+1)){
$planneddate = DateCalc($planneddate,"3 weeks");
$wkno++;
}
}
$resultdate=DateCalc($planneddate,"3 weeks");
}
if ($subscription->{periodicity} == 5) {
for(my $i = 0;$i < @irreg; $i++){
# warn $irreg[$i];
# warn $month;
if($month == 12) { $month = 0; } # need to rollover to check January
if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
$planneddate = DateCalc($planneddate,"1 month");
$month++; # to check if following ones are to be skipped too
}
}
$resultdate=DateCalc($planneddate,"1 month");
# warn "Planneddate2: $planneddate";
}
if ($subscription->{periodicity} == 6) {
for(my $i = 0;$i < @irreg; $i++){
if($month == 12) { $month = 0; } # need to rollover to check January
if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
$planneddate = DateCalc($planneddate,"2 months");
$month++; # to check if following ones are to be skipped too
}
}
$resultdate=DateCalc($planneddate,"2 months");
}
if ($subscription->{periodicity} == 7) {
for(my $i = 0;$i < @irreg; $i++){
if($month == 12) { $month = 0; } # need to rollover to check January
if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
$planneddate = DateCalc($planneddate,"3 months");
$month++; # to check if following ones are to be skipped too
}
}
$resultdate=DateCalc($planneddate,"3 months");
}
if ($subscription->{periodicity} == 8) {
for(my $i = 0;$i < @irreg; $i++){
if($month == 12) { $month = 0; } # need to rollover to check January
if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
$planneddate = DateCalc($planneddate,"3 months");
$month++; # to check if following ones are to be skipped too
}
}
$resultdate=DateCalc($planneddate,"3 months");
}
if ($subscription->{periodicity} == 9) {
for(my $i = 0;$i < @irreg; $i++){
if($month == 12) { $month = 0; } # need to rollover to check January
if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
$planneddate = DateCalc($planneddate,"6 months");
$month++; # to check if following ones are to be skipped too
}
}
$resultdate=DateCalc($planneddate,"6 months");
}
if ($subscription->{periodicity} == 10) {
$resultdate=DateCalc($planneddate,"1 year");
}
if ($subscription->{periodicity} == 11) {
$resultdate=DateCalc($planneddate,"2 years");
}
# warn "date: ".$resultdate;
return format_date_in_iso($resultdate);
}
END { } # module clean-up code here (global destructor)
1;