X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FSerials.pm;h=32e46becae8223f4afb42ac920e30ce0c4d4b4b4;hb=00408e262fbe58f4c6a3fbb722a0cb56d3d22f6c;hp=f2828d79c6c47180920d6fc85280acbb696cba90;hpb=4399daf0bdc0deabb13ec7b16198260bd5bc6b0c;p=koha.git diff --git a/C4/Serials.pm b/C4/Serials.pm index f2828d79c6..32e46becae 100644 --- a/C4/Serials.pm +++ b/C4/Serials.pm @@ -1,4 +1,4 @@ -package C4::Serials; #assumes C4/Serials.pm +package C4::Serials; # Copyright 2000-2002 Katipo Communications # @@ -13,34 +13,58 @@ package C4::Serials; #assumes C4/Serials.pm # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR # A PARTICULAR PURPOSE. See the GNU General Public License for more details. # -# You should have received a copy of the GNU General Public License along with -# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, -# Suite 330, Boston, MA 02111-1307 USA - +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. use strict; -use C4::Date; +use warnings; +use C4::Dates qw(format_date format_date_in_iso); use Date::Calc qw(:all); use POSIX qw(strftime); use C4::Suggestions; use C4::Koha; use C4::Biblio; +use C4::Branch; +use C4::Items; use C4::Search; use C4::Letters; -use C4::Log; # logaction - -require Exporter; +use C4::Log; # logaction +use C4::Debug; 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 ); -}; +BEGIN { + $VERSION = 3.01; # set version for version checking + require Exporter; + @ISA = qw(Exporter); + @EXPORT = qw( + &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions + &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber + &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory + &HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire + + &GetNextSeq &NewIssue &ItemizeSerials &GetSerials + &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2 + &ReNewSubscription &GetLateIssues &GetLateOrMissingIssues + &GetSerialInformation &AddItem2Serial + &PrepareSerialsData &GetNextExpected &ModNextExpected + + &UpdateClaimdateIssues + &GetSuppliersWithLateIssues &getsupplierbyserialid + &GetDistributedTo &SetDistributedTo + &getroutinglist &delroutingmember &addroutingmember + &reorder_members + &check_routing &updateClaim &removeMissingIssue + &CountIssues + HasItems + + ); +} =head1 NAME -C4::Serials - Give functions for serializing. +C4::Serials - Serials Module Functions =head1 SYNOPSIS @@ -48,88 +72,44 @@ C4::Serials - Give functions for serializing. =head1 DESCRIPTION -Give all XYZ functions - -=head1 FUNCTIONS +Functions for handling subscriptions, claims routing etc. -=cut -@ISA = qw(Exporter); -@EXPORT = qw( - - &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions - &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber - &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory - &HasSubscriptionExpired &GetExpirationDate &abouttoexpire - - &GetNextSeq &NewIssue &ItemizeSerials &GetSerials - &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2 - &ReNewSubscription &GetLateIssues &GetLateOrMissingIssues - &GetSerialInformation &AddItem2Serial - &PrepareSerialsData - - &UpdateClaimdateIssues - &GetSuppliersWithLateIssues &getsupplierbyserialid - &GetDistributedTo &SetDistributedTo - &getroutinglist &delroutingmember &addroutingmember - &reorder_members - &check_routing &updateClaim &removeMissingIssue - - &old_newsubscription &old_modsubscription &old_getserials -); +=head1 SUBROUTINES =head2 GetSuppliersWithLateIssues -=over 4 - -%supplierlist = &GetSuppliersWithLateIssues +$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 +an array_ref of suppliers each entry is a hash_ref containing id and name +the array is in name order =cut sub GetSuppliersWithLateIssues { my $dbh = C4::Context->dbh; - my $query = qq| - SELECT DISTINCT id, name - FROM subscription - LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid - LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id - WHERE subscription.subscriptionid = serial.subscriptionid - AND (planneddate < now() OR serial.STATUS = 3 OR serial.STATUS = 4) - ORDER BY name - |; - 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; + my $query = q| + SELECT DISTINCT aqbooksellerid as id, aqbooksellers.name as 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() OR serial.STATUS = 3 OR serial.STATUS = 4) ORDER BY name|; + return $dbh->selectall_arrayref($query, { Slice => {} }); } =head2 GetLateIssues -=over 4 - -@issuelist = &GetLateIssues($supplierid) +@issuelist = GetLateIssues($supplierid) -this function select late issues on database +this function selects late issues from the database return : -the issuelist into an table. Each line of this table containts a ref to a hash which it containts +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 -=back - =cut sub GetLateIssues { @@ -148,8 +128,7 @@ sub GetLateIssues { ORDER BY title |; $sth = $dbh->prepare($query); - } - else { + } else { my $query = qq| SELECT name,title,planneddate,serialseq,serial.subscriptionid FROM subscription @@ -165,29 +144,21 @@ sub GetLateIssues { 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} ); - $count++; push @issuelist, $line; } - return $count, @issuelist; + return @issuelist; } =head2 GetSubscriptionHistoryFromSubscriptionId -=over 4 - $sth = GetSubscriptionHistoryFromSubscriptionId() -this function just prepare the SQL request. +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) -return : -$sth = $dbh->prepare($query). - -=back =cut @@ -203,16 +174,12 @@ sub GetSubscriptionHistoryFromSubscriptionId() { =head2 GetSerialStatusFromSerialId -=over 4 - $sth = GetSerialStatusFromSerialId(); -this function just prepare the SQL request. +this function returns a statement handle After this function, don't forget to execute it by using $sth->execute($serialid) return : $sth = $dbh->prepare($query). -=back - =cut sub GetSerialStatusFromSerialId() { @@ -227,16 +194,13 @@ sub GetSerialStatusFromSerialId() { =head2 GetSerialInformation -=over 4 $data = GetSerialInformation($serialid); -returns a hash containing : +returns a hash_ref containing : items : items marcrecord (can be an array) serial table field subscription table field + information about subscription expiration - -=back =cut @@ -244,14 +208,15 @@ sub GetSerialInformation { 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 |; + 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| FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid WHERE serialid = ? |; @@ -259,26 +224,26 @@ sub GetSerialInformation { $rq->execute($serialid); my $data = $rq->fetchrow_hashref; - if ( C4::Context->preference("serialsadditems") ) { - if ( $data->{'itemnumber'} ) { - my @itemnumbers = split /,/, $data->{'itemnumber'}; - foreach my $itemnum (@itemnumbers) { + # create item information if we have serialsadditems for this subscription + if ( $data->{'serialsadditems'} ) { + my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?"); + $queryitem->execute($serialid); + my $itemnumbers = $queryitem->fetchall_arrayref( [0] ); + if ( scalar(@$itemnumbers) > 0 ) { + foreach my $itemnum (@$itemnumbers) { #It is ASSUMED that GetMarcItem ALWAYS WORK... #Maybe GetMarcItem should return values on failure -# warn "itemnumber :$itemnum, bibnum :".$data->{'biblionumber'}; - my $itemprocessed = - PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum ); - $itemprocessed->{'itemnumber'} = $itemnum; - $itemprocessed->{'itemid'} = $itemnum; + $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'}; + my $itemprocessed = PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data ); + $itemprocessed->{'itemnumber'} = $itemnum->[0]; + $itemprocessed->{'itemid'} = $itemnum->[0]; $itemprocessed->{'serialid'} = $serialid; $itemprocessed->{'biblionumber'} = $data->{'biblionumber'}; push @{ $data->{'items'} }, $itemprocessed; } - } - else { - my $itemprocessed = - PrepareItemrecordDisplay( $data->{'biblionumber'} ); + } else { + my $itemprocessed = PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data ); $itemprocessed->{'itemid'} = "N$serialid"; $itemprocessed->{'serialid'} = $serialid; $itemprocessed->{'biblionumber'} = $data->{'biblionumber'}; @@ -287,72 +252,56 @@ sub GetSerialInformation { } } $data->{ "status" . $data->{'serstatus'} } = 1; - $data->{'subscriptionexpired'} = - HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'}==1; - $data->{'abouttoexpire'} = - abouttoexpire( $data->{'subscriptionid'} ); + $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1; + $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} ); return $data; } =head2 AddItem2Serial -=over 4 - -$data = AddItem2Serial($serialid,$itemnumber); +$rows = AddItem2Serial($serialid,$itemnumber); Adds an itemnumber to Serial record -=back +returns the number of rows affected =cut sub AddItem2Serial { my ( $serialid, $itemnumber ) = @_; - my $dbh = C4::Context->dbh; - my $query = qq| - UPDATE serial SET itemnumber=IF(itemnumber IS NULL, $itemnumber, CONCAT(itemnumber,",",$itemnumber)) - WHERE serialid = ? - |; - my $rq = $dbh->prepare($query); - $rq->execute($serialid); + my $dbh = C4::Context->dbh; + my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?"); + $rq->execute( $serialid, $itemnumber ); return $rq->rows; } =head2 UpdateClaimdateIssues -=over 4 - UpdateClaimdateIssues($serialids,[$date]); -Update Claimdate for issues in @$serialids list with date $date +Update Claimdate for issues in @$serialids list with date $date (Take Today if none) -=back =cut sub UpdateClaimdateIssues { my ( $serialids, $date ) = @_; - my $dbh = C4::Context->dbh; - $date = strftime("%Y-%m-%d",localtime) unless ($date); + my $dbh = C4::Context->dbh; + $date = strftime( "%Y-%m-%d", localtime ) unless ($date); my $query = " - UPDATE serial SET claimdate=$date,status=7 - WHERE serialid in ".join (",",@$serialids); - ; + UPDATE serial SET claimdate = ?, status = 7 + WHERE serialid in (" . join( ",", map { '?' } @$serialids ) . ")"; my $rq = $dbh->prepare($query); - $rq->execute; + $rq->execute($date, @$serialids); return $rq->rows; } =head2 GetSubscription -=over 4 - $subs = GetSubscription($subscriptionid) -this function get the subscription which has $subscriptionid as id. +this function returns the subscription which has $subscriptionid as id. return : a hashref. This hash containts subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title -=back - =cut sub GetSubscription { @@ -361,53 +310,47 @@ sub GetSubscription { my $query = qq( SELECT subscription.*, subscriptionhistory.*, - aqbudget.bookfundid, 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( + 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( 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 = ? ); -# if (C4::Context->preference('IndependantBranches') && -# C4::Context->userenv && -# C4::Context->userenv->{'flags'} != 1){ -# # warn "flags: ".C4::Context->userenv->{'flags'}; -# $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")"; -# } -# warn "query : $query"; + + # 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); -# warn "subsid :$subscriptionid"; $sth->execute($subscriptionid); - my $subs = $sth->fetchrow_hashref; - return $subs; + return $sth->fetchrow_hashref; } =head2 GetFullSubscription -=over 4 - - \@res = GetFullSubscription($subscriptionid) - this function read on serial table. - -=back + $array_ref = GetFullSubscription($subscriptionid) + this function reads the serial table. =cut sub GetFullSubscription { my ($subscriptionid) = @_; - my $dbh = C4::Context->dbh; - my $query = qq| + my $dbh = C4::Context->dbh; + my $query = qq| SELECT serial.serialid, serial.serialseq, serial.planneddate, @@ -415,21 +358,21 @@ sub GetFullSubscription { serial.status, serial.notes as notes, year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year, - aqbudget.bookfundid,aqbooksellers.name as aqbooksellername, + 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 "; + 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| + $query .= qq| FROM serial LEFT JOIN subscription ON (serial.subscriptionid=subscription.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 serial.subscriptionid = ? @@ -437,27 +380,21 @@ sub GetFullSubscription { IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC, serial.subscriptionid |; -# warn $query; + $debug and warn "GetFullSubscription query: $query"; my $sth = $dbh->prepare($query); $sth->execute($subscriptionid); - my $subs = $sth->fetchall_arrayref({}); - return $subs; + return $sth->fetchall_arrayref( {} ); } - =head2 PrepareSerialsData -=over 4 - - \@res = PrepareSerialsData($serialinfomation) + $array_ref = PrepareSerialsData($serialinfomation) where serialinformation is a hashref array -=back - =cut -sub PrepareSerialsData{ - my ($lines)=@_; +sub PrepareSerialsData { + my ($lines) = @_; my %tmpresults; my $year; my @res; @@ -467,55 +404,52 @@ sub PrepareSerialsData{ my @loopissues; my $first; my $previousnote = ""; - - foreach my $subs ( @$lines ) { - $subs->{'publisheddate'} = - ( $subs->{'publisheddate'} - ? format_date( $subs->{'publisheddate'} ) - : "XXX" ); - $subs->{'planneddate'} = format_date( $subs->{'planneddate'} ); + + 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} ); + } + } + $subs->{'branchname'} = GetBranchName( $subs->{'branchcode'} ); $subs->{ "status" . $subs->{'status'} } = 1; + $subs->{"checked"} = $subs->{'status'} =~ /1|3|4|7/; -# $subs->{'notes'} = $subs->{'notes'} eq $previousnote?"":$subs->{notes}; if ( $subs->{'year'} && $subs->{'year'} ne "" ) { $year = $subs->{'year'}; - } - else { + } else { $year = "manage"; } if ( $tmpresults{$year} ) { push @{ $tmpresults{$year}->{'serials'} }, $subs; - } - else { + } else { $tmpresults{$year} = { - 'year' => $year, - - # 'startdate'=>format_date($subs->{'startdate'}), + 'year' => $year, 'aqbooksellername' => $subs->{'aqbooksellername'}, 'bibliotitle' => $subs->{'bibliotitle'}, 'serials' => [$subs], 'first' => $first, -# 'branchcode' => $subs->{'branchcode'}, -# 'subscriptionid' => $subs->{'subscriptionid'}, }; } - - # $previousnote=$subs->{notes}; } foreach my $key ( sort { $b cmp $a } keys %tmpresults ) { push @res, $tmpresults{$key}; } - $res[0]->{'first'}=1; + $res[0]->{'first'} = 1; return \@res; } =head2 GetSubscriptionsFromBiblionumber -\@res = GetSubscriptionsFromBiblionumber($biblionumber) -this function get the subscription list. it reads on subscription table. +$array_ref = GetSubscriptionsFromBiblionumber($biblionumber) +this function get the subscription list. it reads the 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 +reference to an array of subscriptions which have the biblionumber given on input arg. +each element of this array is a hashref containing startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate =cut @@ -527,47 +461,43 @@ sub GetSubscriptionsFromBiblionumber { SELECT subscription.*, branches.branchname, 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 LEFT JOIN branches ON branches.branchcode=subscription.branchcode WHERE subscription.biblionumber = ? ); -# if (C4::Context->preference('IndependantBranches') && -# C4::Context->userenv && -# C4::Context->userenv->{'flags'} != 1){ -# $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")"; -# } my $sth = $dbh->prepare($query); $sth->execute($biblionumber); my @res; while ( my $subs = $sth->fetchrow_hashref ) { $subs->{startdate} = format_date( $subs->{startdate} ); $subs->{histstartdate} = format_date( $subs->{histstartdate} ); + $subs->{histenddate} = format_date( $subs->{histenddate} ); $subs->{opacnote} =~ s/\n/\/g; $subs->{missinglist} =~ s/\n/\/g; $subs->{recievedlist} =~ s/\n/\/g; - $subs->{ "periodicity" . $subs->{periodicity} } = 1; + $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} !=1 && - C4::Context->userenv->{branch} && $subs->{branchcode} && - (C4::Context->userenv->{branch} ne $subs->{branchcode})); + $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} = ''; - } - else { + } else { $subs->{enddate} = format_date( $subs->{enddate} ); } - $subs->{'abouttoexpire'}=abouttoexpire($subs->{'subscriptionid'}); - $subs->{'subscriptionexpired'}=HasSubscriptionExpired($subs->{'subscriptionid'}); + $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} ); + $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} ); push @res, $subs; } return \@res; @@ -575,12 +505,8 @@ sub GetSubscriptionsFromBiblionumber { =head2 GetFullSubscriptionsFromBiblionumber -=over 4 - - \@res = GetFullSubscriptionsFromBiblionumber($biblionumber) - this function read on serial table. - -=back + $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber) + this function reads the serial table. =cut @@ -595,22 +521,21 @@ sub GetFullSubscriptionsFromBiblionumber { serial.status, serial.notes as notes, year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year, - aqbudget.bookfundid,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| + 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| FROM serial LEFT JOIN subscription ON (serial.subscriptionid=subscription.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 = ? @@ -620,102 +545,87 @@ sub GetFullSubscriptionsFromBiblionumber { |; my $sth = $dbh->prepare($query); $sth->execute($biblionumber); - my $subs= $sth->fetchall_arrayref({}); - return $subs; + return $sth->fetchall_arrayref( {} ); } =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. +this function gets all subscriptions which have 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 ) = @_; + my ( $string, $issn, $biblionumber ) = @_; + #return unless $title or $ISSN or $biblionumber; my $dbh = C4::Context->dbh; my $sth; - if ($biblionumber) { - my $query = qq( - SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber + 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 - WHERE biblio.biblionumber=? - ); - $query.=" ORDER BY title"; -# warn "query :$query"; - $sth = $dbh->prepare($query); - $sth->execute($biblionumber); + ); + my @bind_params; + my $sqlwhere; + if ($biblionumber) { + $sqlwhere = " WHERE biblio.biblionumber=?"; + push @bind_params, $biblionumber; } - else { - if ( $ISSN and $title ) { - my $query = qq| - SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber - FROM subscription - LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber - LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber - WHERE (biblioitems.issn = ? or|. join('and ',map{"biblio.title LIKE \"%$_%\""}split (" ",$title))." )"; - $query.=" ORDER BY title"; - $sth = $dbh->prepare($query); - $sth->execute( $ISSN ); + 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; } - else { - if ($ISSN) { - my $query = qq( - SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber - FROM subscription - LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber - LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber - WHERE biblioitems.issn LIKE ? - ); - $query.=" ORDER BY title"; -# warn "query :$query"; - $sth = $dbh->prepare($query); - $sth->execute( "%" . $ISSN . "%" ); - } - else { - my $query = qq( - SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber - FROM subscription - LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber - LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber - WHERE 1 - ).($title?" and ":""). join('and ',map{"biblio.title LIKE \"%$_%\""} split (" ",$title) ); - - $query.=" ORDER BY title"; -# warn $query; - $sth = $dbh->prepare($query); - $sth->execute; - } + $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 ) . ")"; } + $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; 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 { + $line->{title} = ""; + $line->{issn} = ""; + } else { $previoustitle = $line->{title}; $odd = -$odd; - $line->{toggle} = 1 if $odd == 1; } - $line->{'cannotedit'}=(C4::Context->preference('IndependantBranches') && - C4::Context->userenv && - C4::Context->userenv->{flags} !=1 && - C4::Context->userenv->{branch} && $line->{branchcode} && - (C4::Context->userenv->{branch} ne $line->{branchcode})); + $line->{toggle} = 1 if $odd == 1; + $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; } return @results; @@ -723,42 +633,39 @@ sub GetSubscriptions { =head2 GetSerials -=over 4 - ($totalissues,@serials) = GetSerials($subscriptionid); -this function get every serial not arrived for a given subscription +this function gets 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 +FIXME: We should return \@serials. =cut sub GetSerials { - my ($subscriptionid,$count) = @_; + my ( $subscriptionid, $count ) = @_; my $dbh = C4::Context->dbh; # status = 2 is "arrived" my $counter = 0; - $count=5 unless ($count); + $count = 5 unless ($count); my @serials; - my $query = - "SELECT serialid,serialseq, status, publisheddate, planneddate,notes, routingnotes + my $query = "SELECT serialid,serialseq, status, publisheddate, planneddate,notes, routingnotes FROM serial WHERE subscriptionid = ? AND status NOT IN (2,4,5) ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC"; 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"} ); + $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 arrives/missing - $query = - "SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes + $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes FROM serial WHERE subscriptionid = ? AND (status in (2,4,5)) @@ -768,15 +675,14 @@ sub GetSerials { $sth->execute($subscriptionid); while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) { $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"} ); + $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; } $query = "SELECT count(*) FROM serial WHERE subscriptionid=?"; - $sth = $dbh->prepare($query); + $sth = $dbh->prepare($query); $sth->execute($subscriptionid); my ($totalissues) = $sth->fetchrow; return ( $totalissues, @serials ); @@ -784,49 +690,42 @@ sub GetSerials { =head2 GetSerials2 -=over 4 - -($totalissues,@serials) = GetSerials2($subscriptionid,$status); -this function get every serial waited for a given subscription +@serials = GetSerials2($subscriptionid,$status); +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) -=back - =cut + sub GetSerials2 { - my ($subscription,$status) = @_; - my $dbh = C4::Context->dbh; + my ( $subscription, $status ) = @_; + 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) ORDER BY publisheddate,serialid DESC |; -# warn $query; - my $sth=$dbh->prepare($query); + $debug and warn "GetSerials2 query: $query"; + my $sth = $dbh->prepare($query); $sth->execute; 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"}); - $line->{"publisheddate"} = format_date($line->{"publisheddate"}); - push @serials,$line; + + 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; } - my ($totalissues) = scalar(@serials); - return ($totalissues,@serials); + return @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 +a ref to an array which contains all of the latest serials stored into a hash. =cut @@ -845,31 +744,18 @@ sub GetLatestSerials { $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->{ "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 +This function returns the field distributedto for the subscription matching subscriptionid =cut @@ -877,23 +763,19 @@ sub GetDistributedTo { my $dbh = C4::Context->dbh; my $distributedto; my $subscriptionid = @_; - my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?"; - my $sth = $dbh->prepare($query); + my $query = "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 +a list containing all the input params updated. =cut @@ -930,93 +812,83 @@ all the input params updated. sub GetNextSeq { my ($val) = @_; - my ( - $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3, - $newinnerloop1, $newinnerloop2, $newinnerloop3 - ); - my $pattern = $val->{numberpattern}; - my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' ); + 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}; - $newlastvalue1 = $val->{lastvalue1}; - # check if we have to increase the new value. - $newinnerloop1 = $val->{innerloop1}+$val->{add1}; - $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1}-$val->{setto1}); - $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}+$val->{add2}; - $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2}-$val->{setto2}); - $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; + # 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; + } + } else { + $calculated =~ s/\{Y\}/$newlastvalue2/g; } - } - else { - $calculated =~ s/\{Y\}/$newlastvalue2/g; - } - - - $newlastvalue3 = $val->{lastvalue3}; - # check if we have to increase the new value. - $newinnerloop3 = $val->{innerloop3}+$val->{add3}; - $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3}-$val->{setto3}); - $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); + + $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 ); } =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 ($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'}; + 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 { + } else { my $newlastvalue2seq = $seasons[$newlastvalue2]; $calculated =~ s/\{Y\}/$newlastvalue2seq/g; } - } - else { + } else { $calculated =~ s/\{Y\}/$newlastvalue2/g; } my $z = $val->{'lastvalue3'}; @@ -1026,63 +898,66 @@ sub GetSeq { =head2 GetExpirationDate -$sensddate = GetExpirationDate($subscriptionid) +$sensddate = GetExpirationDate($subscriptionid, [$startdate]) -this function return the expiration date for a subscription given on input args. +this function return the next expiration date for a subscription given on input args. return -the enddate +the enddate or undef =cut sub GetExpirationDate { - 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->{periodicity} % 16) >0){ - if ( $subscription->{numberlength} ) { - #calculate the date of the last issue. - my $length = $subscription->{numberlength}; - for ( my $i = 1 ; $i <= $length ; $i++ ) { - $enddate = GetNextDate( $enddate, $subscription ); - } - } - elsif ( $subscription->{monthlength} ){ - my @date=split (/-/,$subscription->{startdate}); - my @enddate = Add_Delta_YM($date[0],$date[1],$date[2],0,$subscription->{monthlength}); - $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]); - } elsif ( $subscription->{weeklength} ){ - my @date=split (/-/,$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]); - } - return $enddate; + my ( $subscriptionid, $startdate ) = @_; + 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 ) { + + # 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 ); + } + } elsif ( $subscription->{monthlength} ) { + if ( $$subscription{startdate} ) { + my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} ); + $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] ); + } + } elsif ( $subscription->{weeklength} ) { + if ( $$subscription{startdate} ) { + my @date = split( /-/, $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] ); + } + } + return $enddate; } else { - return 0; - } + return; + } } =head2 CountSubscriptionFromBiblionumber -=over 4 - $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber) -this count the number of subscription for a biblionumber given. +this returns a count of the subscriptions for a given biblionumber return : -the number of subscriptions with biblionumber given on input arg. - -=back +the number of subscriptions =cut sub CountSubscriptionFromBiblionumber { my ($biblionumber) = @_; - my $dbh = C4::Context->dbh; - my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?"; - my $sth = $dbh->prepare($query); + my $dbh = C4::Context->dbh; + my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?"; + my $sth = $dbh->prepare($query); $sth->execute($biblionumber); my $subscriptionsnumber = $sth->fetchrow; return $subscriptionsnumber; @@ -1090,53 +965,39 @@ sub CountSubscriptionFromBiblionumber { =head2 ModSubscriptionHistory -=over 4 - ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote); -this function modify the history of a subscription. Put your new values on input arg. - -=back +this function modifies the history of a subscription. Put your new values on input arg. +returns the number of rows affected =cut sub ModSubscriptionHistory { - my ( - $subscriptionid, $histstartdate, $enddate, $recievedlist, - $missinglist, $opacnote, $librariannote - ) = @_; + my ( $subscriptionid, $histstartdate, $enddate, $recievedlist, $missinglist, $opacnote, $librariannote ) = @_; my $dbh = C4::Context->dbh; my $query = "UPDATE subscriptionhistory - SET histstartdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=? + SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=? WHERE subscriptionid=? "; my $sth = $dbh->prepare($query); - $recievedlist =~ s/^,//g; - $missinglist =~ s/^,//g; - $opacnote =~ s/^,//g; - $sth->execute( - $histstartdate, $enddate, $recievedlist, $missinglist, - $opacnote, $librariannote, $subscriptionid - ); + $recievedlist =~ s/^; //; + $missinglist =~ s/^; //; + $opacnote =~ s/^; //; + $sth->execute( $histstartdate, $enddate, $recievedlist, $missinglist, $opacnote, $librariannote, $subscriptionid ); return $sth->rows; } =head2 ModSerialStatus -=over 4 - ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$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, $planneddate,$publisheddate, $status, $notes ) - = @_; + my ( $serialid, $serialseq, $planneddate, $publisheddate, $status, $notes ) = @_; #It is a usual serial # 1st, get previous status : @@ -1148,108 +1009,153 @@ sub ModSerialStatus { # change status & update subscriptionhistory my $val; - if ( $status eq 6 ) { + if ( $status == 6 ) { DelIssue( {'serialid'=>$serialid, 'subscriptionid'=>$subscriptionid,'serialseq'=>$serialseq} ); } else { my $query = -"UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?"; +'UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?'; $sth = $dbh->prepare($query); - $sth->execute( $serialseq, $publisheddate, $planneddate, $status, - $notes, $serialid ); + $sth->execute( $serialseq, $publisheddate, $planneddate, $status, $notes, $serialid ); $query = "SELECT * FROM subscription WHERE subscriptionid = ?"; - $sth = $dbh->prepare($query); + $sth = $dbh->prepare($query); $sth->execute($subscriptionid); my $val = $sth->fetchrow_hashref; unless ( $val->{manualhistory} ) { - $query = -"SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?"; - $sth = $dbh->prepare($query); + $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?"; + $sth = $dbh->prepare($query); $sth->execute($subscriptionid); my ( $missinglist, $recievedlist ) = $sth->fetchrow; - if ( $status eq 2 ) { + if ( $status == 2 ) { -# warn "receivedlist : $recievedlist serialseq :$serialseq, ".index("$recievedlist","$serialseq"); - $recievedlist .= ",$serialseq" + $recievedlist .= "; $serialseq" unless ( index( "$recievedlist", "$serialseq" ) >= 0 ); } -# warn "missinglist : $missinglist serialseq :$serialseq, ".index("$missinglist","$serialseq"); - $missinglist .= ",$serialseq" - if ( $status eq 4 + # warn "missinglist : $missinglist serialseq :$serialseq, ".index("$missinglist","$serialseq"); + $missinglist .= "; $serialseq" + if ( $status == 4 and not index( "$missinglist", "$serialseq" ) >= 0 ); - $missinglist .= ",not issued $serialseq" - if ( $status eq 5 + $missinglist .= "; not issued $serialseq" + if ( $status == 5 and index( "$missinglist", "$serialseq" ) >= 0 ); - $query = -"UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?"; - $sth = $dbh->prepare($query); + $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?"; + $sth = $dbh->prepare($query); + $recievedlist =~ s/^; //; + $missinglist =~ s/^; //; $sth->execute( $recievedlist, $missinglist, $subscriptionid ); } } # create new waited entry if needed (ie : was a "waited" and has changed) - if ( $oldstatus eq 1 && $status ne 1 ) { + if ( $oldstatus == 1 && $status != 1 ) { my $query = "SELECT * FROM subscription WHERE subscriptionid = ?"; $sth = $dbh->prepare($query); $sth->execute($subscriptionid); my $val = $sth->fetchrow_hashref; # next issue number -# warn "Next Seq"; my ( $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3 ) = GetNextSeq($val); -# warn "Next Seq End"; # next date (calculated from actual date & frequency parameters) -# warn "publisheddate :$publisheddate "; my $nextpublisheddate = GetNextDate( $publisheddate, $val ); - NewIssue( $newserialseq, $subscriptionid, $val->{'biblionumber'}, - 1, $nextpublisheddate, $nextpublisheddate ); - $query = -"UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=? + NewIssue( $newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextpublisheddate, $nextpublisheddate ); + $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 - ); + $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 eq 2 && $oldstatus ne 2 ) { + if ( $val->{letter} && $status == 2 && $oldstatus != 2 ) { SendAlerts( 'issue', $val->{subscriptionid}, $val->{letter} ); } } + return; } -=head2 ModSubscription +=head2 GetNextExpected + +$nextexpected = GetNextExpected($subscriptionid) + +Get the planneddate for the current expected issue of the subscription. + +returns a hashref: + +$nextexepected = { + serialid => int + planneddate => C4::Dates object + } + +=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; + } + if (!defined $nextissue->{planneddate}) { + # or should this default to 1st Jan ??? + $nextissue->{planneddate} = strftime('%Y-%m-%d',localtime); + } + $nextissue->{planneddate} = C4::Dates->new($nextissue->{planneddate},'iso'); + return $nextissue; + +} + +=head2 ModNextExpected + +ModNextExpected($subscriptionid,$date) + +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. + +returns 0 + +=cut + +sub ModNextExpected($$) { + my ( $subscriptionid, $date ) = @_; + my $dbh = C4::Context->dbh; + + #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 ); + return 0; -=over 4 +} -this function modify a subscription. Put all new values on input args. +=head2 ModSubscription -=back +this function modifies a subscription. Put all new values on input args. +returns the number of rows affected =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, - $subscriptionid + 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 ) = @_; -# warn $irregularity; + + # warn $irregularity; my $dbh = C4::Context->dbh; my $query = "UPDATE subscription SET librarian=?, branchcode=?,aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?, @@ -1257,65 +1163,58 @@ sub ModSubscription { 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=? + numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, + letter=?, hemisphere=?,manualhistory=?,internalnotes=?,serialsadditems=?, + staffdisplaycount = ?,opacdisplaycount = ?, graceperiod = ?, location = ? + ,enddate=? WHERE subscriptionid = ?"; -# warn "query :".$query; + + #warn "query :".$query; my $sth = $dbh->prepare($query); $sth->execute( - $auser, $branchcode, $aqbooksellerid, $cost, - $aqbudgetid, $startdate, $periodicity, $firstacquidate, + $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), - $internalnotes, - $subscriptionid + $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 ), + $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, + $graceperiod, $location, $enddate, $subscriptionid ); - my $rows=$sth->rows; - $sth->finish; - - &logaction(C4::Context->userenv->{'number'},"SERIAL","MODIFY",$subscriptionid,"") - if C4::Context->preference("SubscriptionLog"); + my $rows = $sth->rows; + + logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog"); return $rows; } =head2 NewSubscription -=over 4 - $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) + $numberingmethod, $status, $notes, $serialsadditems, + $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate); Create a new subscription with value given on input args. return : the id of this new subscription -=back - =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 + 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 $dbh = C4::Context->dbh; @@ -1328,47 +1227,31 @@ sub NewSubscription { add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2, add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3, numberingmethod, status, notes, letter,firstacquidate,irregularity, - numberpattern, callnumber, hemisphere,manualhistory,internalnotes) - VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) + numberpattern, callnumber, hemisphere,manualhistory,internalnotes,serialsadditems, + staffdisplaycount,opacdisplaycount,graceperiod,location,enddate) + VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) |; my $sth = $dbh->prepare($query); $sth->execute( - $auser, $branchcode, - $aqbooksellerid, $cost, - $aqbudgetid, $biblionumber, - format_date_in_iso($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 + $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 ); #then create the 1st waited number my $subscriptionid = $dbh->{'mysql_insertid'}; - $query = qq( + $query = qq( INSERT INTO subscriptionhistory - (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) - VALUES (?,?,?,?,?,?,?,?) + (biblionumber, subscriptionid, histstartdate, opacnote, librariannote) + VALUES (?,?,?,?,?) ); $sth = $dbh->prepare($query); - $sth->execute( $biblionumber, $subscriptionid, - format_date_in_iso($startdate), - 0, "", "", "", "$notes" ); + $sth->execute( $biblionumber, $subscriptionid, $startdate, $notes, $internalnotes ); - # reread subscription to get a hash (for calculation of the 1st issue number) + # reread subscription to get a hash (for calculation of the 1st issue number) $query = qq( SELECT * FROM subscription @@ -1380,93 +1263,107 @@ sub NewSubscription { # calculate issue number my $serialseq = GetSeq($val); - $query = qq| + $query = qq| INSERT INTO serial (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate) VALUES (?,?,?,?,?,?) |; $sth = $dbh->prepare($query); - $sth->execute( - "$serialseq", $subscriptionid, $biblionumber, 1, - format_date_in_iso($startdate), - format_date_in_iso($startdate) - ); - - &logaction(C4::Context->userenv->{'number'},"SERIAL","ADD",$subscriptionid,"") - if C4::Context->preference("SubscriptionLog"); - + $sth->execute( "$serialseq", $subscriptionid, $biblionumber, 1, $firstacquidate, $firstacquidate ); + + logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog"); + + #set serial flag on biblio if not already set. + my ( $null, ($bib) ) = GetBiblio($biblionumber); + if ( !$bib->{'serial'} ) { + my $record = GetMarcBiblio($biblionumber); + my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $bib->{'frameworkcode'} ); + if ($tag) { + eval { $record->field($tag)->update( $subf => 1 ); }; + } + ModBiblio( $record, $biblionumber, $bib->{'frameworkcode'} ); + } 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 ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_; my $dbh = C4::Context->dbh; my $subscription = GetSubscription($subscriptionid); - my $query = qq| + my $query = qq| SELECT * FROM biblio LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber WHERE biblio.biblionumber=? |; - my $sth = $dbh->prepare($query); - $sth->execute( $subscription->{biblionumber} ); - my $biblio = $sth->fetchrow_hashref; - NewSuggestion( - $user, $subscription->{bibliotitle}, - $biblio->{author}, $biblio->{publishercode}, - $biblio->{note}, '', - '', '', - '', '', - $subscription->{biblionumber} - ); + my $sth = $dbh->prepare($query); + $sth->execute( $subscription->{biblionumber} ); + my $biblio = $sth->fetchrow_hashref; + + if ( C4::Context->preference("RenewSerialAddsSuggestion") ) { + + NewSuggestion( + { 'suggestedby' => $user, + 'title' => $subscription->{bibliotitle}, + 'author' => $biblio->{author}, + 'publishercode' => $biblio->{publishercode}, + 'note' => $biblio->{note}, + 'biblionumber' => $subscription->{biblionumber} + } + ); + } # renew subscription - my $query = qq| + $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 ); - - &logaction(C4::Context->userenv->{'number'},"SERIAL","RENEW",$subscriptionid,"") - if C4::Context->preference("SubscriptionLog"); + $sth = $dbh->prepare($query); + $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid ); + my $enddate = GetExpirationDate($subscriptionid); + $debug && warn "enddate :$enddate"; + $query = qq| + UPDATE subscription + SET enddate=? + WHERE subscriptionid=? + |; + $sth = $dbh->prepare($query); + $sth->execute( $enddate, $subscriptionid ); + $query = qq| + UPDATE subscriptionhistory + SET histenddate=? + WHERE subscriptionid=? + |; + $sth = $dbh->prepare($query); + $sth->execute( $enddate, $subscriptionid ); + + logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog"); + return; } =head2 NewIssue -=over 4 - NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes) Create a new issue stored on the database. Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription. - -=back +returns the serial id =cut sub NewIssue { - my ( $serialseq, $subscriptionid, $biblionumber, $status, - $planneddate, $publisheddate, $notes ) - = @_; + my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate, $publisheddate, $notes ) = @_; ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ? - + my $dbh = C4::Context->dbh; my $query = qq| INSERT INTO serial @@ -1474,9 +1371,8 @@ sub NewIssue { VALUES (?,?,?,?,?,?,?) |; my $sth = $dbh->prepare($query); - $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status, - $publisheddate, $planneddate,$notes ); - my $serialid=$dbh->{'mysql_insertid'}; + $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status, $publisheddate, $planneddate, $notes ); + my $serialid = $dbh->{'mysql_insertid'}; $query = qq| SELECT missinglist,recievedlist FROM subscriptionhistory @@ -1486,14 +1382,14 @@ sub NewIssue { $sth->execute($subscriptionid); my ( $missinglist, $recievedlist ) = $sth->fetchrow; - if ( $status eq 2 ) { + if ( $status == 2 ) { ### 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); + $recievedlist .= "; $serialseq" unless (index($recievedlist,$serialseq)>0); } - if ( $status eq 4 ) { - $missinglist .= ",$serialseq" unless (index($missinglist,$serialseq)>0); + if ( $status == 4 ) { + $missinglist .= "; $serialseq" unless (index($missinglist,$serialseq)>0); } $query = qq| UPDATE subscriptionhistory @@ -1501,28 +1397,26 @@ sub NewIssue { WHERE subscriptionid=? |; $sth = $dbh->prepare($query); + $recievedlist =~ s/^; //; + $missinglist =~ s/^; //; $sth->execute( $recievedlist, $missinglist, $subscriptionid ); return $serialid; } =head2 ItemizeSerials -=over 4 - ItemizeSerials($serialid, $info); $info is a hashref containing barcode branch, itemcallnumber, status, location $serialid the serialid return : 1 if the itemize is a succes. -0 and @error else. @error containts the list of errors found. - -=back +0 and @error otherwise. @error containts the list of errors found. =cut sub ItemizeSerials { my ( $serialid, $info ) = @_; - my $now = POSIX::strftime( "%Y-%m-%d",localtime ); + my $now = POSIX::strftime( "%Y-%m-%d", localtime ); my $dbh = C4::Context->dbh; my $query = qq| @@ -1536,41 +1430,21 @@ sub ItemizeSerials { if ( C4::Context->preference("RoutingSerials") ) { # check for existing biblioitem relating to serial issue - my ( $count, @results ) = - GetBiblioItemByBiblioNumber( $data->{'biblionumber'} ); + my ( $count, @results ) = GetBiblioItemByBiblioNumber( $data->{'biblionumber'} ); my $bibitemno = 0; for ( my $i = 0 ; $i < $count ; $i++ ) { - if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' (' - . $data->{'planneddate'} - . ')' ) - { + if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' (' . $data->{'planneddate'} . ')' ) { $bibitemno = $results[$i]->{'biblioitemnumber'}; last; } } if ( $bibitemno == 0 ) { - - # warn "need to add new biblioitem so copy last one and make minor changes"; - my $sth = - $dbh->prepare( -"SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC" - ); + my $sth = $dbh->prepare( "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC" ); $sth->execute( $data->{'biblionumber'} ); my $biblioitem = $sth->fetchrow_hashref; - $biblioitem->{'volumedate'} = - format_date_in_iso( $data->{planneddate} ); - $biblioitem->{'volumeddesc'} = - $data->{serialseq} . ' (' - . format_date( $data->{'planneddate'} ) . ')'; - $biblioitem->{'dewey'} = $info->{itemcallnumber}; - - #FIXME HDL : I don't understand why you need to call newbiblioitem, as the biblioitem should already be somewhere. - # so I comment it, we can speak of it when you want - # newbiblioitems has been removed from Biblio.pm, as it has a deprecated API now -# if ( $info->{barcode} ) -# { # only make biblioitem if we are going to make item also -# $bibitemno = newbiblioitem($biblioitem); -# } + $biblioitem->{'volumedate'} = $data->{planneddate}; + $biblioitem->{'volumeddesc'} = $data->{serialseq} . ' (' . format_date( $data->{'planneddate'} ) . ')'; + $biblioitem->{'dewey'} = $info->{itemcallnumber}; } } @@ -1581,143 +1455,136 @@ sub ItemizeSerials { push @errors, "barcode_not_unique" if ($exists); unless ($exists) { my $marcrecord = MARC::Record->new(); - my ( $tag, $subfield ) = - GetMarcFromKohaField( "items.barcode", $fwk ); - my $newField = - MARC::Field->new( "$tag", '', '', - "$subfield" => $info->{barcode} ); + my ( $tag, $subfield ) = GetMarcFromKohaField( "items.barcode", $fwk ); + my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{barcode} ); $marcrecord->insert_fields_ordered($newField); if ( $info->{branch} ) { - my ( $tag, $subfield ) = - GetMarcFromKohaField( "items.homebranch", - $fwk ); + my ( $tag, $subfield ) = GetMarcFromKohaField( "items.homebranch", $fwk ); #warn "items.homebranch : $tag , $subfield"; if ( $marcrecord->field($tag) ) { - $marcrecord->field($tag) - ->add_subfields( "$subfield" => $info->{branch} ); - } - else { - my $newField = - MARC::Field->new( "$tag", '', '', - "$subfield" => $info->{branch} ); + $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} ); + } else { + my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} ); $marcrecord->insert_fields_ordered($newField); } - ( $tag, $subfield ) = - GetMarcFromKohaField( "items.holdingbranch", - $fwk ); + ( $tag, $subfield ) = GetMarcFromKohaField( "items.holdingbranch", $fwk ); #warn "items.holdingbranch : $tag , $subfield"; if ( $marcrecord->field($tag) ) { - $marcrecord->field($tag) - ->add_subfields( "$subfield" => $info->{branch} ); - } - else { - my $newField = - MARC::Field->new( "$tag", '', '', - "$subfield" => $info->{branch} ); + $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} ); + } else { + my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} ); $marcrecord->insert_fields_ordered($newField); } } if ( $info->{itemcallnumber} ) { - my ( $tag, $subfield ) = - GetMarcFromKohaField( "items.itemcallnumber", - $fwk ); + my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemcallnumber", $fwk ); - #warn "items.itemcallnumber : $tag , $subfield"; if ( $marcrecord->field($tag) ) { - $marcrecord->field($tag) - ->add_subfields( "$subfield" => $info->{itemcallnumber} ); - } - else { - my $newField = - MARC::Field->new( "$tag", '', '', - "$subfield" => $info->{itemcallnumber} ); + $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{itemcallnumber} ); + } else { + my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{itemcallnumber} ); $marcrecord->insert_fields_ordered($newField); } } if ( $info->{notes} ) { - my ( $tag, $subfield ) = - GetMarcFromKohaField( "items.itemnotes", $fwk ); + my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemnotes", $fwk ); - # warn "items.itemnotes : $tag , $subfield"; if ( $marcrecord->field($tag) ) { - $marcrecord->field($tag) - ->add_subfields( "$subfield" => $info->{notes} ); - } - else { - my $newField = - MARC::Field->new( "$tag", '', '', - "$subfield" => $info->{notes} ); + $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{notes} ); + } else { + my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{notes} ); $marcrecord->insert_fields_ordered($newField); } } if ( $info->{location} ) { - my ( $tag, $subfield ) = - GetMarcFromKohaField( "items.location", $fwk ); + my ( $tag, $subfield ) = GetMarcFromKohaField( "items.location", $fwk ); - # warn "items.location : $tag , $subfield"; if ( $marcrecord->field($tag) ) { - $marcrecord->field($tag) - ->add_subfields( "$subfield" => $info->{location} ); - } - else { - my $newField = - MARC::Field->new( "$tag", '', '', - "$subfield" => $info->{location} ); + $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{location} ); + } else { + my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{location} ); $marcrecord->insert_fields_ordered($newField); } } if ( $info->{status} ) { - my ( $tag, $subfield ) = - GetMarcFromKohaField( "items.notforloan", - $fwk ); + my ( $tag, $subfield ) = GetMarcFromKohaField( "items.notforloan", $fwk ); - # warn "items.notforloan : $tag , $subfield"; if ( $marcrecord->field($tag) ) { - $marcrecord->field($tag) - ->add_subfields( "$subfield" => $info->{status} ); - } - else { - my $newField = - MARC::Field->new( "$tag", '', '', - "$subfield" => $info->{status} ); + $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{status} ); + } else { + my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{status} ); $marcrecord->insert_fields_ordered($newField); } } if ( C4::Context->preference("RoutingSerials") ) { - my ( $tag, $subfield ) = - GetMarcFromKohaField( "items.dateaccessioned", - $fwk ); + my ( $tag, $subfield ) = GetMarcFromKohaField( "items.dateaccessioned", $fwk ); if ( $marcrecord->field($tag) ) { - $marcrecord->field($tag) - ->add_subfields( "$subfield" => $now ); - } - else { - my $newField = - MARC::Field->new( "$tag", '', '', "$subfield" => $now ); + $marcrecord->field($tag)->add_subfields( "$subfield" => $now ); + } else { + my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $now ); $marcrecord->insert_fields_ordered($newField); } } - AddItem( $marcrecord, $data->{'biblionumber'} ); + AddItemFromMarc( $marcrecord, $data->{'biblionumber'} ); return 1; } return ( 0, @errors ); } } -=head2 HasSubscriptionExpired +=head2 HasSubscriptionStrictlyExpired + +1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid) -=over 4 +the subscription has stricly expired when today > the end subscription date -1 or 0 = HasSubscriptionExpired($subscriptionid) +return : +1 if true, 0 if false, -1 if the expiration date is not set. + +=cut + +sub HasSubscriptionStrictlyExpired { + + # Getting end of subscription date + my ($subscriptionid) = @_; + my $dbh = C4::Context->dbh; + my $subscription = GetSubscription($subscriptionid); + my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid); + + # If the expiration date is set + if ( $expirationdate != 0 ) { + my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate ); + + # Getting today's date + my ( $nowyear, $nowmonth, $nowday ) = Today(); + + # if today's date > expiration date, then the subscription has stricly expired + if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) { + return 1; + } else { + return 0; + } + } else { + + # There are some cases where the expiration date is not set + # As we can't determine if the subscription has expired on a date-basis, + # we return -1; + return -1; + } +} + +=head2 HasSubscriptionExpired + +$has_expired = 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 +0 if the subscription has not expired +1 if the subscription has expired +2 if has subscription does not have a valid expiration date set =cut @@ -1725,44 +1592,44 @@ sub HasSubscriptionExpired { my ($subscriptionid) = @_; my $dbh = C4::Context->dbh; my $subscription = GetSubscription($subscriptionid); - if (($subscription->{periodicity} % 16)>0){ - my $expirationdate = GetExpirationDate($subscriptionid); - my $query = qq| + if ( ( $subscription->{periodicity} % 16 ) > 0 ) { + my $expirationdate = $subscription->{enddate}; + if (!defined $expirationdate) { + $expirationdate = q{}; + } + my $query = qq| SELECT max(planneddate) FROM serial WHERE subscriptionid=? |; - my $sth = $dbh->prepare($query); - $sth->execute($subscriptionid); - my ($res) = $sth->fetchrow ; - my @res=split (/-/,$res); -# warn "date expiration :$expirationdate"; - my @endofsubscriptiondate=split(/-/,$expirationdate); - return 1 if ( (@endofsubscriptiondate && Delta_Days($res[0],$res[1],$res[2], - $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) <= 0) - || (!$res)); - return 0; + my $sth = $dbh->prepare($query); + $sth->execute($subscriptionid); + my ($res) = $sth->fetchrow; + return 0 unless $res; + my @res = split( /-/, $res ); + my @endofsubscriptiondate = split( /-/, $expirationdate ); + return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) ); + return 1 + if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 ) + || ( !$res ) ); + return 0; } else { - if ($subscription->{'numberlength'}){ - my $countreceived=countissuesfrom($subscriptionid,$subscription->{'startdate'}); - return 1 if ($countreceived >$subscription->{'numberlentgh'}); - return 0; - } else { - return 0; - } + if ( $subscription->{'numberlength'} ) { + my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} ); + return 1 if ( $countreceived > $subscription->{'numberlength'} ); + return 0; + } else { + return 0; + } } - return 0; + return 0; # Notice that you'll never get here. } =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 { @@ -1775,16 +1642,13 @@ sub SetDistributedto { |; my $sth = $dbh->prepare($query); $sth->execute( $distributedto, $subscriptionid ); + return; } =head2 DelSubscription -=over 4 - DelSubscription($subscriptionid) -this function delete the subscription which has $subscriptionid as id. - -=back +this function deletes subscription which has $subscriptionid as id. =cut @@ -1793,42 +1657,38 @@ sub DelSubscription { my $dbh = C4::Context->dbh; $subscriptionid = $dbh->quote($subscriptionid); $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid"); - $dbh->do( - "DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid"); + $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid"); $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid"); - - &logaction(C4::Context->userenv->{'number'},"SERIAL","DELETE",$subscriptionid,"") - if C4::Context->preference("SubscriptionLog"); + + logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog"); } =head2 DelIssue -=over 4 - DelIssue($serialseq,$subscriptionid) -this function delete an issue which has $serialseq and $subscriptionid given on input arg. +this function deletes an issue which has $serialseq and $subscriptionid given on input arg. -=back +returns the number of rows affected =cut sub DelIssue { - my ( $dataissue) = @_; - my $dbh = C4::Context->dbh; + my ($dataissue) = @_; + my $dbh = C4::Context->dbh; ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ? - + my $query = qq| DELETE FROM serial WHERE serialid= ? AND subscriptionid= ? |; my $mainsth = $dbh->prepare($query); - $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'}); + $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} ); #Delete element from subscription history $query = "SELECT * FROM subscription WHERE subscriptionid = ?"; - my $sth = $dbh->prepare($query); - $sth->execute($dataissue->{'subscriptionid'}); + my $sth = $dbh->prepare($query); + $sth->execute( $dataissue->{'subscriptionid'} ); my $val = $sth->fetchrow_hashref; unless ( $val->{manualhistory} ) { my $query = qq| @@ -1836,123 +1696,94 @@ sub DelIssue { WHERE subscriptionid= ? |; my $sth = $dbh->prepare($query); - $sth->execute($dataissue->{'subscriptionid'}); - my $data = $sth->fetchrow_hashref; - my $serialseq= $dataissue->{'serialseq'}; + $sth->execute( $dataissue->{'subscriptionid'} ); + my $data = $sth->fetchrow_hashref; + my $serialseq = $dataissue->{'serialseq'}; $data->{'missinglist'} =~ s/\b$serialseq\b//; $data->{'recievedlist'} =~ s/\b$serialseq\b//; - my $strsth = "UPDATE subscriptionhistory SET " - . join( ",", - map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) - . " WHERE subscriptionid=?"; + my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?"; $sth = $dbh->prepare($strsth); - $sth->execute($dataissue->{'subscriptionid'}); + $sth->execute( $dataissue->{'subscriptionid'} ); } - + return $mainsth->rows; } =head2 GetLateOrMissingIssues -=over 4 - -($count,@issuelist) = &GetLateMissingIssues($supplierid,$serialid) +@issuelist = GetLateMissingIssues($supplierid,$serialid) -this function select missing issues on database - where serial.status = 4 or serial.status=3 or planneddatedbh; my $sth; my $byserial = ''; if ($serialid) { $byserial = "and serialid = " . $serialid; } - if ($order){ - $order.=", title"; + if ($order) { + $order .= ", title"; } else { - $order="title"; + $order = "title"; } if ($supplierid) { $sth = $dbh->prepare( -"SELECT - serialid, - aqbooksellerid, - name, - biblio.title, - planneddate, - serialseq, - serial.status, - serial.subscriptionid, - claimdate -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)) -AND subscription.aqbooksellerid=$supplierid -$byserial -ORDER BY $order" + "SELECT + serialid, aqbooksellerid, name, + biblio.title, planneddate, serialseq, + serial.status, serial.subscriptionid, claimdate + 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)) + AND subscription.aqbooksellerid=$supplierid + $byserial + ORDER BY $order" ); - } - else { + } else { $sth = $dbh->prepare( -"SELECT - serialid, - aqbooksellerid, - name, - biblio.title, - planneddate, - serialseq, - serial.status, - serial.subscriptionid, - claimdate -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)) -$byserial -ORDER BY $order" + "SELECT + serialid, aqbooksellerid, name, + biblio.title, planneddate, serialseq, + serial.status, serial.subscriptionid, claimdate + 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)) + $byserial + ORDER BY $order" ); } $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} ); + + if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) { + $line->{planneddate} = format_date( $line->{planneddate} ); + } + if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) { + $line->{claimdate} = format_date( $line->{claimdate} ); + } $line->{"status".$line->{status}} = 1; - $line->{'odd'} = 1 if $odd % 2; - $count++; push @issuelist, $line; } - return $count, @issuelist; + return @issuelist; } =head2 removeMissingIssue -=over 4 - removeMissingIssue($subscriptionid) this function removes an issue from being part of the missing string in @@ -1960,16 +1791,12 @@ subscriptionlist.missinglist column called when a missing issue is found from the serials-recieve.pl file -=back - =cut sub removeMissingIssue { my ( $sequence, $subscriptionid ) = @_; my $dbh = C4::Context->dbh; - my $sth = - $dbh->prepare( - "SELECT * FROM subscriptionhistory WHERE subscriptionid = ?"); + my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?"); $sth->execute($subscriptionid); my $data = $sth->fetchrow_hashref; my $missinglist = $data->{'missinglist'}; @@ -1985,25 +1812,22 @@ sub removeMissingIssue { $missinglist =~ s/\|$//g; my $sth2 = $dbh->prepare( "UPDATE subscriptionhistory - SET missinglist = ? - WHERE subscriptionid = ?" + SET missinglist = ? + WHERE subscriptionid = ?" ); $sth2->execute( $missinglist, $subscriptionid ); } + return; } =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 { @@ -2011,25 +1835,22 @@ sub updateClaim { my $dbh = C4::Context->dbh; my $sth = $dbh->prepare( "UPDATE serial SET claimdate = now() - WHERE serialid = ? - " + WHERE serialid = ? + " ); $sth->execute($serialid); + return; } =head2 getsupplierbyserialid -=over 4 - -($result) = &getsupplierbyserialid($serialid) +$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 { @@ -2038,9 +1859,9 @@ sub getsupplierbyserialid { my $sth = $dbh->prepare( "SELECT serialid, serial.subscriptionid, aqbooksellerid FROM serial - LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid - WHERE serialid = ? - " + LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid + WHERE serialid = ? + " ); $sth->execute($serialid); my $line = $sth->fetchrow_hashref; @@ -2050,13 +1871,10 @@ sub getsupplierbyserialid { =head2 check_routing -=over 4 - -($result) = &check_routing($subscriptionid) +$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 @@ -2064,7 +1882,7 @@ sub check_routing { my ($subscriptionid) = @_; my $dbh = C4::Context->dbh; my $sth = $dbh->prepare( -"SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist + "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid WHERE subscription.subscriptionid = ? ORDER BY ranking ASC " @@ -2077,47 +1895,34 @@ sub check_routing { =head2 addroutingmember -=over 4 - -&addroutingmember($borrowernumber,$subscriptionid) +addroutingmember($borrowernumber,$subscriptionid) -this function takes a borrowernumber and subscriptionid and add the member to the +this function takes a borrowernumber and subscriptionid and adds 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 ( $borrowernumber, $subscriptionid ) = @_; my $rank; my $dbh = C4::Context->dbh; - my $sth = - $dbh->prepare( -"SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" - ); + 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 { + } else { $rank = 1; } } - $sth = - $dbh->prepare( -"INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" - ); + $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" ); $sth->execute( $subscriptionid, $borrowernumber, $rank ); } =head2 reorder_members -=over 4 - -&reorder_members($subscriptionid,$routingid,$rank) +reorder_members($subscriptionid,$routingid,$rank) this function is used to reorder the routing list @@ -2127,17 +1932,12 @@ it takes the routingid of the member one wants to re-rank and the rank it is to - 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" - ); + my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" ); $sth->execute($subscriptionid); my @result; while ( my $line = $sth->fetchrow_hashref ) { @@ -2156,81 +1956,63 @@ sub reorder_members { # 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 $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] - . "'" ); + my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" ); $sth->execute; } + return; } =head2 delroutingmember -=over 4 - -&delroutingmember($routingid,$subscriptionid) +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 + # 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 = ?"); + 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 = ?"); + } else { + my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?"); $sth->execute($subscriptionid); } + return; } =head2 getroutinglist -=over 4 - -($count,@routinglist) = &getroutinglist($subscriptionid) +($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 +the routinglist as an array. Each element of the array contains a hash_ref containing 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 subscription - LEFT JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid - WHERE subscription.subscriptionid = ? ORDER BY ranking ASC + "SELECT routingid, borrowernumber, ranking, biblionumber + FROM subscription + JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid + WHERE subscription.subscriptionid = ? ORDER BY ranking ASC " ); $sth->execute($subscriptionid); @@ -2245,321 +2027,133 @@ sub getroutinglist { =head2 countissuesfrom -=over 4 +$result = countissuesfrom($subscriptionid,$startdate) -$result = &countissuesfrom($subscriptionid,$startdate) - - -=back +Returns a count of serial rows matching the given subsctiptionid +with published date greater than startdate =cut sub countissuesfrom { - my ($subscriptionid,$startdate) = @_; - my $dbh = C4::Context->dbh; + my ( $subscriptionid, $startdate ) = @_; + my $dbh = C4::Context->dbh; my $query = qq| SELECT count(*) FROM serial WHERE subscriptionid=? AND serial.publisheddate>? |; - my $sth=$dbh->prepare($query); - $sth->execute($subscriptionid, $startdate); - my ($countreceived)=$sth->fetchrow; - return $countreceived; + my $sth = $dbh->prepare($query); + $sth->execute( $subscriptionid, $startdate ); + my ($countreceived) = $sth->fetchrow; + return $countreceived; } -=head2 abouttoexpire - -=over 4 - -$result = &abouttoexpire($subscriptionid) - -this function alerts you to the penultimate issue for a serial subscription +=head2 CountIssues -returns 1 - if this is the penultimate issue -returns 0 - if not +$result = CountIssues($subscriptionid) -=back +Returns a count of serial rows matching the given subsctiptionid =cut -sub abouttoexpire { +sub CountIssues { my ($subscriptionid) = @_; my $dbh = C4::Context->dbh; - my $subscription = GetSubscription($subscriptionid); - my $per = $subscription->{'periodicity'}; - if ($per % 16>0){ - my $expirationdate = GetExpirationDate($subscriptionid); - my $sth = - $dbh->prepare( - "select max(planneddate) from serial where subscriptionid=?"); - $sth->execute($subscriptionid); - my ($res) = $sth->fetchrow ; -# warn "date expiration : ".$expirationdate." date courante ".$res; - my @res=split /-/,$res; - @res=Date::Calc::Today if ($res[0]*$res[1]==0); - my @endofsubscriptiondate=split/-/,$expirationdate; - my $x; - if ( $per == 1 ) {$x=7;} - if ( $per == 2 ) {$x=7; } - if ( $per == 3 ) {$x=14;} - if ( $per == 4 ) { $x = 21; } - if ( $per == 5 ) { $x = 31; } - if ( $per == 6 ) { $x = 62; } - if ( $per == 7 || $per == 8 ) { $x = 93; } - if ( $per == 9 ) { $x = 190; } - if ( $per == 10 ) { $x = 365; } - if ( $per == 11 ) { $x = 730; } - my @datebeforeend=Add_Delta_Days( $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2], - - (3 * $x)) if (@endofsubscriptiondate); - # warn "DATE BEFORE END: $datebeforeend"; - 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); - } else {return 0} -} - -=head2 old_newsubscription - -=over 4 - -($subscriptionid) = &old_newsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber, - $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength, - $add1,$every1,$whenmorethan1,$setto1,$lastvalue1, - $add2,$every2,$whenmorethan2,$setto2,$lastvalue2, - $add3,$every3,$whenmorethan3,$setto3,$lastvalue3, - $numberingmethod, $status, $callnumber, $notes, $hemisphere) - -this function is similar to the NewSubscription subroutine but has a few different -values passed in -$firstacquidate - date of first serial issue to arrive -$irregularity - the issues not expected separated by a '|' -- eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7' -$numberpattern - the number for an array of labels to reconstruct the javascript correctly in the - subscription-add.tmpl file -$callnumber - display the callnumber of the serial -$hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials - -return : -the $subscriptionid number of the new subscription - -=back - -=cut - -sub old_newsubscription { - my ( - $auser, $aqbooksellerid, $cost, $aqbudgetid, - $biblionumber, $startdate, $periodicity, $firstacquidate, - $dow, $irregularity, $numberpattern, $numberlength, - $weeklength, $monthlength, $add1, $every1, - $whenmorethan1, $setto1, $lastvalue1, $add2, - $every2, $whenmorethan2, $setto2, $lastvalue2, - $add3, $every3, $whenmorethan3, $setto3, - $lastvalue3, $numberingmethod, $status, $callnumber, - $notes, $hemisphere - ) = @_; - my $dbh = C4::Context->dbh; - - #save subscription - my $sth = $dbh->prepare( -"insert into subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber, - startdate,periodicity,firstacquidate,dow,irregularity,numberpattern,numberlength,weeklength,monthlength, - add1,every1,whenmorethan1,setto1,lastvalue1, - add2,every2,whenmorethan2,setto2,lastvalue2, - add3,every3,whenmorethan3,setto3,lastvalue3, - numberingmethod, status, callnumber, notes, hemisphere) values - (?,?,?,?,?,?,?,?,?,?,?, - ?,?,?,?,?,?,?,?,?,?,?, - ?,?,?,?,?,?,?,?,?,?,?,?)" - ); - $sth->execute( - $auser, $aqbooksellerid, - $cost, $aqbudgetid, - $biblionumber, format_date_in_iso($startdate), - $periodicity, format_date_in_iso($firstacquidate), - $dow, $irregularity, - $numberpattern, $numberlength, - $weeklength, $monthlength, - $add1, $every1, - $whenmorethan1, $setto1, - $lastvalue1, $add2, - $every2, $whenmorethan2, - $setto2, $lastvalue2, - $add3, $every3, - $whenmorethan3, $setto3, - $lastvalue3, $numberingmethod, - $status, $callnumber, - $notes, $hemisphere - ); - - #then create the 1st waited number - my $subscriptionid = $dbh->{'mysql_insertid'}; - my $enddate = GetExpirationDate($subscriptionid); - - $sth = - $dbh->prepare( -"insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)" - ); - $sth->execute( - $biblionumber, $subscriptionid, - format_date_in_iso($startdate), - format_date_in_iso($enddate), - "", "", "", $notes - ); - - # reread subscription to get a hash (for calculation of the 1st issue number) - $sth = - $dbh->prepare("select * from subscription where subscriptionid = ? "); + my $query = qq| + SELECT count(*) + FROM serial + WHERE subscriptionid=? + |; + my $sth = $dbh->prepare($query); $sth->execute($subscriptionid); - my $val = $sth->fetchrow_hashref; - - # calculate issue number - my $serialseq = GetSeq($val); - $sth = - $dbh->prepare( -"insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)" - ); - $sth->execute( $serialseq, $subscriptionid, $val->{'biblionumber'}, - 1, format_date_in_iso($startdate) ); - return $subscriptionid; + my ($countreceived) = $sth->fetchrow; + return $countreceived; } -=head2 old_modsubscription - -=over 4 - -($subscriptionid) = &old_modsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber, - $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength, - $add1,$every1,$whenmorethan1,$setto1,$lastvalue1, - $add2,$every2,$whenmorethan2,$setto2,$lastvalue2, - $add3,$every3,$whenmorethan3,$setto3,$lastvalue3, - $numberingmethod, $status, $callnumber, $notes, $hemisphere, $subscriptionid) +=head2 HasItems -this function is similar to the ModSubscription subroutine but has a few different -values passed in -$firstacquidate - date of first serial issue to arrive -$irregularity - the issues not expected separated by a '|' -- eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7' -$numberpattern - the number for an array of labels to reconstruct the javascript correctly in the - subscription-add.tmpl file -$callnumber - display the callnumber of the serial -$hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials +$result = HasItems($subscriptionid) -=back +returns a count of items from serial matching the subscriptionid =cut -sub old_modsubscription { - my ( - $auser, $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, - $hemisphere, $subscriptionid - ) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare( -"update subscription set librarian=?, 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=?, hemisphere=? where subscriptionid = ?" - ); - $sth->execute( - $auser, $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, - $hemisphere, $subscriptionid - ); - $sth->finish; - - $sth = - $dbh->prepare("select * from subscription where subscriptionid = ? "); +sub HasItems { + my ($subscriptionid) = @_; + my $dbh = C4::Context->dbh; + my $query = q| + SELECT COUNT(serialitems.itemnumber) + FROM serial + LEFT JOIN serialitems USING(serialid) + WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL + |; + my $sth=$dbh->prepare($query); $sth->execute($subscriptionid); - my $val = $sth->fetchrow_hashref; - - # calculate issue number - my $serialseq = Get_Seq($val); - $sth = - $dbh->prepare("UPDATE serial SET serialseq = ? WHERE subscriptionid = ?"); - $sth->execute( $serialseq, $subscriptionid ); - - my $enddate = subscriptionexpirationdate($subscriptionid); - $sth = $dbh->prepare("update subscriptionhistory set enddate=?"); - $sth->execute( format_date_in_iso($enddate) ); + my ($countitems)=$sth->fetchrow_array(); + return $countitems; } -=head2 old_getserials - -=over 4 - -($totalissues,@serials) = &old_getserials($subscriptionid) +=head2 abouttoexpire -this function get a hashref of serials and the total count of them +$result = abouttoexpire($subscriptionid) -return : -$totalissues - number of serial lines -the serials into a table. Each line of this table containts a ref to a hash which it containts -serialid, serialseq, status,planneddate,notes,routingnotes from tables : serial where status is not 2, 4, or 5 +this function alerts you to the penultimate issue for a serial subscription -=back +returns 1 - if this is the penultimate issue +returns 0 - if not =cut -sub old_getserials { +sub abouttoexpire { my ($subscriptionid) = @_; - my $dbh = C4::Context->dbh; + my $dbh = C4::Context->dbh; + my $subscription = GetSubscription($subscriptionid); + my $per = $subscription->{'periodicity'}; + if ($per && $per % 16 > 0){ + 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 @endofsubscriptiondate=split(/-/,$expirationdate); + my @per_list = (0, 7, 7, 14, 21, 31, 62, 93, 93, 190, 365, 730, 0, 0, 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; +} - # status = 2 is "arrived" - my $sth = - $dbh->prepare( -"select serialid,serialseq, status, planneddate,notes,routingnotes from serial where subscriptionid = ? and status <>2 and status <>4 and status <>5" - ); - $sth->execute($subscriptionid); - my @serials; - my $num = 1; - 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->{"num"} = $num; - $num++; - push @serials, $line; +sub in_array { # used in next sub down + my ( $val, @elements ) = @_; + foreach my $elem (@elements) { + if ( $val == $elem ) { + return 1; + } } - $sth = $dbh->prepare("select count(*) from serial where subscriptionid=?"); - $sth->execute($subscriptionid); - my ($totalissues) = $sth->fetchrow; - return ( $totalissues, @serials ); + return 0; } =head2 GetNextDate -($resultdate) = &GetNextDate($planneddate,$subscription) +$resultdate = GetNextDate($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 +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 skipped then the returned date will be 2007-05-10 @@ -2570,134 +2164,151 @@ $resultdate - then next date in the sequence Return 0 if periodicity==0 =cut -sub in_array { # used in next sub down - my ($val,@elements) = @_; - foreach my $elem(@elements) { - if($val == $elem) { - return 1; - } - } - return 0; -} sub GetNextDate(@) { my ( $planneddate, $subscription ) = @_; my @irreg = split( /\,/, $subscription->{irregularity} ); #date supposed to be in ISO. - - my ( $year, $month, $day ) = split(/-/, $planneddate); - $month=1 unless ($month); - $day=1 unless ($day); + + my ( $year, $month, $day ) = split( /-/, $planneddate ); + $month = 1 unless ($month); + $day = 1 unless ($day); my @resultdate; # warn "DOW $dayofweek"; - if ( $subscription->{periodicity} % 16 == 0 ) { - return 0; - } + if ( $subscription->{periodicity} % 16 == 0 ) { # 'without regularity' || 'irregular' + return 0; + } + + # 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 = Day_of_Week( $year,$month, $day ); - 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++; + 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++; + } } + @resultdate = Add_Delta_Days( $year, $month, $day, 1 ); } - @resultdate = Add_Delta_Days($year,$month, $day , 1 ); } + + # 1 week if ( $subscription->{periodicity} == 2 ) { - my ($wkno,$year) = Week_of_Year( $year,$month, $day ); - for ( my $i = 0 ; $i < @irreg ; $i++ ) { - 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); + 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 ); + } } + @resultdate = Add_Delta_Days( $year, $month, $day, 7 ); } - @resultdate = Add_Delta_Days( $year,$month, $day, 7); } + + # 1 / 2 weeks if ( $subscription->{periodicity} == 3 ) { - my ($wkno,$year) = Week_of_Year( $year,$month, $day ); - 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); + 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 ); + } } + @resultdate = Add_Delta_Days( $year, $month, $day, 14 ); } - @resultdate = Add_Delta_Days($year,$month, $day , 14 ); } + + # 1 / 3 weeks if ( $subscription->{periodicity} == 4 ) { - my ($wkno,$year) = Week_of_Year( $year,$month, $day ); - 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); + 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 ); + } } + @resultdate = Add_Delta_Days( $year, $month, $day, 21 ); } - @resultdate = Add_Delta_Days($year,$month, $day , 21 ); } - my $tmpmonth=$month; - 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); + 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 ); + } } + @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 1, 0 ); } - @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); + 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 ); + } } + @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 2, 0 ); } - @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); + 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 ); + } } + @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 ); } - @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->{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 ); + } } + @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 ); } - @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 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->{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 ); + } } + @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 ); } - @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 ); } - my $resultdate=sprintf("%04d-%02d-%02d",$resultdate[0],$resultdate[1],$resultdate[2]); -# warn "dateNEXTSEQ : ".$resultdate; + my $resultdate = sprintf( "%04d-%02d-%02d", $resultdate[0], $resultdate[1], $resultdate[2] ); + return "$resultdate"; } =head2 itemdata - $item = &itemdata($barcode); + $item = itemdata($barcode); Looks up the item with the given barcode, and returns a reference-to-hash containing information about that item. The keys of @@ -2720,14 +2331,11 @@ sub itemdata { return ($data); } -END { } # module clean-up code here (global destructor) - 1; - -=back +__END__ =head1 AUTHOR -Koha Developement team +Koha Development Team =cut