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) = @_;
716 if ($subscription->{periodicity} == 1) {
717 $duration=get_duration("1 days");
719 if ($subscription->{periodicity} == 2) {
720 $duration=get_duration("1 weeks");
722 if ($subscription->{periodicity} == 3) {
723 $duration=get_duration("2 weeks");
725 if ($subscription->{periodicity} == 4) {
726 $duration=get_duration("3 weeks");
728 if ($subscription->{periodicity} == 5) {
729 $duration=get_duration("1 months");
731 if ($subscription->{periodicity} == 6) {
732 $duration=get_duration("2 months");
734 if ($subscription->{periodicity} == 7 || $subscription->{periodicity} == 8) {
735 $duration=get_duration("3 months");
738 if ($subscription->{periodicity} == 9) {
739 $duration=get_duration("6 months");
741 if ($subscription->{periodicity} == 10) {
742 $duration=get_duration("1 years");
744 if ($subscription->{periodicity} == 11) {
745 $duration=get_duration("2 years");
747 $resultdate=DATE_Add_Duration($planneddate,$duration);
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 my $duration=get_duration($subscription->{monthlength}." months") if ($subscription->{monthlength});
804 my $duration=get_duration($subscription->{weeklength}." weeks") if ($subscription->{weeklength});
806 $enddate = DATE_Add_Duration($subscription->{startdate},$duration) ;
811 =head2 CountSubscriptionFromBiblionumber
815 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
816 this count the number of subscription for a biblionumber given.
818 the number of subscriptions with biblionumber given on input arg.
823 sub CountSubscriptionFromBiblionumber {
824 my ($biblionumber) = @_;
825 my $dbh = C4::Context->dbh;
831 my $sth = $dbh->prepare($query);
832 $sth->execute($biblionumber);
833 my $subscriptionsnumber = $sth->fetchrow;
834 return $subscriptionsnumber;
838 =head2 ModSubscriptionHistory
842 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$receivedlist,$missinglist,$opacnote,$librariannote);
844 this function modify the history of a subscription. Put your new values on input arg.
849 sub ModSubscriptionHistory {
850 my ($subscriptionid,$histstartdate,$enddate,$receivedlist,$missinglist,$opacnote,$librariannote)=@_;
851 my $dbh=C4::Context->dbh;
853 UPDATE subscriptionhistory
854 SET histstartdate=?,enddate=?,receivedlist=?,missinglist=?,opacnote=?,librariannote=?
855 WHERE subscriptionid=?
857 my $sth = $dbh->prepare($query);
858 $receivedlist =~ s/^,//g;
859 $missinglist =~ s/^,//g;
860 $opacnote =~ s/^,//g;
861 $sth->execute($histstartdate,$enddate,$receivedlist,$missinglist,$opacnote,$librariannote,$subscriptionid);
864 =head2 ModSerialStatus
868 ModSerialStatus($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes)
870 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
871 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
876 sub ModSerialStatus {
877 my ($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes,$itemnumber)=@_;
879 # 1st, get previous status :
880 my $dbh = C4::Context->dbh;
882 SELECT subscriptionid,status
886 my $sth = $dbh->prepare($query);
887 $sth->execute($serialid);
888 my ($subscriptionid,$oldstatus) = $sth->fetchrow;
889 # change status & update subscriptionhistory
891 DelIssue($serialseq, $subscriptionid)
895 SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=?,itemnumber=?
898 $sth = $dbh->prepare($query);
899 $sth->execute($serialseq,format_date_in_iso($publisheddate),format_date_in_iso($planneddate),$status,$notes,$itemnumber,$serialid);
901 SELECT missinglist,receivedlist
902 FROM subscriptionhistory
903 WHERE subscriptionid=?
905 $sth = $dbh->prepare($query);
906 $sth->execute($subscriptionid);
907 my ($missinglist,$receivedlist) = $sth->fetchrow;
908 if ($status == 2 && $oldstatus != 2) {
909 $receivedlist .= ",$serialseq";
911 $missinglist .= ",$serialseq" if ($status eq 4) ;
912 $missinglist .= ",not issued $serialseq" if ($status eq 5);
914 UPDATE subscriptionhistory
915 SET receivedlist=?, missinglist=?
916 WHERE subscriptionid=?
918 $sth=$dbh->prepare($query);
919 $sth->execute($receivedlist,$missinglist,$subscriptionid);
921 # create new waited entry if needed (ie : was a "waited" and has changed)
922 if ($oldstatus eq 1 && $status ne 1) {
926 WHERE subscriptionid = ?
928 $sth = $dbh->prepare($query);
929 $sth->execute($subscriptionid);
930 my $val = $sth->fetchrow_hashref;
932 my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3) = GetNextSeq($val);
933 # next date (calculated from actual date & frequency parameters)
934 my $nextplanneddate = Get_Next_Date($planneddate,$val);
935 my $nextpublisheddate = Get_Next_Date($publisheddate,$val);
936 NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextpublisheddate,$nextplanneddate,0);
939 SET lastvalue1=?, lastvalue2=?, lastvalue3=?,
940 innerloop1=?, innerloop2=?, innerloop3=?
941 WHERE subscriptionid = ?
943 $sth = $dbh->prepare($query);
944 $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3,$subscriptionid);
948 =head2 ModSubscription
952 this function modify a subscription. Put all new values on input args.
957 sub ModSubscription {
958 my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
959 $periodicity,$dow,$numberlength,$weeklength,$monthlength,
960 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
961 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
962 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
963 $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid,$irregularity,$hemisphere,$callnumber,$numberpattern,$publisheddate)= @_;
964 my $dbh = C4::Context->dbh;
967 SET librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
968 periodicity=?,dow=?,numberlength=?,weeklength=?,monthlength=?,
969 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
970 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
971 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
972 numberingmethod=?, status=?, biblionumber=?, notes=?, letter=?,irregularity=?,hemisphere=?,callnumber=?,numberpattern=? ,publisheddate=?
973 WHERE subscriptionid = ?
975 my $sth=$dbh->prepare($query);
976 $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
977 $periodicity,$dow,$numberlength,$weeklength,$monthlength,
978 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
979 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
980 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
981 $numberingmethod, $status, $biblionumber, $notes, $letter, $irregularity,$hemisphere,$callnumber,$numberpattern,$publisheddate,$subscriptionid);
986 =head2 NewSubscription
990 $subscriptionid = &NewSubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
991 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
992 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
993 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
994 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
995 $numberingmethod, $status, $notes)
997 Create a new subscription with value given on input args.
1000 the id of this new subscription
1005 sub NewSubscription {
1006 my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1007 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1008 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1009 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1010 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1011 $numberingmethod, $status, $notes, $letter,$irregularity,$hemisphere,$callnumber,$numberpattern,$publisheddate) = @_;
1013 my $dbh = C4::Context->dbh;
1014 #save subscription (insert into database)
1016 INSERT INTO subscription
1017 (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
1018 startdate,periodicity,dow,numberlength,weeklength,monthlength,
1019 add1,every1,whenmorethan1,setto1,lastvalue1,
1020 add2,every2,whenmorethan2,setto2,lastvalue2,
1021 add3,every3,whenmorethan3,setto3,lastvalue3,
1022 numberingmethod, status, notes, letter,irregularity,hemisphere,callnumber,numberpattern,publisheddate)
1023 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1025 my $sth=$dbh->prepare($query);
1027 $auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1028 format_date_in_iso($startdate),$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1029 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1030 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1031 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1032 $numberingmethod, $status, $notes, $letter,$irregularity,$hemisphere,$callnumber,$numberpattern,format_date_in_iso($publisheddate));
1035 #then create the 1st waited number
1036 my $subscriptionid = $dbh->{'mysql_insertid'};
1037 my $enddate = GetSubscriptionExpirationDate($subscriptionid);
1039 INSERT INTO subscriptionhistory
1040 (biblionumber, subscriptionid, histstartdate, enddate, missinglist, receivedlist, opacnote, librariannote)
1041 VALUES (?,?,?,?,?,?,?,?)
1043 $sth = $dbh->prepare($query);
1044 $sth->execute($biblionumber, $subscriptionid, format_date_in_iso($startdate), format_date_in_iso($enddate), "", "", "", $notes);
1045 ## User may have subscriptionid stored in MARC so check and fill it
1046 my $record=XMLgetbiblio($dbh,$biblionumber);
1047 $record=XML_xml2hash_onerecord($record);
1048 XML_writeline( $record, "subscriptionid", $subscriptionid,"biblios" );
1049 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
1050 NEWmodbiblio($dbh,$biblionumber,$record,$frameworkcode);
1051 # reread subscription to get a hash (for calculation of the 1st issue number)
1055 WHERE subscriptionid = ?
1057 $sth = $dbh->prepare($query);
1058 $sth->execute($subscriptionid);
1059 my $val = $sth->fetchrow_hashref;
1061 # calculate issue number
1062 my $serialseq = GetSeq($val);
1065 (serialseq,subscriptionid,biblionumber,status, planneddate,publisheddate)
1066 VALUES (?,?,?,?,?,?)
1069 $sth = $dbh->prepare($query);
1070 $sth->execute($serialseq, $subscriptionid, $val->{'biblionumber'}, 1, format_date_in_iso($startdate),format_date_in_iso($publisheddate));
1071 return $subscriptionid;
1075 =head2 ReNewSubscription
1079 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1081 this function renew a subscription with values given on input args.
1086 sub ReNewSubscription {
1087 my ($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note) = @_;
1088 my $dbh = C4::Context->dbh;
1089 my $subscription = GetSubscription($subscriptionid);
1090 my $record=XMLgetbiblio($dbh,$subscription->{biblionumber});
1091 $record=XML_xml2hash_onerecord($record);
1092 my $biblio = XMLmarc2koha_onerecord($dbh,$record,"biblios");
1093 NewSuggestion($user,$subscription->{bibliotitle},$biblio->{author},$biblio->{publishercode},$biblio->{note},'','','','','',$subscription->{biblionumber});
1094 # renew subscription
1097 SET startdate=?,numberlength=?,weeklength=?,monthlength=?
1098 WHERE subscriptionid=?
1100 my $sth=$dbh->prepare($query);
1101 $sth->execute(format_date_in_iso($startdate),$numberlength,$weeklength,$monthlength, $subscriptionid);
1109 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate)
1111 Create a new issue stored on the database.
1112 Note : we have to update the receivedlist and missinglist on subscriptionhistory for this subscription.
1118 my ($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate,$itemnumber) = @_;
1119 my $dbh = C4::Context->dbh;
1122 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,itemnumber)
1123 VALUES (?,?,?,?,?,?,?)
1125 my $sth = $dbh->prepare($query);
1126 $sth->execute($serialseq,$subscriptionid,$biblionumber,$status,format_date_in_iso($publisheddate), format_date_in_iso($planneddate),$itemnumber);
1129 SELECT missinglist,receivedlist
1130 FROM subscriptionhistory
1131 WHERE subscriptionid=?
1133 $sth = $dbh->prepare($query);
1134 $sth->execute($subscriptionid);
1135 my ($missinglist,$receivedlist) = $sth->fetchrow;
1137 $receivedlist .= ",$serialseq";
1140 $missinglist .= ",$serialseq";
1143 UPDATE subscriptionhistory
1144 SET receivedlist=?, missinglist=?
1145 WHERE subscriptionid=?
1147 $sth=$dbh->prepare($query);
1148 $sth->execute($receivedlist,$missinglist,$subscriptionid);
1151 =head2 serialchangestatus
1155 serialchangestatus($serialid,$serialseq,$planneddate,$status,$notes)
1157 Change the status of a serial issue.
1158 Note: this was the older subroutine
1163 sub serialchangestatus {
1164 my ($serialid,$serialseq,$planneddate,$status,$notes)=@_;
1165 # 1st, get previous status : if we change from "waited" to something else, then we will have to create a new "waited" entry
1166 my $dbh = C4::Context->dbh;
1167 my $sth = $dbh->prepare("select subscriptionid,status from serial where serialid=?");
1168 $sth->execute($serialid);
1169 my ($subscriptionid,$oldstatus) = $sth->fetchrow;
1170 # change status & update subscriptionhistory
1172 delissue($serialseq, $subscriptionid)
1174 $sth = $dbh->prepare("update serial set serialseq=?,planneddate=?,status=?,notes=? where serialid = ?");
1175 $sth->execute($serialseq,format_date_in_iso($planneddate),$status,$notes,$serialid);
1177 $sth = $dbh->prepare("select missinglist,receivedlist from subscriptionhistory where subscriptionid=?");
1178 $sth->execute($subscriptionid);
1179 my ($missinglist,$receivedlist) = $sth->fetchrow;
1181 $receivedlist .= "| $serialseq";
1182 $receivedlist =~ s/^\| //g;
1184 $missinglist .= "| $serialseq" if ($status eq 4) ;
1185 $missinglist .= "| not issued $serialseq" if ($status eq 5);
1186 $missinglist =~ s/^\| //g;
1187 $sth=$dbh->prepare("update subscriptionhistory set receivedlist=?, missinglist=? where subscriptionid=?");
1188 $sth->execute($receivedlist,$missinglist,$subscriptionid);
1190 # create new waited entry if needed (ie : was a "waited" and has changed)
1191 if ($oldstatus eq 1 && $status ne 1) {
1192 $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1193 $sth->execute($subscriptionid);
1194 my $val = $sth->fetchrow_hashref;
1196 my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3) = New_Get_Next_Seq($val);
1197 my $nextplanneddate = Get_Next_Date($planneddate,$val);
1198 NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextplanneddate);
1199 $sth = $dbh->prepare("update subscription set lastvalue1=?, lastvalue2=?,lastvalue3=? where subscriptionid = ?");
1200 $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$subscriptionid);
1202 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1203 $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1204 $sth->execute($subscriptionid);
1205 my $subscription = $sth->fetchrow_hashref;
1206 if ($subscription->{letter} && $status eq 2) {
1207 sendalerts('issue',$subscription->{subscriptionid},$subscription->{letter});
1214 =head2 HasSubscriptionExpired
1218 1 or 0 = HasSubscriptionExpired($subscriptionid)
1220 the subscription has expired when the next issue to arrive is out of subscription limit.
1223 1 if true, 0 if false.
1228 sub HasSubscriptionExpired {
1229 my ($subscriptionid) = @_;
1230 my $dbh = C4::Context->dbh;
1231 my $subscription = GetSubscription($subscriptionid);
1232 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1233 if ($subscription->{numberlength} ) {
1237 WHERE subscriptionid=? AND planneddate>=?
1239 my $sth = $dbh->prepare($query);
1240 $sth->execute($subscriptionid,$subscription->{startdate});
1241 my $res = $sth->fetchrow;
1242 if ($subscription->{numberlength}>=$res) {
1248 #a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
1250 SELECT max(planneddate)
1252 WHERE subscriptionid=?
1254 my $sth = $dbh->prepare($query);
1255 $sth->execute($subscriptionid);
1256 my $res = $sth->fetchrow;
1257 my $endofsubscriptiondate;
1258 my $duration=get_duration($subscription->{monthlength}." months") if ($subscription->{monthlength});
1259 my $duration=get_duration($subscription->{weeklength}." weeks") if ($subscription->{weeklength});
1261 $endofsubscriptiondate = DATE_Add_Duration($subscription->{startdate},$duration) ;
1262 return 1 if ($res >= $endofsubscriptiondate);
1267 =head2 SetDistributedto
1271 SetDistributedto($distributedto,$subscriptionid);
1272 This function update the value of distributedto for a subscription given on input arg.
1277 sub SetDistributedto {
1278 my ($distributedto,$subscriptionid) = @_;
1279 my $dbh = C4::Context->dbh;
1283 WHERE subscriptionid=?
1285 my $sth = $dbh->prepare($query);
1286 $sth->execute($distributedto,$subscriptionid);
1289 =head2 DelSubscription
1293 DelSubscription($subscriptionid)
1294 this function delete the subscription which has $subscriptionid as id.
1299 sub DelSubscription {
1300 my ($subscriptionid,$biblionumber) = @_;
1301 my $dbh = C4::Context->dbh;
1302 ## User may have subscriptionid stored in MARC so check and remove it
1303 my $record=XMLgetbibliohash($dbh,$biblionumber);
1304 XML_writeline( $record, "subscriptionid", "","biblios" );
1305 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
1306 NEWmodbiblio($dbh,$biblionumber,$record,$frameworkcode);
1307 $subscriptionid=$dbh->quote($subscriptionid);
1308 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1309 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1310 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1318 DelIssue($serialseq,$subscriptionid)
1319 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1325 my ($serialseq,$subscriptionid) = @_;
1326 my $dbh = C4::Context->dbh;
1330 AND subscriptionid= ?
1332 my $sth = $dbh->prepare($query);
1333 $sth->execute($serialseq,$subscriptionid);
1336 =head2 GetMissingIssues
1340 ($count,@issuelist) = &GetMissingIssues($supplierid,$serialid)
1342 this function select missing issues on database - where serial.status = 4
1345 a count of the number of missing issues
1346 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1347 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1352 sub GetMissingIssues {
1353 my ($supplierid,$serialid) = @_;
1354 my $dbh = C4::Context->dbh;
1358 $byserial = "and serialid = ".$serialid;
1361 $sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
1362 FROM subscription, serial, biblio
1363 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1364 WHERE subscription.subscriptionid = serial.subscriptionid AND
1365 serial.STATUS = 4 and
1366 subscription.aqbooksellerid=$supplierid and
1367 biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
1370 $sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
1371 FROM subscription, serial, biblio
1372 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1373 WHERE subscription.subscriptionid = serial.subscriptionid AND
1374 serial.STATUS =4 and
1375 biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
1383 while (my $line = $sth->fetchrow_hashref) {
1384 $odd++ unless $line->{title} eq $last_title;
1385 $last_title = $line->{title} if ($line->{title});
1386 $line->{planneddate} = format_date($line->{planneddate});
1387 $line->{claimdate} = format_date($line->{claimdate});
1388 $line->{'odd'} = 1 if $odd %2 ;
1390 push @issuelist,$line;
1392 return $count,@issuelist;
1395 =head2 removeMissingIssue
1399 removeMissingIssue($subscriptionid)
1401 this function removes an issue from being part of the missing string in
1402 subscriptionlist.missinglist column
1404 called when a missing issue is found from the statecollection.pl file
1409 sub removeMissingIssue {
1410 my ($sequence,$subscriptionid) = @_;
1411 my $dbh = C4::Context->dbh;
1412 my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1413 $sth->execute($subscriptionid);
1414 my $data = $sth->fetchrow_hashref;
1415 my $missinglist = $data->{'missinglist'};
1416 my $missinglistbefore = $missinglist;
1417 # warn $missinglist." before";
1418 $missinglist =~ s/($sequence)//;
1419 # warn $missinglist." after";
1420 if($missinglist ne $missinglistbefore){
1421 $missinglist =~ s/\|\s\|/\|/g;
1422 $missinglist =~ s/^\| //g;
1423 $missinglist =~ s/\|$//g;
1424 my $sth2= $dbh->prepare("UPDATE subscriptionhistory
1426 WHERE subscriptionid = ?");
1427 $sth2->execute($missinglist,$subscriptionid);
1435 &updateClaim($serialid)
1437 this function updates the time when a claim is issued for late/missing items
1439 called from claims.pl file
1445 my ($serialid) = @_;
1446 my $dbh = C4::Context->dbh;
1447 my $sth = $dbh->prepare("UPDATE serial SET claimdate = now()
1450 $sth->execute($serialid);
1453 =head2 getsupplierbyserialid
1457 ($result) = &getsupplierbyserialid($serialid)
1459 this function is used to find the supplier id given a serial id
1462 hashref containing serialid, subscriptionid, and aqbooksellerid
1467 sub getsupplierbyserialid {
1468 my ($serialid) = @_;
1469 my $dbh = C4::Context->dbh;
1470 my $sth = $dbh->prepare("SELECT serialid, serial.subscriptionid, aqbooksellerid
1471 FROM serial, subscription
1472 WHERE serial.subscriptionid = subscription.subscriptionid
1475 $sth->execute($serialid);
1476 my $line = $sth->fetchrow_hashref;
1477 my $result = $line->{'aqbooksellerid'};
1481 =head2 check_routing
1485 ($result) = &check_routing($subscriptionid)
1487 this function checks to see if a serial has a routing list and returns the count of routingid
1488 used to show either an 'add' or 'edit' link
1493 my ($subscriptionid) = @_;
1494 my $dbh = C4::Context->dbh;
1495 my $sth = $dbh->prepare("SELECT count(routingid) routingids FROM subscriptionroutinglist, subscription
1496 WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1497 AND subscription.subscriptionid = ? ORDER BY ranking ASC
1499 $sth->execute($subscriptionid);
1500 my $line = $sth->fetchrow_hashref;
1501 my $result = $line->{'routingids'};
1505 =head2 addroutingmember
1509 &addroutingmember($bornum,$subscriptionid)
1511 this function takes a borrowernumber and subscriptionid and add the member to the
1512 routing list for that serial subscription and gives them a rank on the list
1513 of either 1 or highest current rank + 1
1518 sub addroutingmember {
1519 my ($bornum,$subscriptionid) = @_;
1521 my $dbh = C4::Context->dbh;
1522 my $sth = $dbh->prepare("SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?");
1523 $sth->execute($subscriptionid);
1524 while(my $line = $sth->fetchrow_hashref){
1525 if($line->{'rank'}>0){
1526 $rank = $line->{'rank'}+1;
1531 $sth = $dbh->prepare("INSERT INTO subscriptionroutinglist VALUES (null,?,?,?,null)");
1532 $sth->execute($subscriptionid,$bornum,$rank);
1535 =head2 reorder_members
1539 &reorder_members($subscriptionid,$routingid,$rank)
1541 this function is used to reorder the routing list
1543 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1544 - it gets all members on list puts their routingid's into an array
1545 - removes the one in the array that is $routingid
1546 - then reinjects $routingid at point indicated by $rank
1547 - then update the database with the routingids in the new order
1552 sub reorder_members {
1553 my ($subscriptionid,$routingid,$rank) = @_;
1554 my $dbh = C4::Context->dbh;
1555 my $sth = $dbh->prepare("SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC");
1556 $sth->execute($subscriptionid);
1558 while(my $line = $sth->fetchrow_hashref){
1559 push(@result,$line->{'routingid'});
1561 # To find the matching index
1563 my $key = -1; # to allow for 0 being a valid response
1564 for ($i = 0; $i < @result; $i++) {
1565 if ($routingid == $result[$i]) {
1566 $key = $i; # save the index
1570 # if index exists in array then move it to new position
1571 if($key > -1 && $rank > 0){
1572 my $new_rank = $rank-1; # $new_rank is what you want the new index to be in the array
1573 my $moving_item = splice(@result, $key, 1);
1574 splice(@result, $new_rank, 0, $moving_item);
1576 for(my $j = 0; $j < @result; $j++){
1577 my $sth = $dbh->prepare("UPDATE subscriptionroutinglist SET ranking = '" . ($j+1) . "' WHERE routingid = '". $result[$j]."'");
1582 =head2 delroutingmember
1586 &delroutingmember($routingid,$subscriptionid)
1588 this function either deletes one member from routing list if $routingid exists otherwise
1589 deletes all members from the routing list
1594 sub delroutingmember {
1595 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
1596 my ($routingid,$subscriptionid) = @_;
1597 my $dbh = C4::Context->dbh;
1599 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
1600 $sth->execute($routingid);
1601 reorder_members($subscriptionid,$routingid);
1603 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
1604 $sth->execute($subscriptionid);
1608 =head2 getroutinglist
1612 ($count,@routinglist) = &getroutinglist($subscriptionid)
1614 this gets the info from the subscriptionroutinglist for $subscriptionid
1617 a count of the number of members on routinglist
1618 the routinglist into a table. Each line of this table containts a ref to a hash which containts
1619 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
1624 sub getroutinglist {
1625 my ($subscriptionid) = @_;
1626 my $dbh = C4::Context->dbh;
1627 my $sth = $dbh->prepare("SELECT routingid, borrowernumber,
1628 ranking, biblionumber FROM subscriptionroutinglist, subscription
1629 WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1630 AND subscription.subscriptionid = ? ORDER BY ranking ASC
1632 $sth->execute($subscriptionid);
1635 while (my $line = $sth->fetchrow_hashref) {
1637 push(@routinglist,$line);
1639 return ($count,@routinglist);
1642 =head2 abouttoexpire
1646 $result = &abouttoexpire($subscriptionid)
1648 this function alerts you to the penultimate issue for a serial subscription
1650 returns 1 - if this is the penultimate issue
1658 my ($subscriptionid) = @_;
1659 my $dbh = C4::Context->dbh;
1660 my $subscription = GetSubscription($subscriptionid);
1661 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1662 if ($subscription->{numberlength}) {
1663 my $sth = $dbh->prepare("select count(*) from serial where subscriptionid=? and planneddate>=?");
1664 $sth->execute($subscriptionid,$subscription->{startdate});
1665 my $res = $sth->fetchrow;
1666 # warn "length: ".$subscription->{numberlength}." vs count: ".$res;
1667 if ($subscription->{numberlength}==$res) {
1673 # a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
1674 my $sth = $dbh->prepare("select max(planneddate) from serial where subscriptionid=?");
1675 $sth->execute($subscriptionid);
1676 my $res = $sth->fetchrow;
1677 my $endofsubscriptiondate;
1678 my $duration=get_duration($subscription->{monthlength}." months") if ($subscription->{monthlength});
1679 my $duration=get_duration($subscription->{weeklength}." weeks") if ($subscription->{weeklength});
1681 $endofsubscriptiondate = DATE_Add_Duration($subscription->{startdate},$duration) ;
1682 my $per = $subscription->{'periodicity'};
1684 if ($per == 1) { $x = '1 days'; }
1685 if ($per == 2) { $x = '1 weeks'; }
1686 if ($per == 3) { $x = '2 weeks'; }
1687 if ($per == 4) { $x = '3 weeks'; }
1688 if ($per == 5) { $x = '1 months'; }
1689 if ($per == 6) { $x = '2 months'; }
1690 if ($per == 7 || $per == 8) { $x = '3 months'; }
1691 if ($per == 9) { $x = '6 months'; }
1692 if ($per == 10) { $x = '1 years'; }
1693 if ($per == 11) { $x = '2 years'; }
1694 my $duration=get_duration("-".$x) ;
1695 my $datebeforeend = DATE_Add_Duration($endofsubscriptiondate,$duration); # if ($subscription->{weeklength});
1696 # warn "DATE BEFORE END: $datebeforeend";
1697 return 1 if ($res >= $datebeforeend && $res < $endofsubscriptiondate);
1704 =head2 Get_Next_Date
1708 ($resultdate) = &Get_Next_Date($planneddate,$subscription)
1710 this function is an extension of GetNextDate which allows for checking for irregularity
1712 it takes the planneddate and will return the next issue's date and will skip dates if there
1713 exists an irregularity
1714 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
1715 skipped then the returned date will be 2007-05-10
1718 $resultdate - then next date in the sequence
1723 sub Get_Next_Date(@) {
1724 my ($planneddate,$subscription) = @_;
1725 my @irreg = split(/\|/,$subscription->{irregularity});
1726 my $dateobj=DATE_obj($planneddate);
1727 my $dayofweek = $dateobj->day_of_week;
1728 my $month=$dateobj->month;
1730 # warn "DOW $dayofweek";
1732 if ($subscription->{periodicity} == 1) {
1733 my $duration=get_duration("1 days");
1734 for(my $i=0;$i<@irreg;$i++){
1735 if($dayofweek == 7){ $dayofweek = 0; }
1737 if(in_array(($dayofweek+1), @irreg)){
1738 $planneddate = DATE_Add_Duration($planneddate,$duration);
1742 $resultdate=DATE_Add_Duration($planneddate,$duration);
1744 if ($subscription->{periodicity} == 2) {
1745 my $wkno = $dateobj->week_number;
1746 my $duration=get_duration("1 weeks");
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 = DATE_Add_Duration($planneddate,$duration);
1754 $resultdate=DATE_Add_Duration($planneddate,$duration);
1756 if ($subscription->{periodicity} == 3) {
1757 my $wkno = $dateobj->week_number;
1758 my $duration=get_duration("2 weeks");
1759 for(my $i = 0;$i < @irreg; $i++){
1760 if($wkno > 52) { $wkno = 0; } # need to rollover at January
1761 if($irreg[$i] == ($wkno+1)){
1762 $planneddate = DATE_Add_Duration($planneddate,$duration);
1766 $resultdate=DATE_Add_Duration($planneddate,$duration);
1768 if ($subscription->{periodicity} == 4) {
1769 my $wkno = $dateobj->week_number;
1770 my $duration=get_duration("3 weeks");
1771 for(my $i = 0;$i < @irreg; $i++){
1772 if($wkno > 52) { $wkno = 0; } # need to rollover at January
1773 if($irreg[$i] == ($wkno+1)){
1774 $planneddate = DATE_Add_Duration($planneddate,$duration);
1778 $resultdate=DATE_Add_Duration($planneddate,$duration);
1780 if ($subscription->{periodicity} == 5) {
1781 my $duration=get_duration("1 months");
1782 for(my $i = 0;$i < @irreg; $i++){
1785 if($month == 12) { $month = 0; } # need to rollover to check January
1786 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1787 $planneddate = DATE_Add_Duration($planneddate,$duration);
1788 $month++; # to check if following ones are to be skipped too
1791 $resultdate=DATE_Add_Duration($planneddate,$duration);
1792 # warn "Planneddate2: $planneddate";
1794 if ($subscription->{periodicity} == 6) {
1795 my $duration=get_duration("2 months");
1796 for(my $i = 0;$i < @irreg; $i++){
1799 if($month == 12) { $month = 0; } # need to rollover to check January
1800 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1801 $planneddate = DATE_Add_Duration($planneddate,$duration);
1802 $month++; # to check if following ones are to be skipped too
1805 $resultdate=DATE_Add_Duration($planneddate,$duration);
1807 if ($subscription->{periodicity} == 7 || $subscription->{periodicity} == 8 ) {
1808 my $duration=get_duration("3 months");
1809 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 = DATE_Add_Duration($planneddate,$duration);
1815 $month++; # to check if following ones are to be skipped too
1818 $resultdate=DATE_Add_Duration($planneddate,$duration);
1821 if ($subscription->{periodicity} == 9) {
1822 my $duration=get_duration("6 months");
1823 for(my $i = 0;$i < @irreg; $i++){
1826 if($month == 12) { $month = 0; } # need to rollover to check January
1827 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1828 $planneddate = DATE_Add_Duration($planneddate,$duration);
1829 $month++; # to check if following ones are to be skipped too
1832 $resultdate=DATE_Add_Duration($planneddate,$duration);
1834 if ($subscription->{periodicity} == 10) {
1835 my $duration=get_duration("1 years");
1836 $resultdate=DATE_Add_Duration($planneddate,$duration);
1838 if ($subscription->{periodicity} == 11) {
1839 my $duration=get_duration("2 years");
1840 $resultdate=DATE_Add_Duration($planneddate,$duration);
1842 # warn "date: ".$resultdate;
1848 END { } # module clean-up code here (global destructor)