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
30 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
32 # set the version for version checking
33 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
34 shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
39 C4::Serials - Give functions for serializing.
47 Give all XYZ functions
54 &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions &GetSubscription
55 &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
56 &GetFullSubscriptionsFromBiblionumber &GetNextSeq
57 &ModSubscriptionHistory &NewIssue
58 &GetSerials &GetLatestSerials &ModSerialStatus
59 &HasSubscriptionExpired &GetSubscriptionExpirationDate &ReNewSubscription
60 &GetSuppliersWithLateIssues &GetLateIssues &GetMissingIssues
61 &GetDistributedTo &SetDistributedto
62 &getroutinglist &delroutingmember &addroutingmember &reorder_members
63 &check_routing &getsupplierbyserialid &updateClaim &removeMissingIssue &abouttoexpire
67 =head2 GetSuppliersWithLateIssues
71 %supplierlist = &GetSuppliersWithLateIssues
73 this function get all suppliers with late issues.
76 the supplierlist into a hash. this hash containts id & name of the supplier
81 sub GetSuppliersWithLateIssues {
82 my $dbh = C4::Context->dbh;
84 SELECT DISTINCT id, name
85 FROM subscription, serial
86 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
87 WHERE subscription.subscriptionid = serial.subscriptionid
88 AND (planneddate < now() OR serial.STATUS = 3 OR serial.STATUS = 4)
90 my $sth = $dbh->prepare($query);
93 while (my ($id,$name) = $sth->fetchrow) {
94 $supplierlist{$id} = $name;
96 if(C4::Context->preference("RoutingSerials")){
97 $supplierlist{''} = "All Suppliers";
106 @issuelist = &GetLateIssues($supplierid)
108 this function select late issues on database
111 the issuelist into an table. Each line of this table containts a ref to a hash which it containts
112 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
118 my ($supplierid) = @_;
119 my $dbh = C4::Context->dbh;
123 SELECT name,title,planneddate,serialseq,serial.subscriptionid
124 FROM subscription, serial, biblio
125 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
126 WHERE subscription.subscriptionid = serial.subscriptionid
127 AND ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
128 AND subscription.aqbooksellerid=$supplierid
129 AND biblio.biblionumber = subscription.biblionumber
132 $sth = $dbh->prepare($query);
135 SELECT name,title,planneddate,serialseq,serial.subscriptionid
136 FROM subscription, serial, biblio
137 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
138 WHERE subscription.subscriptionid = serial.subscriptionid
139 AND ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
140 AND biblio.biblionumber = subscription.biblionumber
143 $sth = $dbh->prepare($query);
150 while (my $line = $sth->fetchrow_hashref) {
151 $odd++ unless $line->{title} eq $last_title;
152 $line->{title} = "" if $line->{title} eq $last_title;
153 $last_title = $line->{title} if ($line->{title});
154 $line->{planneddate} = format_date($line->{planneddate});
155 $line->{'odd'} = 1 if $odd %2 ;
157 push @issuelist,$line;
159 return $count,@issuelist;
162 =head2 GetSubscriptionHistoryFromSubscriptionId
166 $sth = GetSubscriptionHistoryFromSubscriptionId()
167 this function just prepare the SQL request.
168 After this function, don't forget to execute it by using $sth->execute($subscriptionid)
170 $sth = $dbh->prepare($query).
175 sub GetSubscriptionHistoryFromSubscriptionId() {
176 my $dbh = C4::Context->dbh;
179 FROM subscriptionhistory
180 WHERE subscriptionid = ?
182 return $dbh->prepare($query);
185 =head2 GetSerialStatusFromSerialId
189 $sth = GetSerialStatusFromSerialId();
190 this function just prepare the SQL request.
191 After this function, don't forget to execute it by using $sth->execute($serialid)
193 $sth = $dbh->prepare($query).
198 sub GetSerialStatusFromSerialId(){
199 my $dbh = C4::Context->dbh;
205 return $dbh->prepare($query);
209 =head2 GetSubscription
213 $subs = GetSubscription($subscriptionid)
214 this function get the subscription which has $subscriptionid as id.
216 a hashref. This hash containts
217 subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
222 sub GetSubscription {
223 my ($subscriptionid) = @_;
224 my $dbh = C4::Context->dbh;
226 SELECT subscription.*,
227 subscriptionhistory.*,
229 aqbooksellers.name AS aqbooksellername,
230 biblio.title AS bibliotitle
232 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
233 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
234 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
235 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
236 WHERE subscription.subscriptionid = ?
238 my $sth = $dbh->prepare($query);
239 $sth->execute($subscriptionid);
240 my $subs = $sth->fetchrow_hashref;
244 =head2 GetSubscriptionsFromBiblionumber
248 \@res = GetSubscriptionsFromBiblionumber($biblionumber)
249 this function get the subscription list. it reads on subscription table.
251 table of subscription which has the biblionumber given on input arg.
252 each line of this table is a hashref. All hashes containt
253 planned, histstartdate,opacnote,missinglist,receivedlist,periodicity,status & enddate
258 sub GetSubscriptionsFromBiblionumber {
259 my ($biblionumber) = @_;
260 my $dbh = C4::Context->dbh;
262 SELECT subscription.*,
263 subscriptionhistory.*,
265 aqbooksellers.name AS aqbooksellername,
266 biblio.title AS bibliotitle
268 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
269 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
270 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
271 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
272 WHERE subscription.biblionumber = ?
274 my $sth = $dbh->prepare($query);
275 $sth->execute($biblionumber);
277 while (my $subs = $sth->fetchrow_hashref) {
278 $subs->{planneddate} = format_date($subs->{planneddate});
279 $subs->{publisheddate} = format_date($subs->{publisheddate});
280 $subs->{histstartdate} = format_date($subs->{histstartdate});
281 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
282 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
283 $subs->{receivedlist} =~ s/\n/\<br\/\>/g;
284 $subs->{"periodicity".$subs->{periodicity}} = 1;
285 $subs->{"status".$subs->{'status'}} = 1;
286 if ($subs->{enddate} eq '0000-00-00') {
289 $subs->{enddate} = format_date($subs->{enddate});
295 =head2 GetFullSubscriptionsFromBiblionumber
299 \@res = GetFullSubscriptionsFromBiblionumber($biblionumber)
300 this function read on serial table.
305 sub GetFullSubscriptionsFromBiblionumber {
306 my ($biblionumber) = @_;
307 my $dbh = C4::Context->dbh;
309 SELECT serial.serialseq,
311 serial.publisheddate,
314 year(serial.publisheddate) AS year,
315 aqbudget.bookfundid,aqbooksellers.name AS aqbooksellername,
316 biblio.title AS bibliotitle
318 LEFT JOIN subscription ON
319 (serial.subscriptionid=subscription.subscriptionid AND subscription.biblionumber=serial.biblionumber)
320 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
321 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
322 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
323 WHERE subscription.biblionumber = ?
324 ORDER BY year,serial.publisheddate,serial.subscriptionid,serial.planneddate
327 my $sth = $dbh->prepare($query);
328 $sth->execute($biblionumber);
332 my $aqbooksellername;
337 while (my $subs = $sth->fetchrow_hashref) {
338 ### BUG To FIX: When there is no published date, will create many null ids!!!
340 if ($year and ($year==$subs->{year})){
341 if ($first eq 1){$first=0;}
342 my $temp=$res[scalar(@res)-1]->{'serials'};
344 {'publisheddate' =>format_date($subs->{'publisheddate'}),
345 'planneddate' => format_date($subs->{'planneddate'}),
346 'serialseq' => $subs->{'serialseq'},
347 "status".$subs->{'status'} => 1,
348 'notes' => $subs->{'notes'} eq $previousnote?"":$subs->{notes},
351 $first=1 if (not $year);
352 $year= $subs->{'year'};
353 $startdate= format_date($subs->{'startdate'});
354 $aqbooksellername= $subs->{'aqbooksellername'};
355 $bibliotitle= $subs->{'bibliotitle'};
358 {'publisheddate' =>format_date($subs->{'publisheddate'}),
359 'planneddate' => format_date($subs->{'planneddate'}),
360 'serialseq' => $subs->{'serialseq'},
361 "status".$subs->{'status'} => 1,
362 'notes' => $subs->{'notes'} eq $previousnote?"":$subs->{notes},
367 'startdate'=>$startdate,
368 'aqbooksellername'=>$aqbooksellername,
369 'bibliotitle'=>$bibliotitle,
374 $previousnote=$subs->{notes};
380 =head2 GetSubscriptions
384 @results = GetSubscriptions($title,$ISSN,$biblionumber);
385 this function get all subscriptions which has title like $title,ISSN like $ISSN and biblionumber like $biblionumber.
387 a table of hashref. Each hash containt the subscription.
392 sub GetSubscriptions {
393 my ($title,$ISSN,$biblionumber) = @_;
394 return unless $title or $ISSN or $biblionumber;
395 my $dbh = C4::Context->dbh;
399 SELECT subscription.subscriptionid,biblio.title,biblio.issn,subscription.notes,biblio.biblionumber
400 FROM subscription,biblio
401 WHERE biblio.biblionumber = subscription.biblionumber
402 AND biblio.biblionumber=?
405 $sth = $dbh->prepare($query);
406 $sth->execute($biblionumber);
408 if ($ISSN and $title){
410 SELECT subscription.subscriptionid,biblio.title,biblio.issn,subscription.notes,biblio.biblionumber
411 FROM subscription,biblio
412 WHERE biblio.biblionumber= subscription.biblionumber
413 AND (biblio.title LIKE ? or biblio.issn = ?)
416 $sth = $dbh->prepare($query);
417 $sth->execute("%$title%",$ISSN);
422 SELECT subscription.subscriptionid,biblio.title,biblio.issn,subscription.notes,biblio.biblionumber
423 FROM subscription,biblio
424 WHERE biblio.biblionumber = biblioitems.biblionumber
425 AND biblio.biblionumber=subscription.biblionumber
426 AND biblioitems.issn = ?
429 $sth = $dbh->prepare($query);
430 $sth->execute($ISSN);
433 SELECT subscription.subscriptionid,biblio.title,biblio.issn,subscription.notes,biblio.biblionumber
434 FROM subscription,biblio
435 WHERE biblio.biblionumber=subscription.biblionumber
436 AND biblio.title LIKE ?
439 $sth = $dbh->prepare($query);
440 $sth->execute("%$title%");
445 my $previoustitle="";
447 while (my $line = $sth->fetchrow_hashref) {
448 if ($previoustitle eq $line->{title}) {
451 $line->{toggle} = 1 if $odd==1;
453 $previoustitle=$line->{title};
455 $line->{toggle} = 1 if $odd==1;
457 push @results, $line;
466 ($totalissues,@serials) = GetSerials($subscriptionid);
467 this function get every serial not arrived for a given subscription
468 as well as the number of issues registered in the database (all types)
469 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
475 my ($subscriptionid) = @_;
476 my $dbh = C4::Context->dbh;
481 # status = 2 is "arrived"
485 WHERE subscriptionid = ? AND status NOT IN (2,4,5)
487 my $sth=$dbh->prepare($query);
488 $sth->execute($subscriptionid);
489 while(my $line = $sth->fetchrow_hashref) {
490 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
491 $line->{"publisheddate"} = format_date($line->{"publisheddate"});
492 $line->{"planneddate"} = format_date($line->{"planneddate"});
495 # OK, now add the last 5 issues arrived/missing
499 WHERE subscriptionid = ?
500 AND (status in (2,4,5))
501 ORDER BY serialid DESC
503 my $sth=$dbh->prepare($query);
504 $sth->execute($subscriptionid);
505 while((my $line = $sth->fetchrow_hashref) && $counter <5) {
507 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
508 $line->{"planneddate"} = format_date($line->{"planneddate"});
509 $line->{"publisheddate"} = format_date($line->{"publisheddate"});
515 WHERE subscriptionid=?
517 $sth=$dbh->prepare($query);
518 $sth->execute($subscriptionid);
519 my ($totalissues) = $sth->fetchrow;
520 return ($totalissues,@serials);
523 =head2 GetLatestSerials
527 \@serials = GetLatestSerials($subscriptionid,$limit)
528 get the $limit's latest serials arrived or missing for a given subscription
530 a ref to a table which it containts all of the latest serials stored into a hash.
535 sub GetLatestSerials {
536 my ($subscriptionid,$limit) = @_;
537 my $dbh = C4::Context->dbh;
538 # status = 2 is "arrived"
540 SELECT serialid,serialseq, status, planneddate
542 WHERE subscriptionid = ?
543 AND (status =2 or status=4)
544 ORDER BY planneddate DESC LIMIT 0,$limit
546 my $sth=$dbh->prepare($strsth);
547 $sth->execute($subscriptionid);
549 while(my $line = $sth->fetchrow_hashref) {
550 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
551 $line->{"planneddate"} = format_date($line->{"planneddate"});
557 # WHERE subscriptionid=?
559 # $sth=$dbh->prepare($query);
560 # $sth->execute($subscriptionid);
561 # my ($totalissues) = $sth->fetchrow;
565 =head2 GetDistributedTo
569 $distributedto=GetDistributedTo($subscriptionid)
570 This function select the old previous value of distributedto in the database.
575 sub GetDistributedTo {
576 my $dbh = C4::Context->dbh;
578 my $subscriptionid = @_;
582 WHERE subscriptionid=?
584 my $sth = $dbh->prepare($query);
585 $sth->execute($subscriptionid);
586 return ($distributedto) = $sth->fetchrow;
594 $val is a hashref containing all the attributes of the table 'subscription'
595 This function get the next issue for the subscription given on input arg
597 all the input params updated.
604 my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
605 $calculated = $val->{numberingmethod};
606 # calculate the (expected) value of the next issue received.
607 $newlastvalue1 = $val->{lastvalue1};
608 # check if we have to increase the new value.
609 $newinnerloop1 = $val->{innerloop1}+1;
610 $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
611 $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
612 $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
613 $calculated =~ s/\{X\}/$newlastvalue1/g;
615 $newlastvalue2 = $val->{lastvalue2};
616 # check if we have to increase the new value.
617 $newinnerloop2 = $val->{innerloop2}+1;
618 $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
619 $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
620 $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
621 $calculated =~ s/\{Y\}/$newlastvalue2/g;
623 $newlastvalue3 = $val->{lastvalue3};
624 # check if we have to increase the new value.
625 $newinnerloop3 = $val->{innerloop3}+1;
626 $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
627 $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
628 $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
629 $calculated =~ s/\{Z\}/$newlastvalue3/g;
630 return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
634 sub New_Get_Next_Seq {
636 my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
637 my $pattern = $val->{numberpattern};
638 my @seasons = ('nothing','Winter','Spring','Summer','Autumn');
639 my @southern_seasons = ('','Summer','Autumn','Winter','Spring');
640 $calculated = $val->{numberingmethod};
641 $newlastvalue1 = $val->{lastvalue1};
642 $newlastvalue2 = $val->{lastvalue2};
643 $newlastvalue3 = $val->{lastvalue3};
644 if($newlastvalue3 > 0){ # if x y and z columns are used
645 $newlastvalue3 = $newlastvalue3+1;
646 if($newlastvalue3 > $val->{whenmorethan3}){
647 $newlastvalue3 = $val->{setto3};
649 if($newlastvalue2 > $val->{whenmorethan2}){
651 $newlastvalue2 = $val->{setto2};
654 $calculated =~ s/\{X\}/$newlastvalue1/g;
656 if($val->{hemisphere} == 2){
657 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
658 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
660 my $newlastvalue2seq = $seasons[$newlastvalue2];
661 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
664 $calculated =~ s/\{Y\}/$newlastvalue2/g;
666 $calculated =~ s/\{Z\}/$newlastvalue3/g;
668 if($newlastvalue2 > 0 && $newlastvalue3 < 1){ # if x and y columns are used
669 $newlastvalue2 = $newlastvalue2+1;
670 if($newlastvalue2 > $val->{whenmorethan2}){
671 $newlastvalue2 = $val->{setto2};
674 $calculated =~ s/\{X\}/$newlastvalue1/g;
676 if($val->{hemisphere} == 2){
677 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
678 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
680 my $newlastvalue2seq = $seasons[$newlastvalue2];
681 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
684 $calculated =~ s/\{Y\}/$newlastvalue2/g;
687 if($newlastvalue1 > 0 && $newlastvalue2 < 1 && $newlastvalue3 < 1){ # if column x only
688 $newlastvalue1 = $newlastvalue1+1;
689 if($newlastvalue1 > $val->{whenmorethan1}){
690 $newlastvalue1 = $val->{setto2};
692 $calculated =~ s/\{X\}/$newlastvalue1/g;
694 return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3);
702 $resultdate = GetNextDate($planneddate,$subscription)
704 this function get the date after $planneddate.
706 the date on ISO format.
712 my ($planneddate,$subscription) = @_;
715 if ($subscription->{periodicity} == 1) {
716 $duration=get_duration("1 days");
718 if ($subscription->{periodicity} == 2) {
719 $duration=get_duration("1 weeks");
721 if ($subscription->{periodicity} == 3) {
722 $duration=get_duration("2 weeks");
724 if ($subscription->{periodicity} == 4) {
725 $duration=get_duration("3 weeks");
727 if ($subscription->{periodicity} == 5) {
728 $duration=get_duration("1 months");
730 if ($subscription->{periodicity} == 6) {
731 $duration=get_duration("2 months");
733 if ($subscription->{periodicity} == 7 || $subscription->{periodicity} == 8) {
734 $duration=get_duration("3 months");
737 if ($subscription->{periodicity} == 9) {
738 $duration=get_duration("6 months");
740 if ($subscription->{periodicity} == 10) {
741 $duration=get_duration("1 years");
743 if ($subscription->{periodicity} == 11) {
744 $duration=get_duration("2 years");
746 $resultdate=DATE_Add_Duration($planneddate,$duration);
754 $calculated = GetSeq($val)
755 $val is a hashref containing all the attributes of the table 'subscription'
756 this function transforms {X},{Y},{Z} to 150,0,0 for example.
758 the sequence in integer format
765 my $calculated = $val->{numberingmethod};
766 my $x=$val->{'lastvalue1'};
767 $calculated =~ s/\{X\}/$x/g;
768 my $y=$val->{'lastvalue2'};
769 $calculated =~ s/\{Y\}/$y/g;
770 my $z=$val->{'lastvalue3'};
771 $calculated =~ s/\{Z\}/$z/g;
775 =head2 GetSubscriptionExpirationDate
779 $sensddate = GetSubscriptionExpirationDate($subscriptionid)
781 this function return the expiration date for a subscription given on input args.
789 sub GetSubscriptionExpirationDate {
790 my ($subscriptionid) = @_;
791 my $dbh = C4::Context->dbh;
792 my $subscription = GetSubscription($subscriptionid);
793 my $enddate=$subscription->{startdate};
794 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
795 if ($subscription->{numberlength}) {
796 #calculate the date of the last issue.
797 for (my $i=1;$i<=$subscription->{numberlength};$i++) {
798 $enddate = GetNextDate($enddate,$subscription);
802 my $duration=get_duration($subscription->{monthlength}." months") if ($subscription->{monthlength});
803 my $duration=get_duration($subscription->{weeklength}." weeks") if ($subscription->{weeklength});
805 $enddate = DATE_Add_Duration($subscription->{startdate},$duration) ;
810 =head2 CountSubscriptionFromBiblionumber
814 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
815 this count the number of subscription for a biblionumber given.
817 the number of subscriptions with biblionumber given on input arg.
822 sub CountSubscriptionFromBiblionumber {
823 my ($biblionumber) = @_;
824 my $dbh = C4::Context->dbh;
830 my $sth = $dbh->prepare($query);
831 $sth->execute($biblionumber);
832 my $subscriptionsnumber = $sth->fetchrow;
833 return $subscriptionsnumber;
837 =head2 ModSubscriptionHistory
841 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$receivedlist,$missinglist,$opacnote,$librariannote);
843 this function modify the history of a subscription. Put your new values on input arg.
848 sub ModSubscriptionHistory {
849 my ($subscriptionid,$histstartdate,$enddate,$receivedlist,$missinglist,$opacnote,$librariannote)=@_;
850 my $dbh=C4::Context->dbh;
852 UPDATE subscriptionhistory
853 SET histstartdate=?,enddate=?,receivedlist=?,missinglist=?,opacnote=?,librariannote=?
854 WHERE subscriptionid=?
856 my $sth = $dbh->prepare($query);
857 $receivedlist =~ s/^,//g;
858 $missinglist =~ s/^,//g;
859 $opacnote =~ s/^,//g;
860 $sth->execute($histstartdate,$enddate,$receivedlist,$missinglist,$opacnote,$librariannote,$subscriptionid);
863 =head2 ModSerialStatus
867 ModSerialStatus($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes)
869 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
870 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
875 sub ModSerialStatus {
876 my ($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes,$itemnumber)=@_;
878 # 1st, get previous status :
879 my $dbh = C4::Context->dbh;
881 SELECT subscriptionid,status
885 my $sth = $dbh->prepare($query);
886 $sth->execute($serialid);
887 my ($subscriptionid,$oldstatus) = $sth->fetchrow;
888 # change status & update subscriptionhistory
890 DelIssue($serialseq, $subscriptionid)
894 SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=?,itemnumber=?
897 $sth = $dbh->prepare($query);
898 $sth->execute($serialseq,format_date_in_iso($publisheddate),format_date_in_iso($planneddate),$status,$notes,$itemnumber,$serialid);
900 SELECT missinglist,receivedlist
901 FROM subscriptionhistory
902 WHERE subscriptionid=?
904 $sth = $dbh->prepare($query);
905 $sth->execute($subscriptionid);
906 my ($missinglist,$receivedlist) = $sth->fetchrow;
907 if ($status == 2 && $oldstatus != 2) {
908 $receivedlist .= ",$serialseq";
910 $missinglist .= ",$serialseq" if ($status eq 4) ;
911 $missinglist .= ",not issued $serialseq" if ($status eq 5);
913 UPDATE subscriptionhistory
914 SET receivedlist=?, missinglist=?
915 WHERE subscriptionid=?
917 $sth=$dbh->prepare($query);
918 $sth->execute($receivedlist,$missinglist,$subscriptionid);
920 # create new waited entry if needed (ie : was a "waited" and has changed)
921 if ($oldstatus eq 1 && $status ne 1) {
925 WHERE subscriptionid = ?
927 $sth = $dbh->prepare($query);
928 $sth->execute($subscriptionid);
929 my $val = $sth->fetchrow_hashref;
931 my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3) = GetNextSeq($val);
932 # next date (calculated from actual date & frequency parameters)
933 my $nextplanneddate = Get_Next_Date($planneddate,$val);
934 my $nextpublisheddate = Get_Next_Date($publisheddate,$val);
935 NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextpublisheddate,$nextplanneddate,0);
938 SET lastvalue1=?, lastvalue2=?, lastvalue3=?,
939 innerloop1=?, innerloop2=?, innerloop3=?
940 WHERE subscriptionid = ?
942 $sth = $dbh->prepare($query);
943 $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3,$subscriptionid);
947 =head2 ModSubscription
951 this function modify a subscription. Put all new values on input args.
956 sub ModSubscription {
957 my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
958 $periodicity,$dow,$numberlength,$weeklength,$monthlength,
959 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
960 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
961 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
962 $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid,$irregularity,$hemisphere,$callnumber,$numberpattern,$publisheddate)= @_;
963 my $dbh = C4::Context->dbh;
966 SET librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
967 periodicity=?,dow=?,numberlength=?,weeklength=?,monthlength=?,
968 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
969 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
970 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
971 numberingmethod=?, status=?, biblionumber=?, notes=?, letter=?,irregularity=?,hemisphere=?,callnumber=?,numberpattern=? ,publisheddate=?
972 WHERE subscriptionid = ?
974 my $sth=$dbh->prepare($query);
975 $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
976 $periodicity,$dow,$numberlength,$weeklength,$monthlength,
977 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
978 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
979 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
980 $numberingmethod, $status, $biblionumber, $notes, $letter, $irregularity,$hemisphere,$callnumber,$numberpattern,$publisheddate,$subscriptionid);
985 =head2 NewSubscription
989 $subscriptionid = &NewSubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
990 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
991 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
992 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
993 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
994 $numberingmethod, $status, $notes)
996 Create a new subscription with value given on input args.
999 the id of this new subscription
1004 sub NewSubscription {
1005 my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1006 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1007 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1008 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1009 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1010 $numberingmethod, $status, $notes, $letter,$irregularity,$hemisphere,$callnumber,$numberpattern,$publisheddate) = @_;
1012 my $dbh = C4::Context->dbh;
1013 #save subscription (insert into database)
1015 INSERT INTO subscription
1016 (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
1017 startdate,periodicity,dow,numberlength,weeklength,monthlength,
1018 add1,every1,whenmorethan1,setto1,lastvalue1,
1019 add2,every2,whenmorethan2,setto2,lastvalue2,
1020 add3,every3,whenmorethan3,setto3,lastvalue3,
1021 numberingmethod, status, notes, letter,irregularity,hemisphere,callnumber,numberpattern,publisheddate)
1022 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1024 my $sth=$dbh->prepare($query);
1026 $auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1027 format_date_in_iso($startdate),$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1028 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1029 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1030 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1031 $numberingmethod, $status, $notes, $letter,$irregularity,$hemisphere,$callnumber,$numberpattern,format_date_in_iso($publisheddate));
1034 #then create the 1st waited number
1035 my $subscriptionid = $dbh->{'mysql_insertid'};
1036 my $enddate = GetSubscriptionExpirationDate($subscriptionid);
1038 INSERT INTO subscriptionhistory
1039 (biblionumber, subscriptionid, histstartdate, enddate, missinglist, receivedlist, opacnote, librariannote)
1040 VALUES (?,?,?,?,?,?,?,?)
1042 $sth = $dbh->prepare($query);
1043 $sth->execute($biblionumber, $subscriptionid, format_date_in_iso($startdate), format_date_in_iso($enddate), "", "", "", $notes);
1044 ## User may have subscriptionid stored in MARC so check and fill it
1045 my $record=XMLgetbiblio($dbh,$biblionumber);
1046 $record=XML_xml2hash_onerecord($record);
1047 XML_writeline( $record, "subscriptionid", $subscriptionid,"biblios" );
1048 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
1049 NEWmodbiblio($dbh,$biblionumber,$record,$frameworkcode);
1050 # reread subscription to get a hash (for calculation of the 1st issue number)
1054 WHERE subscriptionid = ?
1056 $sth = $dbh->prepare($query);
1057 $sth->execute($subscriptionid);
1058 my $val = $sth->fetchrow_hashref;
1060 # calculate issue number
1061 my $serialseq = GetSeq($val);
1064 (serialseq,subscriptionid,biblionumber,status, planneddate,publisheddate)
1065 VALUES (?,?,?,?,?,?)
1068 $sth = $dbh->prepare($query);
1069 $sth->execute($serialseq, $subscriptionid, $val->{'biblionumber'}, 1, format_date_in_iso($startdate),format_date_in_iso($publisheddate));
1070 return $subscriptionid;
1074 =head2 ReNewSubscription
1078 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1080 this function renew a subscription with values given on input args.
1085 sub ReNewSubscription {
1086 my ($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note) = @_;
1087 my $dbh = C4::Context->dbh;
1088 my $subscription = GetSubscription($subscriptionid);
1089 my $record=XMLgetbiblio($dbh,$subscription->{biblionumber});
1090 $record=XML_xml2hash_onerecord($record);
1091 my $biblio = XMLmarc2koha_onerecord($dbh,$record,"biblios");
1092 NewSuggestion($user,$subscription->{bibliotitle},$biblio->{author},$biblio->{publishercode},$biblio->{note},'','','','','',$subscription->{biblionumber});
1093 # renew subscription
1096 SET startdate=?,numberlength=?,weeklength=?,monthlength=?
1097 WHERE subscriptionid=?
1099 my $sth=$dbh->prepare($query);
1100 $sth->execute(format_date_in_iso($startdate),$numberlength,$weeklength,$monthlength, $subscriptionid);
1108 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate)
1110 Create a new issue stored on the database.
1111 Note : we have to update the receivedlist and missinglist on subscriptionhistory for this subscription.
1117 my ($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate,$itemnumber) = @_;
1118 my $dbh = C4::Context->dbh;
1121 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,itemnumber)
1122 VALUES (?,?,?,?,?,?,?)
1124 my $sth = $dbh->prepare($query);
1125 $sth->execute($serialseq,$subscriptionid,$biblionumber,$status,format_date_in_iso($publisheddate), format_date_in_iso($planneddate),$itemnumber);
1128 SELECT missinglist,receivedlist
1129 FROM subscriptionhistory
1130 WHERE subscriptionid=?
1132 $sth = $dbh->prepare($query);
1133 $sth->execute($subscriptionid);
1134 my ($missinglist,$receivedlist) = $sth->fetchrow;
1136 $receivedlist .= ",$serialseq";
1139 $missinglist .= ",$serialseq";
1142 UPDATE subscriptionhistory
1143 SET receivedlist=?, missinglist=?
1144 WHERE subscriptionid=?
1146 $sth=$dbh->prepare($query);
1147 $sth->execute($receivedlist,$missinglist,$subscriptionid);
1150 =head2 serialchangestatus
1154 serialchangestatus($serialid,$serialseq,$planneddate,$status,$notes)
1156 Change the status of a serial issue.
1157 Note: this was the older subroutine
1162 sub serialchangestatus {
1163 my ($serialid,$serialseq,$planneddate,$status,$notes)=@_;
1164 # 1st, get previous status : if we change from "waited" to something else, then we will have to create a new "waited" entry
1165 my $dbh = C4::Context->dbh;
1166 my $sth = $dbh->prepare("select subscriptionid,status from serial where serialid=?");
1167 $sth->execute($serialid);
1168 my ($subscriptionid,$oldstatus) = $sth->fetchrow;
1169 # change status & update subscriptionhistory
1171 delissue($serialseq, $subscriptionid)
1173 $sth = $dbh->prepare("update serial set serialseq=?,planneddate=?,status=?,notes=? where serialid = ?");
1174 $sth->execute($serialseq,format_date_in_iso($planneddate),$status,$notes,$serialid);
1176 $sth = $dbh->prepare("select missinglist,receivedlist from subscriptionhistory where subscriptionid=?");
1177 $sth->execute($subscriptionid);
1178 my ($missinglist,$receivedlist) = $sth->fetchrow;
1180 $receivedlist .= "| $serialseq";
1181 $receivedlist =~ s/^\| //g;
1183 $missinglist .= "| $serialseq" if ($status eq 4) ;
1184 $missinglist .= "| not issued $serialseq" if ($status eq 5);
1185 $missinglist =~ s/^\| //g;
1186 $sth=$dbh->prepare("update subscriptionhistory set receivedlist=?, missinglist=? where subscriptionid=?");
1187 $sth->execute($receivedlist,$missinglist,$subscriptionid);
1189 # create new waited entry if needed (ie : was a "waited" and has changed)
1190 if ($oldstatus eq 1 && $status ne 1) {
1191 $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1192 $sth->execute($subscriptionid);
1193 my $val = $sth->fetchrow_hashref;
1195 my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3) = New_Get_Next_Seq($val);
1196 my $nextplanneddate = Get_Next_Date($planneddate,$val);
1197 NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextplanneddate);
1198 $sth = $dbh->prepare("update subscription set lastvalue1=?, lastvalue2=?,lastvalue3=? where subscriptionid = ?");
1199 $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$subscriptionid);
1201 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1202 $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1203 $sth->execute($subscriptionid);
1204 my $subscription = $sth->fetchrow_hashref;
1205 if ($subscription->{letter} && $status eq 2) {
1206 sendalerts('issue',$subscription->{subscriptionid},$subscription->{letter});
1213 =head2 HasSubscriptionExpired
1217 1 or 0 = HasSubscriptionExpired($subscriptionid)
1219 the subscription has expired when the next issue to arrive is out of subscription limit.
1222 1 if true, 0 if false.
1227 sub HasSubscriptionExpired {
1228 my ($subscriptionid) = @_;
1229 my $dbh = C4::Context->dbh;
1230 my $subscription = GetSubscription($subscriptionid);
1231 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1232 if ($subscription->{numberlength} ) {
1236 WHERE subscriptionid=? AND planneddate>=?
1238 my $sth = $dbh->prepare($query);
1239 $sth->execute($subscriptionid,$subscription->{startdate});
1240 my $res = $sth->fetchrow;
1241 if ($subscription->{numberlength}>=$res) {
1247 #a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
1249 SELECT max(planneddate)
1251 WHERE subscriptionid=?
1253 my $sth = $dbh->prepare($query);
1254 $sth->execute($subscriptionid);
1255 my $res = $sth->fetchrow;
1256 my $endofsubscriptiondate;
1257 my $duration=get_duration($subscription->{monthlength}." months") if ($subscription->{monthlength});
1258 my $duration=get_duration($subscription->{weeklength}." weeks") if ($subscription->{weeklength});
1260 $endofsubscriptiondate = DATE_Add_Duration($subscription->{startdate},$duration) ;
1261 return 1 if ($res >= $endofsubscriptiondate);
1266 =head2 SetDistributedto
1270 SetDistributedto($distributedto,$subscriptionid);
1271 This function update the value of distributedto for a subscription given on input arg.
1276 sub SetDistributedto {
1277 my ($distributedto,$subscriptionid) = @_;
1278 my $dbh = C4::Context->dbh;
1282 WHERE subscriptionid=?
1284 my $sth = $dbh->prepare($query);
1285 $sth->execute($distributedto,$subscriptionid);
1288 =head2 DelSubscription
1292 DelSubscription($subscriptionid)
1293 this function delete the subscription which has $subscriptionid as id.
1298 sub DelSubscription {
1299 my ($subscriptionid,$biblionumber) = @_;
1300 my $dbh = C4::Context->dbh;
1301 ## User may have subscriptionid stored in MARC so check and remove it
1302 my $record=XMLgetbibliohash($dbh,$biblionumber);
1303 XML_writeline( $record, "subscriptionid", "","biblios" );
1304 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
1305 NEWmodbiblio($dbh,$biblionumber,$record,$frameworkcode);
1306 $subscriptionid=$dbh->quote($subscriptionid);
1307 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1308 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1309 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1317 DelIssue($serialseq,$subscriptionid)
1318 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1324 my ($serialseq,$subscriptionid) = @_;
1325 my $dbh = C4::Context->dbh;
1329 AND subscriptionid= ?
1331 my $sth = $dbh->prepare($query);
1332 $sth->execute($serialseq,$subscriptionid);
1335 =head2 GetMissingIssues
1339 ($count,@issuelist) = &GetMissingIssues($supplierid,$serialid)
1341 this function select missing issues on database - where serial.status = 4
1344 a count of the number of missing issues
1345 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1346 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1351 sub GetMissingIssues {
1352 my ($supplierid,$serialid) = @_;
1353 my $dbh = C4::Context->dbh;
1357 $byserial = "and serialid = ".$serialid;
1360 $sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
1361 FROM subscription, serial, biblio
1362 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1363 WHERE subscription.subscriptionid = serial.subscriptionid AND
1364 serial.STATUS = 4 and
1365 subscription.aqbooksellerid=$supplierid and
1366 biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
1369 $sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
1370 FROM subscription, serial, biblio
1371 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1372 WHERE subscription.subscriptionid = serial.subscriptionid AND
1373 serial.STATUS =4 and
1374 biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
1382 while (my $line = $sth->fetchrow_hashref) {
1383 $odd++ unless $line->{title} eq $last_title;
1384 $last_title = $line->{title} if ($line->{title});
1385 $line->{planneddate} = format_date($line->{planneddate});
1386 $line->{claimdate} = format_date($line->{claimdate});
1387 $line->{'odd'} = 1 if $odd %2 ;
1389 push @issuelist,$line;
1391 return $count,@issuelist;
1394 =head2 removeMissingIssue
1398 removeMissingIssue($subscriptionid)
1400 this function removes an issue from being part of the missing string in
1401 subscriptionlist.missinglist column
1403 called when a missing issue is found from the statecollection.pl file
1408 sub removeMissingIssue {
1409 my ($sequence,$subscriptionid) = @_;
1410 my $dbh = C4::Context->dbh;
1411 my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1412 $sth->execute($subscriptionid);
1413 my $data = $sth->fetchrow_hashref;
1414 my $missinglist = $data->{'missinglist'};
1415 my $missinglistbefore = $missinglist;
1416 # warn $missinglist." before";
1417 $missinglist =~ s/($sequence)//;
1418 # warn $missinglist." after";
1419 if($missinglist ne $missinglistbefore){
1420 $missinglist =~ s/\|\s\|/\|/g;
1421 $missinglist =~ s/^\| //g;
1422 $missinglist =~ s/\|$//g;
1423 my $sth2= $dbh->prepare("UPDATE subscriptionhistory
1425 WHERE subscriptionid = ?");
1426 $sth2->execute($missinglist,$subscriptionid);
1434 &updateClaim($serialid)
1436 this function updates the time when a claim is issued for late/missing items
1438 called from claims.pl file
1444 my ($serialid) = @_;
1445 my $dbh = C4::Context->dbh;
1446 my $sth = $dbh->prepare("UPDATE serial SET claimdate = now()
1449 $sth->execute($serialid);
1452 =head2 getsupplierbyserialid
1456 ($result) = &getsupplierbyserialid($serialid)
1458 this function is used to find the supplier id given a serial id
1461 hashref containing serialid, subscriptionid, and aqbooksellerid
1466 sub getsupplierbyserialid {
1467 my ($serialid) = @_;
1468 my $dbh = C4::Context->dbh;
1469 my $sth = $dbh->prepare("SELECT serialid, serial.subscriptionid, aqbooksellerid
1470 FROM serial, subscription
1471 WHERE serial.subscriptionid = subscription.subscriptionid
1474 $sth->execute($serialid);
1475 my $line = $sth->fetchrow_hashref;
1476 my $result = $line->{'aqbooksellerid'};
1480 =head2 check_routing
1484 ($result) = &check_routing($subscriptionid)
1486 this function checks to see if a serial has a routing list and returns the count of routingid
1487 used to show either an 'add' or 'edit' link
1492 my ($subscriptionid) = @_;
1493 my $dbh = C4::Context->dbh;
1494 my $sth = $dbh->prepare("SELECT count(routingid) routingids FROM subscriptionroutinglist, subscription
1495 WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1496 AND subscription.subscriptionid = ? ORDER BY ranking ASC
1498 $sth->execute($subscriptionid);
1499 my $line = $sth->fetchrow_hashref;
1500 my $result = $line->{'routingids'};
1504 =head2 addroutingmember
1508 &addroutingmember($bornum,$subscriptionid)
1510 this function takes a borrowernumber and subscriptionid and add the member to the
1511 routing list for that serial subscription and gives them a rank on the list
1512 of either 1 or highest current rank + 1
1517 sub addroutingmember {
1518 my ($bornum,$subscriptionid) = @_;
1520 my $dbh = C4::Context->dbh;
1521 my $sth = $dbh->prepare("SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?");
1522 $sth->execute($subscriptionid);
1523 while(my $line = $sth->fetchrow_hashref){
1524 if($line->{'rank'}>0){
1525 $rank = $line->{'rank'}+1;
1530 $sth = $dbh->prepare("INSERT INTO subscriptionroutinglist VALUES (null,?,?,?,null)");
1531 $sth->execute($subscriptionid,$bornum,$rank);
1534 =head2 reorder_members
1538 &reorder_members($subscriptionid,$routingid,$rank)
1540 this function is used to reorder the routing list
1542 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1543 - it gets all members on list puts their routingid's into an array
1544 - removes the one in the array that is $routingid
1545 - then reinjects $routingid at point indicated by $rank
1546 - then update the database with the routingids in the new order
1551 sub reorder_members {
1552 my ($subscriptionid,$routingid,$rank) = @_;
1553 my $dbh = C4::Context->dbh;
1554 my $sth = $dbh->prepare("SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC");
1555 $sth->execute($subscriptionid);
1557 while(my $line = $sth->fetchrow_hashref){
1558 push(@result,$line->{'routingid'});
1560 # To find the matching index
1562 my $key = -1; # to allow for 0 being a valid response
1563 for ($i = 0; $i < @result; $i++) {
1564 if ($routingid == $result[$i]) {
1565 $key = $i; # save the index
1569 # if index exists in array then move it to new position
1570 if($key > -1 && $rank > 0){
1571 my $new_rank = $rank-1; # $new_rank is what you want the new index to be in the array
1572 my $moving_item = splice(@result, $key, 1);
1573 splice(@result, $new_rank, 0, $moving_item);
1575 for(my $j = 0; $j < @result; $j++){
1576 my $sth = $dbh->prepare("UPDATE subscriptionroutinglist SET ranking = '" . ($j+1) . "' WHERE routingid = '". $result[$j]."'");
1581 =head2 delroutingmember
1585 &delroutingmember($routingid,$subscriptionid)
1587 this function either deletes one member from routing list if $routingid exists otherwise
1588 deletes all members from the routing list
1593 sub delroutingmember {
1594 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
1595 my ($routingid,$subscriptionid) = @_;
1596 my $dbh = C4::Context->dbh;
1598 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
1599 $sth->execute($routingid);
1600 reorder_members($subscriptionid,$routingid);
1602 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
1603 $sth->execute($subscriptionid);
1607 =head2 getroutinglist
1611 ($count,@routinglist) = &getroutinglist($subscriptionid)
1613 this gets the info from the subscriptionroutinglist for $subscriptionid
1616 a count of the number of members on routinglist
1617 the routinglist into a table. Each line of this table containts a ref to a hash which containts
1618 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
1623 sub getroutinglist {
1624 my ($subscriptionid) = @_;
1625 my $dbh = C4::Context->dbh;
1626 my $sth = $dbh->prepare("SELECT routingid, borrowernumber,
1627 ranking, biblionumber FROM subscriptionroutinglist, subscription
1628 WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1629 AND subscription.subscriptionid = ? ORDER BY ranking ASC
1631 $sth->execute($subscriptionid);
1634 while (my $line = $sth->fetchrow_hashref) {
1636 push(@routinglist,$line);
1638 return ($count,@routinglist);
1641 =head2 abouttoexpire
1645 $result = &abouttoexpire($subscriptionid)
1647 this function alerts you to the penultimate issue for a serial subscription
1649 returns 1 - if this is the penultimate issue
1657 my ($subscriptionid) = @_;
1658 my $dbh = C4::Context->dbh;
1659 my $subscription = GetSubscription($subscriptionid);
1660 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1661 if ($subscription->{numberlength}) {
1662 my $sth = $dbh->prepare("select count(*) from serial where subscriptionid=? and planneddate>=?");
1663 $sth->execute($subscriptionid,$subscription->{startdate});
1664 my $res = $sth->fetchrow;
1665 # warn "length: ".$subscription->{numberlength}." vs count: ".$res;
1666 if ($subscription->{numberlength}==$res) {
1672 # a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
1673 my $sth = $dbh->prepare("select max(planneddate) from serial where subscriptionid=?");
1674 $sth->execute($subscriptionid);
1675 my $res = $sth->fetchrow;
1676 my $endofsubscriptiondate;
1677 my $duration=get_duration($subscription->{monthlength}." months") if ($subscription->{monthlength});
1678 my $duration=get_duration($subscription->{weeklength}." weeks") if ($subscription->{weeklength});
1680 $endofsubscriptiondate = DATE_Add_Duration($subscription->{startdate},$duration) ;
1681 my $per = $subscription->{'periodicity'};
1683 if ($per == 1) { $x = '1 days'; }
1684 if ($per == 2) { $x = '1 weeks'; }
1685 if ($per == 3) { $x = '2 weeks'; }
1686 if ($per == 4) { $x = '3 weeks'; }
1687 if ($per == 5) { $x = '1 months'; }
1688 if ($per == 6) { $x = '2 months'; }
1689 if ($per == 7 || $per == 8) { $x = '3 months'; }
1690 if ($per == 9) { $x = '6 months'; }
1691 if ($per == 10) { $x = '1 years'; }
1692 if ($per == 11) { $x = '2 years'; }
1693 my $duration=get_duration("-".$x) ;
1694 my $datebeforeend = DATE_Add_Duration($endofsubscriptiondate,$duration); # if ($subscription->{weeklength});
1695 # warn "DATE BEFORE END: $datebeforeend";
1696 return 1 if ($res >= $datebeforeend && $res < $endofsubscriptiondate);
1703 =head2 Get_Next_Date
1707 ($resultdate) = &Get_Next_Date($planneddate,$subscription)
1709 this function is an extension of GetNextDate which allows for checking for irregularity
1711 it takes the planneddate and will return the next issue's date and will skip dates if there
1712 exists an irregularity
1713 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
1714 skipped then the returned date will be 2007-05-10
1717 $resultdate - then next date in the sequence
1722 sub Get_Next_Date(@) {
1723 my ($planneddate,$subscription) = @_;
1724 my @irreg = split(/\|/,$subscription->{irregularity});
1725 my $dateobj=DATE_obj($planneddate);
1726 my $dayofweek = $dateobj->day_of_week;
1727 my $month=$dateobj->month;
1729 # warn "DOW $dayofweek";
1731 if ($subscription->{periodicity} == 1) {
1732 my $duration=get_duration("1 days");
1733 for(my $i=0;$i<@irreg;$i++){
1734 if($dayofweek == 7){ $dayofweek = 0; }
1736 if(in_array(($dayofweek+1), @irreg)){
1737 $planneddate = DATE_Add_Duration($planneddate,$duration);
1741 $resultdate=DATE_Add_Duration($planneddate,$duration);
1743 if ($subscription->{periodicity} == 2) {
1744 my $wkno = $dateobj->week_number;
1745 my $duration=get_duration("1 weeks");
1746 for(my $i = 0;$i < @irreg; $i++){
1747 if($wkno > 52) { $wkno = 0; } # need to rollover at January
1748 if($irreg[$i] == ($wkno+1)){
1749 $planneddate = DATE_Add_Duration($planneddate,$duration);
1753 $resultdate=DATE_Add_Duration($planneddate,$duration);
1755 if ($subscription->{periodicity} == 3) {
1756 my $wkno = $dateobj->week_number;
1757 my $duration=get_duration("2 weeks");
1758 for(my $i = 0;$i < @irreg; $i++){
1759 if($wkno > 52) { $wkno = 0; } # need to rollover at January
1760 if($irreg[$i] == ($wkno+1)){
1761 $planneddate = DATE_Add_Duration($planneddate,$duration);
1765 $resultdate=DATE_Add_Duration($planneddate,$duration);
1767 if ($subscription->{periodicity} == 4) {
1768 my $wkno = $dateobj->week_number;
1769 my $duration=get_duration("3 weeks");
1770 for(my $i = 0;$i < @irreg; $i++){
1771 if($wkno > 52) { $wkno = 0; } # need to rollover at January
1772 if($irreg[$i] == ($wkno+1)){
1773 $planneddate = DATE_Add_Duration($planneddate,$duration);
1777 $resultdate=DATE_Add_Duration($planneddate,$duration);
1779 if ($subscription->{periodicity} == 5) {
1780 my $duration=get_duration("1 months");
1781 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 = DATE_Add_Duration($planneddate,$duration);
1787 $month++; # to check if following ones are to be skipped too
1790 $resultdate=DATE_Add_Duration($planneddate,$duration);
1791 # warn "Planneddate2: $planneddate";
1793 if ($subscription->{periodicity} == 6) {
1794 my $duration=get_duration("2 months");
1795 for(my $i = 0;$i < @irreg; $i++){
1798 if($month == 12) { $month = 0; } # need to rollover to check January
1799 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1800 $planneddate = DATE_Add_Duration($planneddate,$duration);
1801 $month++; # to check if following ones are to be skipped too
1804 $resultdate=DATE_Add_Duration($planneddate,$duration);
1806 if ($subscription->{periodicity} == 7 || $subscription->{periodicity} == 8 ) {
1807 my $duration=get_duration("3 months");
1808 for(my $i = 0;$i < @irreg; $i++){
1811 if($month == 12) { $month = 0; } # need to rollover to check January
1812 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1813 $planneddate = DATE_Add_Duration($planneddate,$duration);
1814 $month++; # to check if following ones are to be skipped too
1817 $resultdate=DATE_Add_Duration($planneddate,$duration);
1820 if ($subscription->{periodicity} == 9) {
1821 my $duration=get_duration("6 months");
1822 for(my $i = 0;$i < @irreg; $i++){
1825 if($month == 12) { $month = 0; } # need to rollover to check January
1826 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1827 $planneddate = DATE_Add_Duration($planneddate,$duration);
1828 $month++; # to check if following ones are to be skipped too
1831 $resultdate=DATE_Add_Duration($planneddate,$duration);
1833 if ($subscription->{periodicity} == 10) {
1834 my $duration=get_duration("1 years");
1835 $resultdate=DATE_Add_Duration($planneddate,$duration);
1837 if ($subscription->{periodicity} == 11) {
1838 my $duration=get_duration("2 years");
1839 $resultdate=DATE_Add_Duration($planneddate,$duration);
1841 # warn "date: ".$resultdate;
1847 END { } # module clean-up code here (global destructor)