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=XMLgetbiblio($dbh,$biblionumber);
1045 $record=XML_xml2hash_onerecord($record);
1046 XML_writeline( $record, "subscriptionid", $subscriptionid,"biblios" );
1047 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
1048 NEWmodbiblio($dbh,$biblionumber,$record,$frameworkcode);
1049 # reread subscription to get a hash (for calculation of the 1st issue number)
1053 WHERE subscriptionid = ?
1055 $sth = $dbh->prepare($query);
1056 $sth->execute($subscriptionid);
1057 my $val = $sth->fetchrow_hashref;
1059 # calculate issue number
1060 my $serialseq = GetSeq($val);
1063 (serialseq,subscriptionid,biblionumber,status, planneddate,publisheddate)
1064 VALUES (?,?,?,?,?,?)
1067 $sth = $dbh->prepare($query);
1068 $sth->execute($serialseq, $subscriptionid, $val->{'biblionumber'}, 1, format_date_in_iso($startdate),format_date_in_iso($publisheddate));
1069 return $subscriptionid;
1073 =head2 ReNewSubscription
1077 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1079 this function renew a subscription with values given on input args.
1084 sub ReNewSubscription {
1085 my ($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note) = @_;
1086 my $dbh = C4::Context->dbh;
1087 my $subscription = GetSubscription($subscriptionid);
1088 my $record=XMLgetbiblio($dbh,$subscription->{biblionumber});
1089 $record=XML_xml2hash_onerecord($record);
1090 my $biblio = XMLmarc2koha_onerecord($dbh,$record,"biblios");
1091 NewSuggestion($user,$subscription->{bibliotitle},$biblio->{author},$biblio->{publishercode},$biblio->{note},'','','','','',$subscription->{biblionumber});
1092 # renew subscription
1095 SET startdate=?,numberlength=?,weeklength=?,monthlength=?
1096 WHERE subscriptionid=?
1098 my $sth=$dbh->prepare($query);
1099 $sth->execute(format_date_in_iso($startdate),$numberlength,$weeklength,$monthlength, $subscriptionid);
1107 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate)
1109 Create a new issue stored on the database.
1110 Note : we have to update the receivedlist and missinglist on subscriptionhistory for this subscription.
1116 my ($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate,$itemnumber) = @_;
1117 my $dbh = C4::Context->dbh;
1120 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,itemnumber)
1121 VALUES (?,?,?,?,?,?,?)
1123 my $sth = $dbh->prepare($query);
1124 $sth->execute($serialseq,$subscriptionid,$biblionumber,$status,format_date_in_iso($publisheddate), format_date_in_iso($planneddate),$itemnumber);
1127 SELECT missinglist,receivedlist
1128 FROM subscriptionhistory
1129 WHERE subscriptionid=?
1131 $sth = $dbh->prepare($query);
1132 $sth->execute($subscriptionid);
1133 my ($missinglist,$receivedlist) = $sth->fetchrow;
1135 $receivedlist .= ",$serialseq";
1138 $missinglist .= ",$serialseq";
1141 UPDATE subscriptionhistory
1142 SET receivedlist=?, missinglist=?
1143 WHERE subscriptionid=?
1145 $sth=$dbh->prepare($query);
1146 $sth->execute($receivedlist,$missinglist,$subscriptionid);
1149 =head2 serialchangestatus
1153 serialchangestatus($serialid,$serialseq,$planneddate,$status,$notes)
1155 Change the status of a serial issue.
1156 Note: this was the older subroutine
1161 sub serialchangestatus {
1162 my ($serialid,$serialseq,$planneddate,$status,$notes)=@_;
1163 # 1st, get previous status : if we change from "waited" to something else, then we will have to create a new "waited" entry
1164 my $dbh = C4::Context->dbh;
1165 my $sth = $dbh->prepare("select subscriptionid,status from serial where serialid=?");
1166 $sth->execute($serialid);
1167 my ($subscriptionid,$oldstatus) = $sth->fetchrow;
1168 # change status & update subscriptionhistory
1170 delissue($serialseq, $subscriptionid)
1172 $sth = $dbh->prepare("update serial set serialseq=?,planneddate=?,status=?,notes=? where serialid = ?");
1173 $sth->execute($serialseq,format_date_in_iso($planneddate),$status,$notes,$serialid);
1175 $sth = $dbh->prepare("select missinglist,receivedlist from subscriptionhistory where subscriptionid=?");
1176 $sth->execute($subscriptionid);
1177 my ($missinglist,$receivedlist) = $sth->fetchrow;
1179 $receivedlist .= "| $serialseq";
1180 $receivedlist =~ s/^\| //g;
1182 $missinglist .= "| $serialseq" if ($status eq 4) ;
1183 $missinglist .= "| not issued $serialseq" if ($status eq 5);
1184 $missinglist =~ s/^\| //g;
1185 $sth=$dbh->prepare("update subscriptionhistory set receivedlist=?, missinglist=? where subscriptionid=?");
1186 $sth->execute($receivedlist,$missinglist,$subscriptionid);
1188 # create new waited entry if needed (ie : was a "waited" and has changed)
1189 if ($oldstatus eq 1 && $status ne 1) {
1190 $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1191 $sth->execute($subscriptionid);
1192 my $val = $sth->fetchrow_hashref;
1194 my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3) = New_Get_Next_Seq($val);
1195 my $nextplanneddate = Get_Next_Date($planneddate,$val);
1196 NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextplanneddate);
1197 $sth = $dbh->prepare("update subscription set lastvalue1=?, lastvalue2=?,lastvalue3=? where subscriptionid = ?");
1198 $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$subscriptionid);
1200 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1201 $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1202 $sth->execute($subscriptionid);
1203 my $subscription = $sth->fetchrow_hashref;
1204 if ($subscription->{letter} && $status eq 2) {
1205 sendalerts('issue',$subscription->{subscriptionid},$subscription->{letter});
1212 =head2 HasSubscriptionExpired
1216 1 or 0 = HasSubscriptionExpired($subscriptionid)
1218 the subscription has expired when the next issue to arrive is out of subscription limit.
1221 1 if true, 0 if false.
1226 sub HasSubscriptionExpired {
1227 my ($subscriptionid) = @_;
1228 my $dbh = C4::Context->dbh;
1229 my $subscription = GetSubscription($subscriptionid);
1230 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1231 if ($subscription->{numberlength} ) {
1235 WHERE subscriptionid=? AND planneddate>=?
1237 my $sth = $dbh->prepare($query);
1238 $sth->execute($subscriptionid,$subscription->{startdate});
1239 my $res = $sth->fetchrow;
1240 if ($subscription->{numberlength}>=$res) {
1246 #a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
1248 SELECT max(planneddate)
1250 WHERE subscriptionid=?
1252 my $sth = $dbh->prepare($query);
1253 $sth->execute($subscriptionid);
1254 my $res = ParseDate(format_date_in_iso($sth->fetchrow));
1255 my $endofsubscriptiondate;
1256 $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
1257 $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
1258 return 1 if ($res >= $endofsubscriptiondate);
1263 =head2 SetDistributedto
1267 SetDistributedto($distributedto,$subscriptionid);
1268 This function update the value of distributedto for a subscription given on input arg.
1273 sub SetDistributedto {
1274 my ($distributedto,$subscriptionid) = @_;
1275 my $dbh = C4::Context->dbh;
1279 WHERE subscriptionid=?
1281 my $sth = $dbh->prepare($query);
1282 $sth->execute($distributedto,$subscriptionid);
1285 =head2 DelSubscription
1289 DelSubscription($subscriptionid)
1290 this function delete the subscription which has $subscriptionid as id.
1295 sub DelSubscription {
1296 my ($subscriptionid,$biblionumber) = @_;
1297 my $dbh = C4::Context->dbh;
1298 ## User may have subscriptionid stored in MARC so check and remove it
1299 my $record=XMLgetbiblio($dbh,$biblionumber);
1300 $record=XML_xml2hash_onerecord($record);
1301 XML_writeline( $record, "subscriptionid", "","biblios" );
1302 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
1303 NEWmodbiblio($dbh,$biblionumber,$record,$frameworkcode);
1304 $subscriptionid=$dbh->quote($subscriptionid);
1305 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1306 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1307 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1315 DelIssue($serialseq,$subscriptionid)
1316 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1322 my ($serialseq,$subscriptionid) = @_;
1323 my $dbh = C4::Context->dbh;
1327 AND subscriptionid= ?
1329 my $sth = $dbh->prepare($query);
1330 $sth->execute($serialseq,$subscriptionid);
1333 =head2 GetMissingIssues
1337 ($count,@issuelist) = &GetMissingIssues($supplierid,$serialid)
1339 this function select missing issues on database - where serial.status = 4
1342 a count of the number of missing issues
1343 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1344 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1349 sub GetMissingIssues {
1350 my ($supplierid,$serialid) = @_;
1351 my $dbh = C4::Context->dbh;
1355 $byserial = "and serialid = ".$serialid;
1358 $sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
1359 FROM subscription, serial, biblio
1360 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1361 WHERE subscription.subscriptionid = serial.subscriptionid AND
1362 serial.STATUS = 4 and
1363 subscription.aqbooksellerid=$supplierid and
1364 biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
1367 $sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
1368 FROM subscription, serial, biblio
1369 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1370 WHERE subscription.subscriptionid = serial.subscriptionid AND
1371 serial.STATUS =4 and
1372 biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
1380 while (my $line = $sth->fetchrow_hashref) {
1381 $odd++ unless $line->{title} eq $last_title;
1382 $last_title = $line->{title} if ($line->{title});
1383 $line->{planneddate} = format_date($line->{planneddate});
1384 $line->{claimdate} = format_date($line->{claimdate});
1385 $line->{'odd'} = 1 if $odd %2 ;
1387 push @issuelist,$line;
1389 return $count,@issuelist;
1392 =head2 removeMissingIssue
1396 removeMissingIssue($subscriptionid)
1398 this function removes an issue from being part of the missing string in
1399 subscriptionlist.missinglist column
1401 called when a missing issue is found from the statecollection.pl file
1406 sub removeMissingIssue {
1407 my ($sequence,$subscriptionid) = @_;
1408 my $dbh = C4::Context->dbh;
1409 my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1410 $sth->execute($subscriptionid);
1411 my $data = $sth->fetchrow_hashref;
1412 my $missinglist = $data->{'missinglist'};
1413 my $missinglistbefore = $missinglist;
1414 # warn $missinglist." before";
1415 $missinglist =~ s/($sequence)//;
1416 # warn $missinglist." after";
1417 if($missinglist ne $missinglistbefore){
1418 $missinglist =~ s/\|\s\|/\|/g;
1419 $missinglist =~ s/^\| //g;
1420 $missinglist =~ s/\|$//g;
1421 my $sth2= $dbh->prepare("UPDATE subscriptionhistory
1423 WHERE subscriptionid = ?");
1424 $sth2->execute($missinglist,$subscriptionid);
1432 &updateClaim($serialid)
1434 this function updates the time when a claim is issued for late/missing items
1436 called from claims.pl file
1442 my ($serialid) = @_;
1443 my $dbh = C4::Context->dbh;
1444 my $sth = $dbh->prepare("UPDATE serial SET claimdate = now()
1447 $sth->execute($serialid);
1450 =head2 getsupplierbyserialid
1454 ($result) = &getsupplierbyserialid($serialid)
1456 this function is used to find the supplier id given a serial id
1459 hashref containing serialid, subscriptionid, and aqbooksellerid
1464 sub getsupplierbyserialid {
1465 my ($serialid) = @_;
1466 my $dbh = C4::Context->dbh;
1467 my $sth = $dbh->prepare("SELECT serialid, serial.subscriptionid, aqbooksellerid
1468 FROM serial, subscription
1469 WHERE serial.subscriptionid = subscription.subscriptionid
1472 $sth->execute($serialid);
1473 my $line = $sth->fetchrow_hashref;
1474 my $result = $line->{'aqbooksellerid'};
1478 =head2 check_routing
1482 ($result) = &check_routing($subscriptionid)
1484 this function checks to see if a serial has a routing list and returns the count of routingid
1485 used to show either an 'add' or 'edit' link
1490 my ($subscriptionid) = @_;
1491 my $dbh = C4::Context->dbh;
1492 my $sth = $dbh->prepare("SELECT count(routingid) routingids FROM subscriptionroutinglist, subscription
1493 WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1494 AND subscription.subscriptionid = ? ORDER BY ranking ASC
1496 $sth->execute($subscriptionid);
1497 my $line = $sth->fetchrow_hashref;
1498 my $result = $line->{'routingids'};
1502 =head2 addroutingmember
1506 &addroutingmember($bornum,$subscriptionid)
1508 this function takes a borrowernumber and subscriptionid and add the member to the
1509 routing list for that serial subscription and gives them a rank on the list
1510 of either 1 or highest current rank + 1
1515 sub addroutingmember {
1516 my ($bornum,$subscriptionid) = @_;
1518 my $dbh = C4::Context->dbh;
1519 my $sth = $dbh->prepare("SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?");
1520 $sth->execute($subscriptionid);
1521 while(my $line = $sth->fetchrow_hashref){
1522 if($line->{'rank'}>0){
1523 $rank = $line->{'rank'}+1;
1528 $sth = $dbh->prepare("INSERT INTO subscriptionroutinglist VALUES (null,?,?,?,null)");
1529 $sth->execute($subscriptionid,$bornum,$rank);
1532 =head2 reorder_members
1536 &reorder_members($subscriptionid,$routingid,$rank)
1538 this function is used to reorder the routing list
1540 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1541 - it gets all members on list puts their routingid's into an array
1542 - removes the one in the array that is $routingid
1543 - then reinjects $routingid at point indicated by $rank
1544 - then update the database with the routingids in the new order
1549 sub reorder_members {
1550 my ($subscriptionid,$routingid,$rank) = @_;
1551 my $dbh = C4::Context->dbh;
1552 my $sth = $dbh->prepare("SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC");
1553 $sth->execute($subscriptionid);
1555 while(my $line = $sth->fetchrow_hashref){
1556 push(@result,$line->{'routingid'});
1558 # To find the matching index
1560 my $key = -1; # to allow for 0 being a valid response
1561 for ($i = 0; $i < @result; $i++) {
1562 if ($routingid == $result[$i]) {
1563 $key = $i; # save the index
1567 # if index exists in array then move it to new position
1568 if($key > -1 && $rank > 0){
1569 my $new_rank = $rank-1; # $new_rank is what you want the new index to be in the array
1570 my $moving_item = splice(@result, $key, 1);
1571 splice(@result, $new_rank, 0, $moving_item);
1573 for(my $j = 0; $j < @result; $j++){
1574 my $sth = $dbh->prepare("UPDATE subscriptionroutinglist SET ranking = '" . ($j+1) . "' WHERE routingid = '". $result[$j]."'");
1579 =head2 delroutingmember
1583 &delroutingmember($routingid,$subscriptionid)
1585 this function either deletes one member from routing list if $routingid exists otherwise
1586 deletes all members from the routing list
1591 sub delroutingmember {
1592 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
1593 my ($routingid,$subscriptionid) = @_;
1594 my $dbh = C4::Context->dbh;
1596 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
1597 $sth->execute($routingid);
1598 reorder_members($subscriptionid,$routingid);
1600 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
1601 $sth->execute($subscriptionid);
1605 =head2 getroutinglist
1609 ($count,@routinglist) = &getroutinglist($subscriptionid)
1611 this gets the info from the subscriptionroutinglist for $subscriptionid
1614 a count of the number of members on routinglist
1615 the routinglist into a table. Each line of this table containts a ref to a hash which containts
1616 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
1621 sub getroutinglist {
1622 my ($subscriptionid) = @_;
1623 my $dbh = C4::Context->dbh;
1624 my $sth = $dbh->prepare("SELECT routingid, borrowernumber,
1625 ranking, biblionumber FROM subscriptionroutinglist, subscription
1626 WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1627 AND subscription.subscriptionid = ? ORDER BY ranking ASC
1629 $sth->execute($subscriptionid);
1632 while (my $line = $sth->fetchrow_hashref) {
1634 push(@routinglist,$line);
1636 return ($count,@routinglist);
1639 =head2 abouttoexpire
1643 $result = &abouttoexpire($subscriptionid)
1645 this function alerts you to the penultimate issue for a serial subscription
1647 returns 1 - if this is the penultimate issue
1655 my ($subscriptionid) = @_;
1656 my $dbh = C4::Context->dbh;
1657 my $subscription = GetSubscription($subscriptionid);
1658 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1659 if ($subscription->{numberlength}) {
1660 my $sth = $dbh->prepare("select count(*) from serial where subscriptionid=? and planneddate>=?");
1661 $sth->execute($subscriptionid,$subscription->{startdate});
1662 my $res = $sth->fetchrow;
1663 # warn "length: ".$subscription->{numberlength}." vs count: ".$res;
1664 if ($subscription->{numberlength}==$res) {
1670 # a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
1671 my $sth = $dbh->prepare("select max(planneddate) from serial where subscriptionid=?");
1672 $sth->execute($subscriptionid);
1673 my $res = ParseDate(format_date_in_iso($sth->fetchrow));
1674 my $endofsubscriptiondate;
1675 $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
1676 $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
1677 # warn "last: ".$endofsubscriptiondate." vs currentdate: ".$res;
1678 my $per = $subscription->{'periodicity'};
1680 if ($per == 1) { $x = '1 day'; }
1681 if ($per == 2) { $x = '1 week'; }
1682 if ($per == 3) { $x = '2 weeks'; }
1683 if ($per == 4) { $x = '3 weeks'; }
1684 if ($per == 5) { $x = '1 month'; }
1685 if ($per == 6) { $x = '2 months'; }
1686 if ($per == 7 || $per == 8) { $x = '3 months'; }
1687 if ($per == 9) { $x = '6 months'; }
1688 if ($per == 10) { $x = '1 year'; }
1689 if ($per == 11) { $x = '2 years'; }
1690 my $datebeforeend = DateCalc($endofsubscriptiondate,"- ".$x); # if ($subscription->{weeklength});
1691 # warn "DATE BEFORE END: $datebeforeend";
1692 return 1 if ($res >= $datebeforeend && $res < $endofsubscriptiondate);
1699 =head2 Get_Next_Date
1703 ($resultdate) = &Get_Next_Date($planneddate,$subscription)
1705 this function is an extension of GetNextDate which allows for checking for irregularity
1707 it takes the planneddate and will return the next issue's date and will skip dates if there
1708 exists an irregularity
1709 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
1710 skipped then the returned date will be 2007-05-10
1713 $resultdate - then next date in the sequence
1718 sub Get_Next_Date(@) {
1719 my ($planneddate,$subscription) = @_;
1720 my @irreg = split(/\|/,$subscription->{irregularity});
1722 my ($year, $month, $day) = UnixDate($planneddate, "%Y", "%m", "%d");
1723 my $dayofweek = Date_DayOfWeek($month,$day,$year);
1725 # warn "DOW $dayofweek";
1726 if ($subscription->{periodicity} == 1) {
1727 for(my $i=0;$i<@irreg;$i++){
1728 if($dayofweek == 7){ $dayofweek = 0; }
1729 if(in_array(($dayofweek+1), @irreg)){
1730 $planneddate = DateCalc($planneddate,"1 day");
1734 $resultdate=DateCalc($planneddate,"1 day");
1736 if ($subscription->{periodicity} == 2) {
1737 my $wkno = Date_WeekOfYear($month,$day,$year,1);
1738 for(my $i = 0;$i < @irreg; $i++){
1739 if($wkno > 52) { $wkno = 0; } # need to rollover at January
1740 if($irreg[$i] == ($wkno+1)){
1741 $planneddate = DateCalc($planneddate,"1 week");
1745 $resultdate=DateCalc($planneddate,"1 week");
1747 if ($subscription->{periodicity} == 3) {
1748 my $wkno = Date_WeekOfYear($month,$day,$year,1);
1749 for(my $i = 0;$i < @irreg; $i++){
1750 if($wkno > 52) { $wkno = 0; } # need to rollover at January
1751 if($irreg[$i] == ($wkno+1)){
1752 $planneddate = DateCalc($planneddate,"2 weeks");
1756 $resultdate=DateCalc($planneddate,"2 weeks");
1758 if ($subscription->{periodicity} == 4) {
1759 my $wkno = Date_WeekOfYear($month,$day,$year,1);
1760 for(my $i = 0;$i < @irreg; $i++){
1761 if($wkno > 52) { $wkno = 0; } # need to rollover at January
1762 if($irreg[$i] == ($wkno+1)){
1763 $planneddate = DateCalc($planneddate,"3 weeks");
1767 $resultdate=DateCalc($planneddate,"3 weeks");
1769 if ($subscription->{periodicity} == 5) {
1770 for(my $i = 0;$i < @irreg; $i++){
1773 if($month == 12) { $month = 0; } # need to rollover to check January
1774 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1775 $planneddate = DateCalc($planneddate,"1 month");
1776 $month++; # to check if following ones are to be skipped too
1779 $resultdate=DateCalc($planneddate,"1 month");
1780 # warn "Planneddate2: $planneddate";
1782 if ($subscription->{periodicity} == 6) {
1783 for(my $i = 0;$i < @irreg; $i++){
1784 if($month == 12) { $month = 0; } # need to rollover to check January
1785 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1786 $planneddate = DateCalc($planneddate,"2 months");
1787 $month++; # to check if following ones are to be skipped too
1790 $resultdate=DateCalc($planneddate,"2 months");
1792 if ($subscription->{periodicity} == 7) {
1793 for(my $i = 0;$i < @irreg; $i++){
1794 if($month == 12) { $month = 0; } # need to rollover to check January
1795 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1796 $planneddate = DateCalc($planneddate,"3 months");
1797 $month++; # to check if following ones are to be skipped too
1800 $resultdate=DateCalc($planneddate,"3 months");
1802 if ($subscription->{periodicity} == 8) {
1803 for(my $i = 0;$i < @irreg; $i++){
1804 if($month == 12) { $month = 0; } # need to rollover to check January
1805 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1806 $planneddate = DateCalc($planneddate,"3 months");
1807 $month++; # to check if following ones are to be skipped too
1810 $resultdate=DateCalc($planneddate,"3 months");
1812 if ($subscription->{periodicity} == 9) {
1813 for(my $i = 0;$i < @irreg; $i++){
1814 if($month == 12) { $month = 0; } # need to rollover to check January
1815 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1816 $planneddate = DateCalc($planneddate,"6 months");
1817 $month++; # to check if following ones are to be skipped too
1820 $resultdate=DateCalc($planneddate,"6 months");
1822 if ($subscription->{periodicity} == 10) {
1823 $resultdate=DateCalc($planneddate,"1 year");
1825 if ($subscription->{periodicity} == 11) {
1826 $resultdate=DateCalc($planneddate,"2 years");
1828 # warn "date: ".$resultdate;
1829 return format_date_in_iso($resultdate);
1833 END { } # module clean-up code here (global destructor)