1 package C4::Serials; #assumes C4/Serials.pm
3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA 02111-1307 USA
31 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
33 # set the version for version checking
34 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
35 shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
40 C4::Serials - Give functions for serializing.
48 Give all XYZ functions
55 &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions &GetSubscription
56 &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
57 &GetFullSubscriptionsFromBiblionumber &GetNextSeq
58 &ModSubscriptionHistory &NewIssue
59 &GetSerials &GetLatestSerials &ModSerialStatus
60 &HasSubscriptionExpired &GetSubscriptionExpirationDate &ReNewSubscription
61 &GetSuppliersWithLateIssues &GetLateIssues &GetMissingIssues
62 &GetDistributedTo &SetDistributedto
63 &getroutinglist &delroutingmember &addroutingmember &reorder_members
64 &check_routing &getsupplierbyserialid &updateClaim &removeMissingIssue &abouttoexpire
68 =head2 GetSuppliersWithLateIssues
72 %supplierlist = &GetSuppliersWithLateIssues
74 this function get all suppliers with late issues.
77 the supplierlist into a hash. this hash containts id & name of the supplier
82 sub GetSuppliersWithLateIssues {
83 my $dbh = C4::Context->dbh;
85 SELECT DISTINCT id, name
86 FROM subscription, serial
87 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
88 WHERE subscription.subscriptionid = serial.subscriptionid
89 AND (planneddate < now() OR serial.STATUS = 3 OR serial.STATUS = 4)
91 my $sth = $dbh->prepare($query);
94 while (my ($id,$name) = $sth->fetchrow) {
95 $supplierlist{$id} = $name;
97 if(C4::Context->preference("RoutingSerials")){
98 $supplierlist{''} = "All Suppliers";
100 return %supplierlist;
107 @issuelist = &GetLateIssues($supplierid)
109 this function select late issues on database
112 the issuelist into an table. Each line of this table containts a ref to a hash which it containts
113 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
119 my ($supplierid) = @_;
120 my $dbh = C4::Context->dbh;
124 SELECT name,title,planneddate,serialseq,serial.subscriptionid
125 FROM subscription, serial, biblio
126 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
127 WHERE subscription.subscriptionid = serial.subscriptionid
128 AND ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
129 AND subscription.aqbooksellerid=$supplierid
130 AND biblio.biblionumber = subscription.biblionumber
133 $sth = $dbh->prepare($query);
136 SELECT name,title,planneddate,serialseq,serial.subscriptionid
137 FROM subscription, serial, biblio
138 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
139 WHERE subscription.subscriptionid = serial.subscriptionid
140 AND ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
141 AND biblio.biblionumber = subscription.biblionumber
144 $sth = $dbh->prepare($query);
151 while (my $line = $sth->fetchrow_hashref) {
152 $odd++ unless $line->{title} eq $last_title;
153 $line->{title} = "" if $line->{title} eq $last_title;
154 $last_title = $line->{title} if ($line->{title});
155 $line->{planneddate} = format_date($line->{planneddate});
156 $line->{'odd'} = 1 if $odd %2 ;
158 push @issuelist,$line;
160 return $count,@issuelist;
163 =head2 GetSubscriptionHistoryFromSubscriptionId
167 $sth = GetSubscriptionHistoryFromSubscriptionId()
168 this function just prepare the SQL request.
169 After this function, don't forget to execute it by using $sth->execute($subscriptionid)
171 $sth = $dbh->prepare($query).
176 sub GetSubscriptionHistoryFromSubscriptionId() {
177 my $dbh = C4::Context->dbh;
180 FROM subscriptionhistory
181 WHERE subscriptionid = ?
183 return $dbh->prepare($query);
186 =head2 GetSerialStatusFromSerialId
190 $sth = GetSerialStatusFromSerialId();
191 this function just prepare the SQL request.
192 After this function, don't forget to execute it by using $sth->execute($serialid)
194 $sth = $dbh->prepare($query).
199 sub GetSerialStatusFromSerialId(){
200 my $dbh = C4::Context->dbh;
206 return $dbh->prepare($query);
210 =head2 GetSubscription
214 $subs = GetSubscription($subscriptionid)
215 this function get the subscription which has $subscriptionid as id.
217 a hashref. This hash containts
218 subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
223 sub GetSubscription {
224 my ($subscriptionid) = @_;
225 my $dbh = C4::Context->dbh;
227 SELECT subscription.*,
228 subscriptionhistory.*,
230 aqbooksellers.name AS aqbooksellername,
231 biblio.title AS bibliotitle
233 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
234 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
235 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
236 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
237 WHERE subscription.subscriptionid = ?
239 my $sth = $dbh->prepare($query);
240 $sth->execute($subscriptionid);
241 my $subs = $sth->fetchrow_hashref;
245 =head2 GetSubscriptionsFromBiblionumber
249 \@res = GetSubscriptionsFromBiblionumber($biblionumber)
250 this function get the subscription list. it reads on subscription table.
252 table of subscription which has the biblionumber given on input arg.
253 each line of this table is a hashref. All hashes containt
254 planned, histstartdate,opacnote,missinglist,receivedlist,periodicity,status & enddate
259 sub GetSubscriptionsFromBiblionumber {
260 my ($biblionumber) = @_;
261 my $dbh = C4::Context->dbh;
263 SELECT subscription.*,
264 subscriptionhistory.*,
266 aqbooksellers.name AS aqbooksellername,
267 biblio.title AS bibliotitle
269 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
270 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
271 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
272 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
273 WHERE subscription.biblionumber = ?
275 my $sth = $dbh->prepare($query);
276 $sth->execute($biblionumber);
278 while (my $subs = $sth->fetchrow_hashref) {
279 $subs->{planneddate} = format_date($subs->{planneddate});
280 $subs->{publisheddate} = format_date($subs->{publisheddate});
281 $subs->{histstartdate} = format_date($subs->{histstartdate});
282 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
283 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
284 $subs->{receivedlist} =~ s/\n/\<br\/\>/g;
285 $subs->{"periodicity".$subs->{periodicity}} = 1;
286 $subs->{"status".$subs->{'status'}} = 1;
287 if ($subs->{enddate} eq '0000-00-00') {
290 $subs->{enddate} = format_date($subs->{enddate});
296 =head2 GetFullSubscriptionsFromBiblionumber
300 \@res = GetFullSubscriptionsFromBiblionumber($biblionumber)
301 this function read on serial table.
306 sub GetFullSubscriptionsFromBiblionumber {
307 my ($biblionumber) = @_;
308 my $dbh = C4::Context->dbh;
310 SELECT serial.serialseq,
312 serial.publisheddate,
315 year(serial.publisheddate) AS year,
316 aqbudget.bookfundid,aqbooksellers.name AS aqbooksellername,
317 biblio.title AS bibliotitle
319 LEFT JOIN subscription ON
320 (serial.subscriptionid=subscription.subscriptionid AND subscription.biblionumber=serial.biblionumber)
321 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
322 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
323 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
324 WHERE subscription.biblionumber = ?
325 ORDER BY year,serial.publisheddate,serial.subscriptionid,serial.planneddate
328 my $sth = $dbh->prepare($query);
329 $sth->execute($biblionumber);
333 my $aqbooksellername;
338 while (my $subs = $sth->fetchrow_hashref) {
339 ### BUG To FIX: When there is no published date, will create many null ids!!!
341 if ($year and ($year==$subs->{year})){
342 if ($first eq 1){$first=0;}
343 my $temp=$res[scalar(@res)-1]->{'serials'};
345 {'publisheddate' =>format_date($subs->{'publisheddate'}),
346 'planneddate' => format_date($subs->{'planneddate'}),
347 'serialseq' => $subs->{'serialseq'},
348 "status".$subs->{'status'} => 1,
349 'notes' => $subs->{'notes'} eq $previousnote?"":$subs->{notes},
352 $first=1 if (not $year);
353 $year= $subs->{'year'};
354 $startdate= format_date($subs->{'startdate'});
355 $aqbooksellername= $subs->{'aqbooksellername'};
356 $bibliotitle= $subs->{'bibliotitle'};
359 {'publisheddate' =>format_date($subs->{'publisheddate'}),
360 'planneddate' => format_date($subs->{'planneddate'}),
361 'serialseq' => $subs->{'serialseq'},
362 "status".$subs->{'status'} => 1,
363 'notes' => $subs->{'notes'} eq $previousnote?"":$subs->{notes},
368 'startdate'=>$startdate,
369 'aqbooksellername'=>$aqbooksellername,
370 'bibliotitle'=>$bibliotitle,
375 $previousnote=$subs->{notes};
381 =head2 GetSubscriptions
385 @results = GetSubscriptions($title,$ISSN,$biblionumber);
386 this function get all subscriptions which has title like $title,ISSN like $ISSN and biblionumber like $biblionumber.
388 a table of hashref. Each hash containt the subscription.
393 sub GetSubscriptions {
394 my ($title,$ISSN,$biblionumber) = @_;
395 return unless $title or $ISSN or $biblionumber;
396 my $dbh = C4::Context->dbh;
400 SELECT subscription.subscriptionid,biblio.title,biblio.issn,subscription.notes,biblio.biblionumber
401 FROM subscription,biblio
402 WHERE biblio.biblionumber = subscription.biblionumber
403 AND biblio.biblionumber=?
406 $sth = $dbh->prepare($query);
407 $sth->execute($biblionumber);
409 if ($ISSN and $title){
411 SELECT subscription.subscriptionid,biblio.title,biblio.issn,subscription.notes,biblio.biblionumber
412 FROM subscription,biblio
413 WHERE biblio.biblionumber= subscription.biblionumber
414 AND (biblio.title LIKE ? or biblio.issn = ?)
417 $sth = $dbh->prepare($query);
418 $sth->execute("%$title%",$ISSN);
423 SELECT subscription.subscriptionid,biblio.title,biblio.issn,subscription.notes,biblio.biblionumber
424 FROM subscription,biblio
425 WHERE biblio.biblionumber = biblioitems.biblionumber
426 AND biblio.biblionumber=subscription.biblionumber
427 AND biblioitems.issn = ?
430 $sth = $dbh->prepare($query);
431 $sth->execute($ISSN);
434 SELECT subscription.subscriptionid,biblio.title,biblio.issn,subscription.notes,biblio.biblionumber
435 FROM subscription,biblio
436 WHERE biblio.biblionumber=subscription.biblionumber
437 AND biblio.title LIKE ?
440 $sth = $dbh->prepare($query);
441 $sth->execute("%$title%");
446 my $previoustitle="";
448 while (my $line = $sth->fetchrow_hashref) {
449 if ($previoustitle eq $line->{title}) {
452 $line->{toggle} = 1 if $odd==1;
454 $previoustitle=$line->{title};
456 $line->{toggle} = 1 if $odd==1;
458 push @results, $line;
467 ($totalissues,@serials) = GetSerials($subscriptionid);
468 this function get every serial not arrived for a given subscription
469 as well as the number of issues registered in the database (all types)
470 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
476 my ($subscriptionid) = @_;
477 my $dbh = C4::Context->dbh;
482 # status = 2 is "arrived"
486 WHERE subscriptionid = ? AND status NOT IN (2,4,5)
488 my $sth=$dbh->prepare($query);
489 $sth->execute($subscriptionid);
490 while(my $line = $sth->fetchrow_hashref) {
491 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
492 $line->{"publisheddate"} = format_date($line->{"publisheddate"});
493 $line->{"planneddate"} = format_date($line->{"planneddate"});
496 # OK, now add the last 5 issues arrived/missing
500 WHERE subscriptionid = ?
501 AND (status in (2,4,5))
502 ORDER BY serialid DESC
504 my $sth=$dbh->prepare($query);
505 $sth->execute($subscriptionid);
506 while((my $line = $sth->fetchrow_hashref) && $counter <5) {
508 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
509 $line->{"planneddate"} = format_date($line->{"planneddate"});
510 $line->{"publisheddate"} = format_date($line->{"publisheddate"});
516 WHERE subscriptionid=?
518 $sth=$dbh->prepare($query);
519 $sth->execute($subscriptionid);
520 my ($totalissues) = $sth->fetchrow;
521 return ($totalissues,@serials);
524 =head2 GetLatestSerials
528 \@serials = GetLatestSerials($subscriptionid,$limit)
529 get the $limit's latest serials arrived or missing for a given subscription
531 a ref to a table which it containts all of the latest serials stored into a hash.
536 sub GetLatestSerials {
537 my ($subscriptionid,$limit) = @_;
538 my $dbh = C4::Context->dbh;
539 # status = 2 is "arrived"
541 SELECT serialid,serialseq, status, planneddate
543 WHERE subscriptionid = ?
544 AND (status =2 or status=4)
545 ORDER BY planneddate DESC LIMIT 0,$limit
547 my $sth=$dbh->prepare($strsth);
548 $sth->execute($subscriptionid);
550 while(my $line = $sth->fetchrow_hashref) {
551 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
552 $line->{"planneddate"} = format_date($line->{"planneddate"});
558 # WHERE subscriptionid=?
560 # $sth=$dbh->prepare($query);
561 # $sth->execute($subscriptionid);
562 # my ($totalissues) = $sth->fetchrow;
566 =head2 GetDistributedTo
570 $distributedto=GetDistributedTo($subscriptionid)
571 This function select the old previous value of distributedto in the database.
576 sub GetDistributedTo {
577 my $dbh = C4::Context->dbh;
579 my $subscriptionid = @_;
583 WHERE subscriptionid=?
585 my $sth = $dbh->prepare($query);
586 $sth->execute($subscriptionid);
587 return ($distributedto) = $sth->fetchrow;
595 $val is a hashref containing all the attributes of the table 'subscription'
596 This function get the next issue for the subscription given on input arg
598 all the input params updated.
605 my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
606 $calculated = $val->{numberingmethod};
607 # calculate the (expected) value of the next issue received.
608 $newlastvalue1 = $val->{lastvalue1};
609 # check if we have to increase the new value.
610 $newinnerloop1 = $val->{innerloop1}+1;
611 $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
612 $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
613 $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
614 $calculated =~ s/\{X\}/$newlastvalue1/g;
616 $newlastvalue2 = $val->{lastvalue2};
617 # check if we have to increase the new value.
618 $newinnerloop2 = $val->{innerloop2}+1;
619 $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
620 $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
621 $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
622 $calculated =~ s/\{Y\}/$newlastvalue2/g;
624 $newlastvalue3 = $val->{lastvalue3};
625 # check if we have to increase the new value.
626 $newinnerloop3 = $val->{innerloop3}+1;
627 $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
628 $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
629 $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
630 $calculated =~ s/\{Z\}/$newlastvalue3/g;
631 return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
635 sub New_Get_Next_Seq {
637 my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
638 my $pattern = $val->{numberpattern};
639 my @seasons = ('nothing','Winter','Spring','Summer','Autumn');
640 my @southern_seasons = ('','Summer','Autumn','Winter','Spring');
641 $calculated = $val->{numberingmethod};
642 $newlastvalue1 = $val->{lastvalue1};
643 $newlastvalue2 = $val->{lastvalue2};
644 $newlastvalue3 = $val->{lastvalue3};
645 if($newlastvalue3 > 0){ # if x y and z columns are used
646 $newlastvalue3 = $newlastvalue3+1;
647 if($newlastvalue3 > $val->{whenmorethan3}){
648 $newlastvalue3 = $val->{setto3};
650 if($newlastvalue2 > $val->{whenmorethan2}){
652 $newlastvalue2 = $val->{setto2};
655 $calculated =~ s/\{X\}/$newlastvalue1/g;
657 if($val->{hemisphere} == 2){
658 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
659 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
661 my $newlastvalue2seq = $seasons[$newlastvalue2];
662 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
665 $calculated =~ s/\{Y\}/$newlastvalue2/g;
667 $calculated =~ s/\{Z\}/$newlastvalue3/g;
669 if($newlastvalue2 > 0 && $newlastvalue3 < 1){ # if x and y columns are used
670 $newlastvalue2 = $newlastvalue2+1;
671 if($newlastvalue2 > $val->{whenmorethan2}){
672 $newlastvalue2 = $val->{setto2};
675 $calculated =~ s/\{X\}/$newlastvalue1/g;
677 if($val->{hemisphere} == 2){
678 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
679 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
681 my $newlastvalue2seq = $seasons[$newlastvalue2];
682 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
685 $calculated =~ s/\{Y\}/$newlastvalue2/g;
688 if($newlastvalue1 > 0 && $newlastvalue2 < 1 && $newlastvalue3 < 1){ # if column x only
689 $newlastvalue1 = $newlastvalue1+1;
690 if($newlastvalue1 > $val->{whenmorethan1}){
691 $newlastvalue1 = $val->{setto2};
693 $calculated =~ s/\{X\}/$newlastvalue1/g;
695 return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3);
703 $resultdate = GetNextDate($planneddate,$subscription)
705 this function get the date after $planneddate.
707 the date on ISO format.
713 my ($planneddate,$subscription) = @_;
715 if ($subscription->{periodicity} == 1) {
716 $resultdate=DateCalc($planneddate,"1 day");
718 if ($subscription->{periodicity} == 2) {
719 $resultdate=DateCalc($planneddate,"1 week");
721 if ($subscription->{periodicity} == 3) {
722 $resultdate=DateCalc($planneddate,"2 weeks");
724 if ($subscription->{periodicity} == 4) {
725 $resultdate=DateCalc($planneddate,"3 weeks");
727 if ($subscription->{periodicity} == 5) {
728 $resultdate=DateCalc($planneddate,"1 month");
730 if ($subscription->{periodicity} == 6) {
731 $resultdate=DateCalc($planneddate,"2 months");
733 if ($subscription->{periodicity} == 7) {
734 $resultdate=DateCalc($planneddate,"3 months");
736 if ($subscription->{periodicity} == 8) {
737 $resultdate=DateCalc($planneddate,"3 months");
739 if ($subscription->{periodicity} == 9) {
740 $resultdate=DateCalc($planneddate,"6 months");
742 if ($subscription->{periodicity} == 10) {
743 $resultdate=DateCalc($planneddate,"1 year");
745 if ($subscription->{periodicity} == 11) {
746 $resultdate=DateCalc($planneddate,"2 years");
748 return format_date_in_iso($resultdate);
755 $calculated = GetSeq($val)
756 $val is a hashref containing all the attributes of the table 'subscription'
757 this function transforms {X},{Y},{Z} to 150,0,0 for example.
759 the sequence in integer format
766 my $calculated = $val->{numberingmethod};
767 my $x=$val->{'lastvalue1'};
768 $calculated =~ s/\{X\}/$x/g;
769 my $y=$val->{'lastvalue2'};
770 $calculated =~ s/\{Y\}/$y/g;
771 my $z=$val->{'lastvalue3'};
772 $calculated =~ s/\{Z\}/$z/g;
776 =head2 GetSubscriptionExpirationDate
780 $sensddate = GetSubscriptionExpirationDate($subscriptionid)
782 this function return the expiration date for a subscription given on input args.
790 sub GetSubscriptionExpirationDate {
791 my ($subscriptionid) = @_;
792 my $dbh = C4::Context->dbh;
793 my $subscription = GetSubscription($subscriptionid);
794 my $enddate=$subscription->{startdate};
795 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
796 if ($subscription->{numberlength}) {
797 #calculate the date of the last issue.
798 for (my $i=1;$i<=$subscription->{numberlength};$i++) {
799 $enddate = GetNextDate($enddate,$subscription);
803 $enddate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
804 $enddate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
809 =head2 CountSubscriptionFromBiblionumber
813 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
814 this count the number of subscription for a biblionumber given.
816 the number of subscriptions with biblionumber given on input arg.
821 sub CountSubscriptionFromBiblionumber {
822 my ($biblionumber) = @_;
823 my $dbh = C4::Context->dbh;
829 my $sth = $dbh->prepare($query);
830 $sth->execute($biblionumber);
831 my $subscriptionsnumber = $sth->fetchrow;
832 return $subscriptionsnumber;
836 =head2 ModSubscriptionHistory
840 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$receivedlist,$missinglist,$opacnote,$librariannote);
842 this function modify the history of a subscription. Put your new values on input arg.
847 sub ModSubscriptionHistory {
848 my ($subscriptionid,$histstartdate,$enddate,$receivedlist,$missinglist,$opacnote,$librariannote)=@_;
849 my $dbh=C4::Context->dbh;
851 UPDATE subscriptionhistory
852 SET histstartdate=?,enddate=?,receivedlist=?,missinglist=?,opacnote=?,librariannote=?
853 WHERE subscriptionid=?
855 my $sth = $dbh->prepare($query);
856 $receivedlist =~ s/^,//g;
857 $missinglist =~ s/^,//g;
858 $opacnote =~ s/^,//g;
859 $sth->execute($histstartdate,$enddate,$receivedlist,$missinglist,$opacnote,$librariannote,$subscriptionid);
862 =head2 ModSerialStatus
866 ModSerialStatus($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes)
868 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
869 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
874 sub ModSerialStatus {
875 my ($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes,$itemnumber)=@_;
877 # 1st, get previous status :
878 my $dbh = C4::Context->dbh;
880 SELECT subscriptionid,status
884 my $sth = $dbh->prepare($query);
885 $sth->execute($serialid);
886 my ($subscriptionid,$oldstatus) = $sth->fetchrow;
887 # change status & update subscriptionhistory
889 DelIssue($serialseq, $subscriptionid)
893 SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=?,itemnumber=?
896 $sth = $dbh->prepare($query);
897 $sth->execute($serialseq,format_date_in_iso($publisheddate),format_date_in_iso($planneddate),$status,$notes,$itemnumber,$serialid);
899 SELECT missinglist,receivedlist
900 FROM subscriptionhistory
901 WHERE subscriptionid=?
903 $sth = $dbh->prepare($query);
904 $sth->execute($subscriptionid);
905 my ($missinglist,$receivedlist) = $sth->fetchrow;
906 if ($status == 2 && $oldstatus != 2) {
907 $receivedlist .= ",$serialseq";
909 $missinglist .= ",$serialseq" if ($status eq 4) ;
910 $missinglist .= ",not issued $serialseq" if ($status eq 5);
912 UPDATE subscriptionhistory
913 SET receivedlist=?, missinglist=?
914 WHERE subscriptionid=?
916 $sth=$dbh->prepare($query);
917 $sth->execute($receivedlist,$missinglist,$subscriptionid);
919 # create new waited entry if needed (ie : was a "waited" and has changed)
920 if ($oldstatus eq 1 && $status ne 1) {
924 WHERE subscriptionid = ?
926 $sth = $dbh->prepare($query);
927 $sth->execute($subscriptionid);
928 my $val = $sth->fetchrow_hashref;
930 my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3) = GetNextSeq($val);
931 # next date (calculated from actual date & frequency parameters)
932 my $nextplanneddate = Get_Next_Date($planneddate,$val);
933 my $nextpublisheddate = Get_Next_Date($publisheddate,$val);
934 NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextpublisheddate,$nextplanneddate,0);
937 SET lastvalue1=?, lastvalue2=?, lastvalue3=?,
938 innerloop1=?, innerloop2=?, innerloop3=?
939 WHERE subscriptionid = ?
941 $sth = $dbh->prepare($query);
942 $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3,$subscriptionid);
946 =head2 ModSubscription
950 this function modify a subscription. Put all new values on input args.
955 sub ModSubscription {
956 my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
957 $periodicity,$dow,$numberlength,$weeklength,$monthlength,
958 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
959 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
960 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
961 $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid,$irregularity,$hemisphere,$callnumber,$numberpattern,$publisheddate)= @_;
962 my $dbh = C4::Context->dbh;
965 SET librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
966 periodicity=?,dow=?,numberlength=?,weeklength=?,monthlength=?,
967 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
968 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
969 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
970 numberingmethod=?, status=?, biblionumber=?, notes=?, letter=?,irregularity=?,hemisphere=?,callnumber=?,numberpattern=? ,publisheddate=?
971 WHERE subscriptionid = ?
973 my $sth=$dbh->prepare($query);
974 $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
975 $periodicity,$dow,$numberlength,$weeklength,$monthlength,
976 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
977 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
978 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
979 $numberingmethod, $status, $biblionumber, $notes, $letter, $irregularity,$hemisphere,$callnumber,$numberpattern,$publisheddate,$subscriptionid);
984 =head2 NewSubscription
988 $subscriptionid = &NewSubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
989 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
990 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
991 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
992 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
993 $numberingmethod, $status, $notes)
995 Create a new subscription with value given on input args.
998 the id of this new subscription
1003 sub NewSubscription {
1004 my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1005 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1006 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1007 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1008 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1009 $numberingmethod, $status, $notes, $letter,$irregularity,$hemisphere,$callnumber,$numberpattern,$publisheddate) = @_;
1011 my $dbh = C4::Context->dbh;
1012 #save subscription (insert into database)
1014 INSERT INTO subscription
1015 (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
1016 startdate,periodicity,dow,numberlength,weeklength,monthlength,
1017 add1,every1,whenmorethan1,setto1,lastvalue1,
1018 add2,every2,whenmorethan2,setto2,lastvalue2,
1019 add3,every3,whenmorethan3,setto3,lastvalue3,
1020 numberingmethod, status, notes, letter,irregularity,hemisphere,callnumber,numberpattern,publisheddate)
1021 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1023 my $sth=$dbh->prepare($query);
1025 $auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1026 format_date_in_iso($startdate),$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1027 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1028 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1029 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1030 $numberingmethod, $status, $notes, $letter,$irregularity,$hemisphere,$callnumber,$numberpattern,format_date_in_iso($publisheddate));
1033 #then create the 1st waited number
1034 my $subscriptionid = $dbh->{'mysql_insertid'};
1035 my $enddate = GetSubscriptionExpirationDate($subscriptionid);
1037 INSERT INTO subscriptionhistory
1038 (biblionumber, subscriptionid, histstartdate, enddate, missinglist, receivedlist, opacnote, librariannote)
1039 VALUES (?,?,?,?,?,?,?,?)
1041 $sth = $dbh->prepare($query);
1042 $sth->execute($biblionumber, $subscriptionid, format_date_in_iso($startdate), format_date_in_iso($enddate), "", "", "", $notes);
1043 ## User may have subscriptionid stored in MARC so check and fill it
1044 my $record=MARCgetbiblio($dbh,$biblionumber);
1045 MARCkoha2marcOnefield( $record, "subscriptionid", $subscriptionid,"biblios" );
1046 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
1047 NEWmodbiblio($dbh,$biblionumber,$record,$frameworkcode);
1048 # reread subscription to get a hash (for calculation of the 1st issue number)
1052 WHERE subscriptionid = ?
1054 $sth = $dbh->prepare($query);
1055 $sth->execute($subscriptionid);
1056 my $val = $sth->fetchrow_hashref;
1058 # calculate issue number
1059 my $serialseq = GetSeq($val);
1062 (serialseq,subscriptionid,biblionumber,status, planneddate,publisheddate)
1063 VALUES (?,?,?,?,?,?)
1066 $sth = $dbh->prepare($query);
1067 $sth->execute($serialseq, $subscriptionid, $val->{'biblionumber'}, 1, format_date_in_iso($startdate),format_date_in_iso($publisheddate));
1068 return $subscriptionid;
1072 =head2 ReNewSubscription
1076 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1078 this function renew a subscription with values given on input args.
1083 sub ReNewSubscription {
1084 my ($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note) = @_;
1085 my $dbh = C4::Context->dbh;
1086 my $subscription = GetSubscription($subscriptionid);
1087 my $record=MARCgetbiblio($dbh,$subscription->{biblionumber});
1089 my $biblio = MARCmarc2koha($dbh,$record,"biblios");
1090 NewSuggestion($user,$subscription->{bibliotitle},$biblio->{author},$biblio->{publishercode},$biblio->{note},'','','','','',$subscription->{biblionumber});
1091 # renew subscription
1094 SET startdate=?,numberlength=?,weeklength=?,monthlength=?
1095 WHERE subscriptionid=?
1097 my $sth=$dbh->prepare($query);
1098 $sth->execute(format_date_in_iso($startdate),$numberlength,$weeklength,$monthlength, $subscriptionid);
1106 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate)
1108 Create a new issue stored on the database.
1109 Note : we have to update the receivedlist and missinglist on subscriptionhistory for this subscription.
1115 my ($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate,$itemnumber) = @_;
1116 my $dbh = C4::Context->dbh;
1119 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,itemnumber)
1120 VALUES (?,?,?,?,?,?,?)
1122 my $sth = $dbh->prepare($query);
1123 $sth->execute($serialseq,$subscriptionid,$biblionumber,$status,format_date_in_iso($publisheddate), format_date_in_iso($planneddate),$itemnumber);
1126 SELECT missinglist,receivedlist
1127 FROM subscriptionhistory
1128 WHERE subscriptionid=?
1130 $sth = $dbh->prepare($query);
1131 $sth->execute($subscriptionid);
1132 my ($missinglist,$receivedlist) = $sth->fetchrow;
1134 $receivedlist .= ",$serialseq";
1137 $missinglist .= ",$serialseq";
1140 UPDATE subscriptionhistory
1141 SET receivedlist=?, missinglist=?
1142 WHERE subscriptionid=?
1144 $sth=$dbh->prepare($query);
1145 $sth->execute($receivedlist,$missinglist,$subscriptionid);
1148 =head2 serialchangestatus
1152 serialchangestatus($serialid,$serialseq,$planneddate,$status,$notes)
1154 Change the status of a serial issue.
1155 Note: this was the older subroutine
1160 sub serialchangestatus {
1161 my ($serialid,$serialseq,$planneddate,$status,$notes)=@_;
1162 # 1st, get previous status : if we change from "waited" to something else, then we will have to create a new "waited" entry
1163 my $dbh = C4::Context->dbh;
1164 my $sth = $dbh->prepare("select subscriptionid,status from serial where serialid=?");
1165 $sth->execute($serialid);
1166 my ($subscriptionid,$oldstatus) = $sth->fetchrow;
1167 # change status & update subscriptionhistory
1169 delissue($serialseq, $subscriptionid)
1171 $sth = $dbh->prepare("update serial set serialseq=?,planneddate=?,status=?,notes=? where serialid = ?");
1172 $sth->execute($serialseq,format_date_in_iso($planneddate),$status,$notes,$serialid);
1174 $sth = $dbh->prepare("select missinglist,receivedlist from subscriptionhistory where subscriptionid=?");
1175 $sth->execute($subscriptionid);
1176 my ($missinglist,$receivedlist) = $sth->fetchrow;
1178 $receivedlist .= "| $serialseq";
1179 $receivedlist =~ s/^\| //g;
1181 $missinglist .= "| $serialseq" if ($status eq 4) ;
1182 $missinglist .= "| not issued $serialseq" if ($status eq 5);
1183 $missinglist =~ s/^\| //g;
1184 $sth=$dbh->prepare("update subscriptionhistory set receivedlist=?, missinglist=? where subscriptionid=?");
1185 $sth->execute($receivedlist,$missinglist,$subscriptionid);
1187 # create new waited entry if needed (ie : was a "waited" and has changed)
1188 if ($oldstatus eq 1 && $status ne 1) {
1189 $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1190 $sth->execute($subscriptionid);
1191 my $val = $sth->fetchrow_hashref;
1193 my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3) = New_Get_Next_Seq($val);
1194 my $nextplanneddate = Get_Next_Date($planneddate,$val);
1195 NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextplanneddate);
1196 $sth = $dbh->prepare("update subscription set lastvalue1=?, lastvalue2=?,lastvalue3=? where subscriptionid = ?");
1197 $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$subscriptionid);
1199 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1200 $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1201 $sth->execute($subscriptionid);
1202 my $subscription = $sth->fetchrow_hashref;
1203 if ($subscription->{letter} && $status eq 2) {
1204 sendalerts('issue',$subscription->{subscriptionid},$subscription->{letter});
1211 =head2 HasSubscriptionExpired
1215 1 or 0 = HasSubscriptionExpired($subscriptionid)
1217 the subscription has expired when the next issue to arrive is out of subscription limit.
1220 1 if true, 0 if false.
1225 sub HasSubscriptionExpired {
1226 my ($subscriptionid) = @_;
1227 my $dbh = C4::Context->dbh;
1228 my $subscription = GetSubscription($subscriptionid);
1229 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1230 if ($subscription->{numberlength} ) {
1234 WHERE subscriptionid=? AND planneddate>=?
1236 my $sth = $dbh->prepare($query);
1237 $sth->execute($subscriptionid,$subscription->{startdate});
1238 my $res = $sth->fetchrow;
1239 if ($subscription->{numberlength}>=$res) {
1245 #a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
1247 SELECT max(planneddate)
1249 WHERE subscriptionid=?
1251 my $sth = $dbh->prepare($query);
1252 $sth->execute($subscriptionid);
1253 my $res = ParseDate(format_date_in_iso($sth->fetchrow));
1254 my $endofsubscriptiondate;
1255 $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
1256 $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
1257 return 1 if ($res >= $endofsubscriptiondate);
1262 =head2 SetDistributedto
1266 SetDistributedto($distributedto,$subscriptionid);
1267 This function update the value of distributedto for a subscription given on input arg.
1272 sub SetDistributedto {
1273 my ($distributedto,$subscriptionid) = @_;
1274 my $dbh = C4::Context->dbh;
1278 WHERE subscriptionid=?
1280 my $sth = $dbh->prepare($query);
1281 $sth->execute($distributedto,$subscriptionid);
1284 =head2 DelSubscription
1288 DelSubscription($subscriptionid)
1289 this function delete the subscription which has $subscriptionid as id.
1294 sub DelSubscription {
1295 my ($subscriptionid,$biblionumber) = @_;
1296 my $dbh = C4::Context->dbh;
1297 ## User may have subscriptionid stored in MARC so check and remove it
1298 my $record=MARCgetbiblio($dbh,$biblionumber);
1299 MARCkoha2marcOnefield( $record, "subscriptionid", "","biblios" );
1300 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
1301 NEWmodbiblio($dbh,$biblionumber,$record,$frameworkcode);
1302 $subscriptionid=$dbh->quote($subscriptionid);
1303 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1304 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1305 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1313 DelIssue($serialseq,$subscriptionid)
1314 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1320 my ($serialseq,$subscriptionid) = @_;
1321 my $dbh = C4::Context->dbh;
1325 AND subscriptionid= ?
1327 my $sth = $dbh->prepare($query);
1328 $sth->execute($serialseq,$subscriptionid);
1331 =head2 GetMissingIssues
1335 ($count,@issuelist) = &GetMissingIssues($supplierid,$serialid)
1337 this function select missing issues on database - where serial.status = 4
1340 a count of the number of missing issues
1341 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1342 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1347 sub GetMissingIssues {
1348 my ($supplierid,$serialid) = @_;
1349 my $dbh = C4::Context->dbh;
1353 $byserial = "and serialid = ".$serialid;
1356 $sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
1357 FROM subscription, serial, biblio
1358 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1359 WHERE subscription.subscriptionid = serial.subscriptionid AND
1360 serial.STATUS = 4 and
1361 subscription.aqbooksellerid=$supplierid and
1362 biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
1365 $sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
1366 FROM subscription, serial, biblio
1367 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1368 WHERE subscription.subscriptionid = serial.subscriptionid AND
1369 serial.STATUS =4 and
1370 biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
1378 while (my $line = $sth->fetchrow_hashref) {
1379 $odd++ unless $line->{title} eq $last_title;
1380 $last_title = $line->{title} if ($line->{title});
1381 $line->{planneddate} = format_date($line->{planneddate});
1382 $line->{claimdate} = format_date($line->{claimdate});
1383 $line->{'odd'} = 1 if $odd %2 ;
1385 push @issuelist,$line;
1387 return $count,@issuelist;
1390 =head2 removeMissingIssue
1394 removeMissingIssue($subscriptionid)
1396 this function removes an issue from being part of the missing string in
1397 subscriptionlist.missinglist column
1399 called when a missing issue is found from the statecollection.pl file
1404 sub removeMissingIssue {
1405 my ($sequence,$subscriptionid) = @_;
1406 my $dbh = C4::Context->dbh;
1407 my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1408 $sth->execute($subscriptionid);
1409 my $data = $sth->fetchrow_hashref;
1410 my $missinglist = $data->{'missinglist'};
1411 my $missinglistbefore = $missinglist;
1412 # warn $missinglist." before";
1413 $missinglist =~ s/($sequence)//;
1414 # warn $missinglist." after";
1415 if($missinglist ne $missinglistbefore){
1416 $missinglist =~ s/\|\s\|/\|/g;
1417 $missinglist =~ s/^\| //g;
1418 $missinglist =~ s/\|$//g;
1419 my $sth2= $dbh->prepare("UPDATE subscriptionhistory
1421 WHERE subscriptionid = ?");
1422 $sth2->execute($missinglist,$subscriptionid);
1430 &updateClaim($serialid)
1432 this function updates the time when a claim is issued for late/missing items
1434 called from claims.pl file
1440 my ($serialid) = @_;
1441 my $dbh = C4::Context->dbh;
1442 my $sth = $dbh->prepare("UPDATE serial SET claimdate = now()
1445 $sth->execute($serialid);
1448 =head2 getsupplierbyserialid
1452 ($result) = &getsupplierbyserialid($serialid)
1454 this function is used to find the supplier id given a serial id
1457 hashref containing serialid, subscriptionid, and aqbooksellerid
1462 sub getsupplierbyserialid {
1463 my ($serialid) = @_;
1464 my $dbh = C4::Context->dbh;
1465 my $sth = $dbh->prepare("SELECT serialid, serial.subscriptionid, aqbooksellerid
1466 FROM serial, subscription
1467 WHERE serial.subscriptionid = subscription.subscriptionid
1470 $sth->execute($serialid);
1471 my $line = $sth->fetchrow_hashref;
1472 my $result = $line->{'aqbooksellerid'};
1476 =head2 check_routing
1480 ($result) = &check_routing($subscriptionid)
1482 this function checks to see if a serial has a routing list and returns the count of routingid
1483 used to show either an 'add' or 'edit' link
1488 my ($subscriptionid) = @_;
1489 my $dbh = C4::Context->dbh;
1490 my $sth = $dbh->prepare("SELECT count(routingid) routingids FROM subscriptionroutinglist, subscription
1491 WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1492 AND subscription.subscriptionid = ? ORDER BY ranking ASC
1494 $sth->execute($subscriptionid);
1495 my $line = $sth->fetchrow_hashref;
1496 my $result = $line->{'routingids'};
1500 =head2 addroutingmember
1504 &addroutingmember($bornum,$subscriptionid)
1506 this function takes a borrowernumber and subscriptionid and add the member to the
1507 routing list for that serial subscription and gives them a rank on the list
1508 of either 1 or highest current rank + 1
1513 sub addroutingmember {
1514 my ($bornum,$subscriptionid) = @_;
1516 my $dbh = C4::Context->dbh;
1517 my $sth = $dbh->prepare("SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?");
1518 $sth->execute($subscriptionid);
1519 while(my $line = $sth->fetchrow_hashref){
1520 if($line->{'rank'}>0){
1521 $rank = $line->{'rank'}+1;
1526 $sth = $dbh->prepare("INSERT INTO subscriptionroutinglist VALUES (null,?,?,?,null)");
1527 $sth->execute($subscriptionid,$bornum,$rank);
1530 =head2 reorder_members
1534 &reorder_members($subscriptionid,$routingid,$rank)
1536 this function is used to reorder the routing list
1538 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1539 - it gets all members on list puts their routingid's into an array
1540 - removes the one in the array that is $routingid
1541 - then reinjects $routingid at point indicated by $rank
1542 - then update the database with the routingids in the new order
1547 sub reorder_members {
1548 my ($subscriptionid,$routingid,$rank) = @_;
1549 my $dbh = C4::Context->dbh;
1550 my $sth = $dbh->prepare("SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC");
1551 $sth->execute($subscriptionid);
1553 while(my $line = $sth->fetchrow_hashref){
1554 push(@result,$line->{'routingid'});
1556 # To find the matching index
1558 my $key = -1; # to allow for 0 being a valid response
1559 for ($i = 0; $i < @result; $i++) {
1560 if ($routingid == $result[$i]) {
1561 $key = $i; # save the index
1565 # if index exists in array then move it to new position
1566 if($key > -1 && $rank > 0){
1567 my $new_rank = $rank-1; # $new_rank is what you want the new index to be in the array
1568 my $moving_item = splice(@result, $key, 1);
1569 splice(@result, $new_rank, 0, $moving_item);
1571 for(my $j = 0; $j < @result; $j++){
1572 my $sth = $dbh->prepare("UPDATE subscriptionroutinglist SET ranking = '" . ($j+1) . "' WHERE routingid = '". $result[$j]."'");
1577 =head2 delroutingmember
1581 &delroutingmember($routingid,$subscriptionid)
1583 this function either deletes one member from routing list if $routingid exists otherwise
1584 deletes all members from the routing list
1589 sub delroutingmember {
1590 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
1591 my ($routingid,$subscriptionid) = @_;
1592 my $dbh = C4::Context->dbh;
1594 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
1595 $sth->execute($routingid);
1596 reorder_members($subscriptionid,$routingid);
1598 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
1599 $sth->execute($subscriptionid);
1603 =head2 getroutinglist
1607 ($count,@routinglist) = &getroutinglist($subscriptionid)
1609 this gets the info from the subscriptionroutinglist for $subscriptionid
1612 a count of the number of members on routinglist
1613 the routinglist into a table. Each line of this table containts a ref to a hash which containts
1614 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
1619 sub getroutinglist {
1620 my ($subscriptionid) = @_;
1621 my $dbh = C4::Context->dbh;
1622 my $sth = $dbh->prepare("SELECT routingid, borrowernumber,
1623 ranking, biblionumber FROM subscriptionroutinglist, subscription
1624 WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1625 AND subscription.subscriptionid = ? ORDER BY ranking ASC
1627 $sth->execute($subscriptionid);
1630 while (my $line = $sth->fetchrow_hashref) {
1632 push(@routinglist,$line);
1634 return ($count,@routinglist);
1637 =head2 abouttoexpire
1641 $result = &abouttoexpire($subscriptionid)
1643 this function alerts you to the penultimate issue for a serial subscription
1645 returns 1 - if this is the penultimate issue
1653 my ($subscriptionid) = @_;
1654 my $dbh = C4::Context->dbh;
1655 my $subscription = GetSubscription($subscriptionid);
1656 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1657 if ($subscription->{numberlength}) {
1658 my $sth = $dbh->prepare("select count(*) from serial where subscriptionid=? and planneddate>=?");
1659 $sth->execute($subscriptionid,$subscription->{startdate});
1660 my $res = $sth->fetchrow;
1661 # warn "length: ".$subscription->{numberlength}." vs count: ".$res;
1662 if ($subscription->{numberlength}==$res) {
1668 # a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
1669 my $sth = $dbh->prepare("select max(planneddate) from serial where subscriptionid=?");
1670 $sth->execute($subscriptionid);
1671 my $res = ParseDate(format_date_in_iso($sth->fetchrow));
1672 my $endofsubscriptiondate;
1673 $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
1674 $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
1675 # warn "last: ".$endofsubscriptiondate." vs currentdate: ".$res;
1676 my $per = $subscription->{'periodicity'};
1678 if ($per == 1) { $x = '1 day'; }
1679 if ($per == 2) { $x = '1 week'; }
1680 if ($per == 3) { $x = '2 weeks'; }
1681 if ($per == 4) { $x = '3 weeks'; }
1682 if ($per == 5) { $x = '1 month'; }
1683 if ($per == 6) { $x = '2 months'; }
1684 if ($per == 7 || $per == 8) { $x = '3 months'; }
1685 if ($per == 9) { $x = '6 months'; }
1686 if ($per == 10) { $x = '1 year'; }
1687 if ($per == 11) { $x = '2 years'; }
1688 my $datebeforeend = DateCalc($endofsubscriptiondate,"- ".$x); # if ($subscription->{weeklength});
1689 # warn "DATE BEFORE END: $datebeforeend";
1690 return 1 if ($res >= $datebeforeend && $res < $endofsubscriptiondate);
1697 =head2 Get_Next_Date
1701 ($resultdate) = &Get_Next_Date($planneddate,$subscription)
1703 this function is an extension of GetNextDate which allows for checking for irregularity
1705 it takes the planneddate and will return the next issue's date and will skip dates if there
1706 exists an irregularity
1707 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
1708 skipped then the returned date will be 2007-05-10
1711 $resultdate - then next date in the sequence
1716 sub Get_Next_Date(@) {
1717 my ($planneddate,$subscription) = @_;
1718 my @irreg = split(/\|/,$subscription->{irregularity});
1720 my ($year, $month, $day) = UnixDate($planneddate, "%Y", "%m", "%d");
1721 my $dayofweek = Date_DayOfWeek($month,$day,$year);
1723 # warn "DOW $dayofweek";
1724 if ($subscription->{periodicity} == 1) {
1725 for(my $i=0;$i<@irreg;$i++){
1726 if($dayofweek == 7){ $dayofweek = 0; }
1727 if(in_array(($dayofweek+1), @irreg)){
1728 $planneddate = DateCalc($planneddate,"1 day");
1732 $resultdate=DateCalc($planneddate,"1 day");
1734 if ($subscription->{periodicity} == 2) {
1735 my $wkno = Date_WeekOfYear($month,$day,$year,1);
1736 for(my $i = 0;$i < @irreg; $i++){
1737 if($wkno > 52) { $wkno = 0; } # need to rollover at January
1738 if($irreg[$i] == ($wkno+1)){
1739 $planneddate = DateCalc($planneddate,"1 week");
1743 $resultdate=DateCalc($planneddate,"1 week");
1745 if ($subscription->{periodicity} == 3) {
1746 my $wkno = Date_WeekOfYear($month,$day,$year,1);
1747 for(my $i = 0;$i < @irreg; $i++){
1748 if($wkno > 52) { $wkno = 0; } # need to rollover at January
1749 if($irreg[$i] == ($wkno+1)){
1750 $planneddate = DateCalc($planneddate,"2 weeks");
1754 $resultdate=DateCalc($planneddate,"2 weeks");
1756 if ($subscription->{periodicity} == 4) {
1757 my $wkno = Date_WeekOfYear($month,$day,$year,1);
1758 for(my $i = 0;$i < @irreg; $i++){
1759 if($wkno > 52) { $wkno = 0; } # need to rollover at January
1760 if($irreg[$i] == ($wkno+1)){
1761 $planneddate = DateCalc($planneddate,"3 weeks");
1765 $resultdate=DateCalc($planneddate,"3 weeks");
1767 if ($subscription->{periodicity} == 5) {
1768 for(my $i = 0;$i < @irreg; $i++){
1771 if($month == 12) { $month = 0; } # need to rollover to check January
1772 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1773 $planneddate = DateCalc($planneddate,"1 month");
1774 $month++; # to check if following ones are to be skipped too
1777 $resultdate=DateCalc($planneddate,"1 month");
1778 # warn "Planneddate2: $planneddate";
1780 if ($subscription->{periodicity} == 6) {
1781 for(my $i = 0;$i < @irreg; $i++){
1782 if($month == 12) { $month = 0; } # need to rollover to check January
1783 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1784 $planneddate = DateCalc($planneddate,"2 months");
1785 $month++; # to check if following ones are to be skipped too
1788 $resultdate=DateCalc($planneddate,"2 months");
1790 if ($subscription->{periodicity} == 7) {
1791 for(my $i = 0;$i < @irreg; $i++){
1792 if($month == 12) { $month = 0; } # need to rollover to check January
1793 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1794 $planneddate = DateCalc($planneddate,"3 months");
1795 $month++; # to check if following ones are to be skipped too
1798 $resultdate=DateCalc($planneddate,"3 months");
1800 if ($subscription->{periodicity} == 8) {
1801 for(my $i = 0;$i < @irreg; $i++){
1802 if($month == 12) { $month = 0; } # need to rollover to check January
1803 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1804 $planneddate = DateCalc($planneddate,"3 months");
1805 $month++; # to check if following ones are to be skipped too
1808 $resultdate=DateCalc($planneddate,"3 months");
1810 if ($subscription->{periodicity} == 9) {
1811 for(my $i = 0;$i < @irreg; $i++){
1812 if($month == 12) { $month = 0; } # need to rollover to check January
1813 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1814 $planneddate = DateCalc($planneddate,"6 months");
1815 $month++; # to check if following ones are to be skipped too
1818 $resultdate=DateCalc($planneddate,"6 months");
1820 if ($subscription->{periodicity} == 10) {
1821 $resultdate=DateCalc($planneddate,"1 year");
1823 if ($subscription->{periodicity} == 11) {
1824 $resultdate=DateCalc($planneddate,"2 years");
1826 # warn "date: ".$resultdate;
1827 return format_date_in_iso($resultdate);
1831 END { } # module clean-up code here (global destructor)