X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FSerials.pm;h=4ca031299e73a10d12a12bf6a95977cecaf69ac4;hb=57fcd4884eaee2637c3a3ad0cbe3af3b5b0c49fc;hp=f2828d79c6c47180920d6fc85280acbb696cba90;hpb=4399daf0bdc0deabb13ec7b16198260bd5bc6b0c;p=koha.git diff --git a/C4/Serials.pm b/C4/Serials.pm index f2828d79c6..4ca031299e 100644 --- a/C4/Serials.pm +++ b/C4/Serials.pm @@ -19,44 +19,25 @@ package C4::Serials; #assumes C4/Serials.pm use strict; -use C4::Date; +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::Items; use C4::Search; use C4::Letters; use C4::Log; # logaction - -require Exporter; +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 ); -}; - -=head1 NAME - -C4::Serials - Give functions for serializing. - -=head1 SYNOPSIS - - use C4::Serials; - -=head1 DESCRIPTION - -Give all XYZ functions - -=head1 FUNCTIONS - -=cut - -@ISA = qw(Exporter); -@EXPORT = qw( - +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 @@ -66,7 +47,7 @@ Give all XYZ functions &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2 &ReNewSubscription &GetLateIssues &GetLateOrMissingIssues &GetSerialInformation &AddItem2Serial - &PrepareSerialsData + &PrepareSerialsData &GetNextExpected &ModNextExpected &UpdateClaimdateIssues &GetSuppliersWithLateIssues &getsupplierbyserialid @@ -76,10 +57,25 @@ Give all XYZ functions &check_routing &updateClaim &removeMissingIssue &old_newsubscription &old_modsubscription &old_getserials -); + ); +} =head2 GetSuppliersWithLateIssues +=head1 NAME + +C4::Serials - Give functions for serializing. + +=head1 SYNOPSIS + + use C4::Serials; + +=head1 DESCRIPTION + +Give all XYZ functions + +=head1 FUNCTIONS + =over 4 %supplierlist = &GetSuppliersWithLateIssues @@ -244,7 +240,7 @@ 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|; + 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'}){ @@ -258,19 +254,20 @@ sub GetSerialInformation { my $rq = $dbh->prepare($query); $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'}; + $debug and warn "itemnumber :$itemnum->[0], bibnum :".$data->{'biblionumber'}; my $itemprocessed = - PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum ); - $itemprocessed->{'itemnumber'} = $itemnum; - $itemprocessed->{'itemid'} = $itemnum; + 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; @@ -278,7 +275,7 @@ sub GetSerialInformation { } else { my $itemprocessed = - PrepareItemrecordDisplay( $data->{'biblionumber'} ); + PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data ); $itemprocessed->{'itemid'} = "N$serialid"; $itemprocessed->{'serialid'} = $serialid; $itemprocessed->{'biblionumber'} = $data->{'biblionumber'}; @@ -300,6 +297,7 @@ sub GetSerialInformation { $data = AddItem2Serial($serialid,$itemnumber); Adds an itemnumber to Serial record + =back =cut @@ -307,12 +305,8 @@ Adds an itemnumber to Serial record 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 $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?"); + $rq->execute($serialid, $itemnumber); return $rq->rows; } @@ -324,6 +318,7 @@ UpdateClaimdateIssues($serialids,[$date]); Update Claimdate for issues in @$serialids list with date $date (Take Today if none) + =back =cut @@ -361,6 +356,7 @@ sub GetSubscription { my $query = qq( SELECT subscription.*, subscriptionhistory.*, + subscriptionhistory.enddate as histenddate, aqbudget.bookfundid, aqbooksellers.name AS aqbooksellername, biblio.title AS bibliotitle, @@ -382,15 +378,13 @@ sub GetSubscription { # if (C4::Context->preference('IndependantBranches') && # C4::Context->userenv && # C4::Context->userenv->{'flags'} != 1){ -# # warn "flags: ".C4::Context->userenv->{'flags'}; +# # $debug and warn "flags: ".C4::Context->userenv->{'flags'}; # $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")"; # } -# warn "query : $query"; + $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 @@ -437,11 +431,10 @@ 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({}); } @@ -527,6 +520,7 @@ sub GetSubscriptionsFromBiblionumber { SELECT subscription.*, branches.branchname, subscriptionhistory.*, + subscriptionhistory.enddate as histenddate, aqbudget.bookfundid, aqbooksellers.name AS aqbooksellername, biblio.title AS bibliotitle @@ -549,6 +543,7 @@ sub GetSubscriptionsFromBiblionumber { 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; @@ -620,8 +615,7 @@ sub GetFullSubscriptionsFromBiblionumber { |; my $sth = $dbh->prepare($query); $sth->execute($biblionumber); - my $subs= $sth->fetchall_arrayref({}); - return $subs; + return $sth->fetchall_arrayref({}); } =head2 GetSubscriptions @@ -651,7 +645,7 @@ sub GetSubscriptions { WHERE biblio.biblionumber=? ); $query.=" ORDER BY title"; -# warn "query :$query"; + $debug and warn "GetSubscriptions query: $query"; $sth = $dbh->prepare($query); $sth->execute($biblionumber); } @@ -664,6 +658,7 @@ sub GetSubscriptions { LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber WHERE (biblioitems.issn = ? or|. join('and ',map{"biblio.title LIKE \"%$_%\""}split (" ",$title))." )"; $query.=" ORDER BY title"; + $debug and warn "GetSubscriptions query: $query"; $sth = $dbh->prepare($query); $sth->execute( $ISSN ); } @@ -677,7 +672,7 @@ sub GetSubscriptions { WHERE biblioitems.issn LIKE ? ); $query.=" ORDER BY title"; -# warn "query :$query"; + $debug and warn "GetSubscriptions query: $query"; $sth = $dbh->prepare($query); $sth->execute( "%" . $ISSN . "%" ); } @@ -691,7 +686,7 @@ sub GetSubscriptions { ).($title?" and ":""). join('and ',map{"biblio.title LIKE \"%$_%\""} split (" ",$title) ); $query.=" ORDER BY title"; -# warn $query; + $debug and warn "GetSubscriptions query: $query"; $sth = $dbh->prepare($query); $sth->execute; } @@ -704,13 +699,12 @@ sub GetSubscriptions { if ( $previoustitle eq $line->{title} ) { $line->{title} = ""; $line->{issn} = ""; - $line->{toggle} = 1 if $odd == 1; } else { $previoustitle = $line->{title}; $odd = -$odd; - $line->{toggle} = 1 if $odd == 1; } + $line->{toggle} = 1 if $odd == 1; $line->{'cannotedit'}=(C4::Context->preference('IndependantBranches') && C4::Context->userenv && C4::Context->userenv->{flags} !=1 && @@ -730,6 +724,8 @@ this function get every serial not arrived for a given subscription as well as the number of issues registered in the database (all types) this number is used to see if a subscription can be deleted (=it must have only 1 issue) +FIXME: We should return \@serials. + =back =cut @@ -803,7 +799,7 @@ sub GetSerials2 { WHERE subscriptionid=$subscription AND status IN ($status) ORDER BY publisheddate,serialid DESC |; -# warn $query; + $debug and warn "GetSerials2 query: $query"; my $sth=$dbh->prepare($query); $sth->execute; my @serials; @@ -941,19 +937,18 @@ sub GetNextSeq { $newlastvalue1 = $val->{lastvalue1}; $newlastvalue2 = $val->{lastvalue2}; $newlastvalue3 = $val->{lastvalue3}; - $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}); + $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}+$val->{add2}; - $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2}-$val->{setto2}); + $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 ) { @@ -973,8 +968,8 @@ sub GetNextSeq { $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}); + $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; @@ -1224,6 +1219,61 @@ sub ModSerialStatus { } } +=head2 GetNextExpected + +=over 4 + +$nextexpected = GetNextExpected($subscriptionid) + +Get the planneddate for the current expected issue of the subscription. + +returns a hashref: + +$nextexepected = { + serialid => int + planneddate => C4::Dates object + } + +=back + +=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; + $nextissue->{planneddate} = C4::Dates->new($nextissue->{planneddate},'iso'); + return $nextissue; +} +=head2 ModNextExpected + +=over 4 + +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. + +=back + +=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; + +} + =head2 ModSubscription =over 4 @@ -1246,7 +1296,7 @@ sub ModSubscription { $whenmorethan3, $setto3, $lastvalue3, $innerloop3, $numberingmethod, $status, $biblionumber, $callnumber, $notes, $letter, $hemisphere, $manualhistory, - $internalnotes, + $internalnotes, $serialsadditems, $subscriptionid ) = @_; # warn $irregularity; @@ -1257,7 +1307,7 @@ 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=? WHERE subscriptionid = ?"; # warn "query :".$query; my $sth = $dbh->prepare($query); @@ -1272,14 +1322,13 @@ sub ModSubscription { $whenmorethan3, $setto3, $lastvalue3, $innerloop3, $numberingmethod, $status, $biblionumber, $callnumber, $notes, $letter, $hemisphere, ($manualhistory?$manualhistory:0), - $internalnotes, + $internalnotes, $serialsadditems, $subscriptionid ); my $rows=$sth->rows; $sth->finish; - &logaction(C4::Context->userenv->{'number'},"SERIAL","MODIFY",$subscriptionid,"") - if C4::Context->preference("SubscriptionLog"); + logaction("SERIAL", "MODIFY", $subscriptionid, "") if C4::Context->preference("SubscriptionLog"); return $rows; } @@ -1292,7 +1341,7 @@ $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbu $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) Create a new subscription with value given on input args. @@ -1315,7 +1364,7 @@ sub NewSubscription { $lastvalue3, $innerloop3, $numberingmethod, $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern, $callnumber, $hemisphere, $manualhistory, - $internalnotes + $internalnotes, $serialsadditems, ) = @_; my $dbh = C4::Context->dbh; @@ -1328,8 +1377,8 @@ 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) + VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) |; my $sth = $dbh->prepare($query); $sth->execute( @@ -1350,23 +1399,23 @@ sub NewSubscription { $lastvalue3, $innerloop3, $numberingmethod, "$status", $notes, $letter, - $firstacquidate, $irregularity, + format_date_in_iso($firstacquidate), $irregularity, $numberpattern, $callnumber, $hemisphere, $manualhistory, - $internalnotes + $internalnotes, $serialsadditems, ); #then create the 1st waited number my $subscriptionid = $dbh->{'mysql_insertid'}; $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" ); + $notes,$internalnotes ); # reread subscription to get a hash (for calculation of the 1st issue number) $query = qq( @@ -1388,13 +1437,24 @@ sub NewSubscription { $sth = $dbh->prepare($query); $sth->execute( "$serialseq", $subscriptionid, $biblionumber, 1, - format_date_in_iso($startdate), - format_date_in_iso($startdate) + format_date_in_iso($firstacquidate), + format_date_in_iso($firstacquidate) ); - &logaction(C4::Context->userenv->{'number'},"SERIAL","ADD",$subscriptionid,"") - if C4::Context->preference("SubscriptionLog"); + 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; } @@ -1425,27 +1485,28 @@ sub ReNewSubscription { 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} - ); + if (C4::Context->preference("RenewSerialAddsSuggestion")){ + NewSuggestion( + $user, $subscription->{bibliotitle}, + $biblio->{author}, $biblio->{publishercode}, + $biblio->{note}, '', + '', '', + '', '', + $subscription->{biblionumber} + ); + } # renew subscription - my $query = qq| + $query = qq| UPDATE subscription SET startdate=?,numberlength=?,weeklength=?,monthlength=? WHERE subscriptionid=? |; - my $sth = $dbh->prepare($query); + $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"); + logaction("SERIAL", "RENEW", $subscriptionid, "") if C4::Context->preference("SubscriptionLog"); } =head2 NewIssue @@ -1699,7 +1760,7 @@ sub ItemizeSerials { $marcrecord->insert_fields_ordered($newField); } } - AddItem( $marcrecord, $data->{'biblionumber'} ); + AddItemFromMarc( $marcrecord, $data->{'biblionumber'} ); return 1; } return ( 0, @errors ); @@ -1745,13 +1806,13 @@ sub HasSubscriptionExpired { } else { if ($subscription->{'numberlength'}){ my $countreceived=countissuesfrom($subscriptionid,$subscription->{'startdate'}); - return 1 if ($countreceived >$subscription->{'numberlentgh'}); + return 1 if ($countreceived >$subscription->{'numberlength'}); return 0; } else { return 0; } } - return 0; + return 0; # Notice that you'll never get here. } =head2 SetDistributedto @@ -1797,8 +1858,7 @@ sub DelSubscription { "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 @@ -2056,6 +2116,7 @@ sub getsupplierbyserialid { 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 @@ -2312,7 +2373,7 @@ sub abouttoexpire { 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); + - (3 * $x)) if (@endofsubscriptiondate && $endofsubscriptiondate[0]*$endofsubscriptiondate[1]*$endofsubscriptiondate[2]); # warn "DATE BEFORE END: $datebeforeend"; return 1 if ( @res && (@datebeforeend && @@ -2592,69 +2653,89 @@ sub GetNextDate(@) { my @resultdate; # warn "DOW $dayofweek"; - if ( $subscription->{periodicity} % 16 == 0 ) { + if ( $subscription->{periodicity} % 16 == 0 ) { # 'without regularity' || 'irregular' return 0; } - 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++; - } - } - @resultdate = Add_Delta_Days($year,$month, $day , 1 ); + # daily : n / week + # Since we're interpreting irregularity here as which days of the week to skip an issue, + # renaming this pattern from 1/day to " n / week ". + if ( $subscription->{periodicity} == 1 ) { + my $dayofweek = eval{Day_of_Week( $year,$month, $day )}; + if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";} + else { + for ( my $i = 0 ; $i < @irreg ; $i++ ) { + $dayofweek = 0 if ( $dayofweek == 7 ); + if ( in_array( ($dayofweek + 1), @irreg ) ) { + ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 1 ); + $dayofweek++; + } + } + @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); - } - } - @resultdate = Add_Delta_Days( $year,$month, $day, 7); + 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); + } } - 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); - } - } - @resultdate = Add_Delta_Days($year,$month, $day , 14 ); + # 1 / 2 weeks + if ( $subscription->{periodicity} == 3 ) { + my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )}; + if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";} + else { + for ( my $i = 0 ; $i < @irreg ; $i++ ) { + if ( $irreg[$i] == (($wkno!=50)?($wkno +2) % 52 :52)) { + ### BUGFIX was previously +1 ^ + ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 14 ); + $wkno=(($wkno!=50)?($wkno +2) % 52 :52); + } + } + @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); - } - } - @resultdate = Add_Delta_Days($year,$month, $day , 21 ); + 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 ); + } } 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 ); + 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 ); } 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 ); + 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 ); } if ( $subscription->{periodicity} == 7 ) { for ( my $i = 0 ; $i < @irreg ; $i++ ) { @@ -2690,7 +2771,9 @@ sub GetNextDate(@) { 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; return "$resultdate"; } @@ -2720,11 +2803,8 @@ sub itemdata { return ($data); } -END { } # module clean-up code here (global destructor) - 1; - -=back +__END__ =head1 AUTHOR