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 &ItemizeSerials
58 &GetSerials &GetLatestSerials &ModSerialStatus
59 &HasSubscriptionExpired &GetSubscriptionExpirationDate &ReNewSubscription
60 &GetSuppliersWithLateIssues &GetLateIssues &GetMissingIssues
61 &GetDistributedTo &SetDistributedto &serialchangestatus
62 &getroutinglist &delroutingmember &addroutingmember &reorder_members
63 &check_routing &getsupplierbyserialid &updateClaim &removeMissingIssue &abouttoexpire
64 &old_newsubscription &old_modsubscription &old_getserials &Get_Next_Date
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 subcriptionhistory
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 startdate, histstartdate,opacnote,missinglist,recievedlist,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->{startdate} = format_date($subs->{startdate});
279 $subs->{histstartdate} = format_date($subs->{histstartdate});
280 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
281 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
282 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
283 $subs->{"periodicity".$subs->{periodicity}} = 1;
284 $subs->{"status".$subs->{'status'}} = 1;
285 if ($subs->{enddate} eq '0000-00-00') {
288 $subs->{enddate} = format_date($subs->{enddate});
294 =head2 GetFullSubscriptionsFromBiblionumber
298 \@res = GetFullSubscriptionsFromBiblionumber($biblionumber)
299 this function read on serial table.
304 sub GetFullSubscriptionsFromBiblionumber {
305 my ($biblionumber) = @_;
306 my $dbh = C4::Context->dbh;
308 SELECT serial.serialseq,
310 serial.publisheddate,
313 year(serial.publisheddate) AS year,
314 aqbudget.bookfundid,aqbooksellers.name AS aqbooksellername,
315 biblio.title AS bibliotitle
317 LEFT JOIN subscription ON
318 (serial.subscriptionid=subscription.subscriptionid AND subscription.biblionumber=serial.biblionumber)
319 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
320 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
321 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
322 WHERE subscription.biblionumber = ?
323 ORDER BY year,serial.publisheddate,serial.subscriptionid,serial.planneddate
326 my $sth = $dbh->prepare($query);
327 $sth->execute($biblionumber);
331 my $aqbooksellername;
336 while (my $subs = $sth->fetchrow_hashref) {
337 ### BUG To FIX: When there is no published date, will create many null ids!!!
339 if ($year and ($year==$subs->{year})){
340 if ($first eq 1){$first=0;}
341 my $temp=$res[scalar(@res)-1]->{'serials'};
343 {'publisheddate' =>format_date($subs->{'publisheddate'}),
344 'planneddate' => format_date($subs->{'planneddate'}),
345 'serialseq' => $subs->{'serialseq'},
346 "status".$subs->{'status'} => 1,
347 'notes' => $subs->{'notes'} eq $previousnote?"":$subs->{notes},
350 $first=1 if (not $year);
351 $year= $subs->{'year'};
352 $startdate= format_date($subs->{'startdate'});
353 $aqbooksellername= $subs->{'aqbooksellername'};
354 $bibliotitle= $subs->{'bibliotitle'};
357 {'publisheddate' =>format_date($subs->{'publisheddate'}),
358 'planneddate' => format_date($subs->{'planneddate'}),
359 'serialseq' => $subs->{'serialseq'},
360 "status".$subs->{'status'} => 1,
361 'notes' => $subs->{'notes'} eq $previousnote?"":$subs->{notes},
366 'startdate'=>$startdate,
367 'aqbooksellername'=>$aqbooksellername,
368 'bibliotitle'=>$bibliotitle,
373 $previousnote=$subs->{notes};
379 =head2 GetSubscriptions
383 @results = GetSubscriptions($title,$ISSN,$biblionumber);
384 this function get all subscriptions which has title like $title,ISSN like $ISSN and biblionumber like $biblionumber.
386 a table of hashref. Each hash containt the subscription.
391 sub GetSubscriptions {
392 my ($title,$ISSN,$biblionumber) = @_;
393 return unless $title or $ISSN or $biblionumber;
394 my $dbh = C4::Context->dbh;
398 SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber
399 FROM subscription,biblio,biblioitems
400 WHERE biblio.biblionumber = biblioitems.biblionumber
401 AND 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,biblioitems.issn,subscription.notes,biblio.biblionumber
411 FROM subscription,biblio,biblioitems
412 WHERE biblio.biblionumber = biblioitems.biblionumber
413 AND biblio.biblionumber= subscription.biblionumber
414 AND (biblio.title LIKE ? or biblioitems.issn = ?)
417 $sth = $dbh->prepare($query);
418 $sth->execute("%$title%",$ISSN);
423 SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber
424 FROM subscription,biblio,biblioitems
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,biblioitems.issn,subscription.notes,biblio.biblionumber
435 FROM subscription,biblio,biblioitems
436 WHERE biblio.biblionumber = biblioitems.biblionumber
437 AND biblio.biblionumber=subscription.biblionumber
438 AND biblio.title LIKE ?
441 $sth = $dbh->prepare($query);
442 $sth->execute("%$title%");
447 my $previoustitle="";
449 while (my $line = $sth->fetchrow_hashref) {
450 if ($previoustitle eq $line->{title}) {
453 $line->{toggle} = 1 if $odd==1;
455 $previoustitle=$line->{title};
457 $line->{toggle} = 1 if $odd==1;
459 push @results, $line;
468 ($totalissues,@serials) = GetSerials($subscriptionid);
469 this function get every serial not arrived for a given subscription
470 as well as the number of issues registered in the database (all types)
471 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
477 my ($subscriptionid) = @_;
478 my $dbh = C4::Context->dbh;
479 # OK, now add the last 5 issues arrives/missing
481 SELECT serialid,serialseq, status, planneddate,notes
483 WHERE subscriptionid = ?
484 AND (status in (2,4,5))
485 ORDER BY serialid DESC
487 my $sth=$dbh->prepare($query);
488 $sth->execute($subscriptionid);
491 while((my $line = $sth->fetchrow_hashref) && $counter <5) {
493 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
494 $line->{"planneddate"} = format_date($line->{"planneddate"});
497 # status = 2 is "arrived"
499 SELECT serialid,serialseq, status, publisheddate, planneddate,notes
501 WHERE subscriptionid = ? AND status NOT IN (2,4,5)
503 my $sth=$dbh->prepare($query);
504 $sth->execute($subscriptionid);
505 while(my $line = $sth->fetchrow_hashref) {
506 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
507 $line->{"publisheddate"} = format_date($line->{"publisheddate"});
508 $line->{"planneddate"} = format_date($line->{"planneddate"});
514 WHERE subscriptionid=?
516 $sth=$dbh->prepare($query);
517 $sth->execute($subscriptionid);
518 my ($totalissues) = $sth->fetchrow;
519 return ($totalissues,@serials);
522 =head2 GetLatestSerials
526 \@serials = GetLatestSerials($subscriptionid,$limit)
527 get the $limit's latest serials arrived or missing for a given subscription
529 a ref to a table which it containts all of the latest serials stored into a hash.
534 sub GetLatestSerials {
535 my ($subscriptionid,$limit) = @_;
536 my $dbh = C4::Context->dbh;
537 # status = 2 is "arrived"
539 SELECT serialid,serialseq, status, planneddate
541 WHERE subscriptionid = ?
542 AND (status =2 or status=4)
543 ORDER BY planneddate DESC LIMIT 0,$limit
545 my $sth=$dbh->prepare($strsth);
546 $sth->execute($subscriptionid);
548 while(my $line = $sth->fetchrow_hashref) {
549 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
550 $line->{"planneddate"} = format_date($line->{"planneddate"});
556 # WHERE subscriptionid=?
558 # $sth=$dbh->prepare($query);
559 # $sth->execute($subscriptionid);
560 # my ($totalissues) = $sth->fetchrow;
564 =head2 GetDistributedTo
568 $distributedto=GetDistributedTo($subscriptionid)
569 This function select the old previous value of distributedto in the database.
574 sub GetDistributedTo {
575 my $dbh = C4::Context->dbh;
577 my $subscriptionid = @_;
581 WHERE subscriptionid=?
583 my $sth = $dbh->prepare($query);
584 $sth->execute($subscriptionid);
585 return ($distributedto) = $sth->fetchrow;
593 $val is a hashref containing all the attributes of the table 'subscription'
594 This function get the next issue for the subscription given on input arg
596 all the input params updated.
603 my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
604 $calculated = $val->{numberingmethod};
605 # calculate the (expected) value of the next issue recieved.
606 $newlastvalue1 = $val->{lastvalue1};
607 # check if we have to increase the new value.
608 $newinnerloop1 = $val->{innerloop1}+1;
609 $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
610 $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
611 $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
612 $calculated =~ s/\{X\}/$newlastvalue1/g;
614 $newlastvalue2 = $val->{lastvalue2};
615 # check if we have to increase the new value.
616 $newinnerloop2 = $val->{innerloop2}+1;
617 $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
618 $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
619 $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
620 $calculated =~ s/\{Y\}/$newlastvalue2/g;
622 $newlastvalue3 = $val->{lastvalue3};
623 # check if we have to increase the new value.
624 $newinnerloop3 = $val->{innerloop3}+1;
625 $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
626 $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
627 $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
628 $calculated =~ s/\{Z\}/$newlastvalue3/g;
629 return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
633 sub New_Get_Next_Seq {
635 my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
636 my $pattern = $val->{numberpattern};
637 my @seasons = ('nothing','Winter','Spring','Summer','Autumn');
638 my @southern_seasons = ('','Summer','Autumn','Winter','Spring');
639 $calculated = $val->{numberingmethod};
640 $newlastvalue1 = $val->{lastvalue1};
641 $newlastvalue2 = $val->{lastvalue2};
642 $newlastvalue3 = $val->{lastvalue3};
643 if($newlastvalue3 > 0){ # if x y and z columns are used
644 $newlastvalue3 = $newlastvalue3+1;
645 if($newlastvalue3 > $val->{whenmorethan3}){
646 $newlastvalue3 = $val->{setto3};
648 if($newlastvalue2 > $val->{whenmorethan2}){
650 $newlastvalue2 = $val->{setto2};
653 $calculated =~ s/\{X\}/$newlastvalue1/g;
655 if($val->{hemisphere} == 2){
656 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
657 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
659 my $newlastvalue2seq = $seasons[$newlastvalue2];
660 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
663 $calculated =~ s/\{Y\}/$newlastvalue2/g;
665 $calculated =~ s/\{Z\}/$newlastvalue3/g;
667 if($newlastvalue2 > 0 && $newlastvalue3 < 1){ # if x and y columns are used
668 $newlastvalue2 = $newlastvalue2+1;
669 if($newlastvalue2 > $val->{whenmorethan2}){
670 $newlastvalue2 = $val->{setto2};
673 $calculated =~ s/\{X\}/$newlastvalue1/g;
675 if($val->{hemisphere} == 2){
676 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
677 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
679 my $newlastvalue2seq = $seasons[$newlastvalue2];
680 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
683 $calculated =~ s/\{Y\}/$newlastvalue2/g;
686 if($newlastvalue1 > 0 && $newlastvalue2 < 1 && $newlastvalue3 < 1){ # if column x only
687 $newlastvalue1 = $newlastvalue1+1;
688 if($newlastvalue1 > $val->{whenmorethan1}){
689 $newlastvalue1 = $val->{setto2};
691 $calculated =~ s/\{X\}/$newlastvalue1/g;
693 return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3);
701 $resultdate = GetNextDate($planneddate,$subscription)
703 this function get the date after $planneddate.
705 the date on ISO format.
711 my ($planneddate,$subscription) = @_;
713 if ($subscription->{periodicity} == 1) {
714 $resultdate=DateCalc($planneddate,"1 day");
716 if ($subscription->{periodicity} == 2) {
717 $resultdate=DateCalc($planneddate,"1 week");
719 if ($subscription->{periodicity} == 3) {
720 $resultdate=DateCalc($planneddate,"2 weeks");
722 if ($subscription->{periodicity} == 4) {
723 $resultdate=DateCalc($planneddate,"3 weeks");
725 if ($subscription->{periodicity} == 5) {
726 $resultdate=DateCalc($planneddate,"1 month");
728 if ($subscription->{periodicity} == 6) {
729 $resultdate=DateCalc($planneddate,"2 months");
731 if ($subscription->{periodicity} == 7) {
732 $resultdate=DateCalc($planneddate,"3 months");
734 if ($subscription->{periodicity} == 8) {
735 $resultdate=DateCalc($planneddate,"3 months");
737 if ($subscription->{periodicity} == 9) {
738 $resultdate=DateCalc($planneddate,"6 months");
740 if ($subscription->{periodicity} == 10) {
741 $resultdate=DateCalc($planneddate,"1 year");
743 if ($subscription->{periodicity} == 11) {
744 $resultdate=DateCalc($planneddate,"2 years");
746 return format_date_in_iso($resultdate);
753 $calculated = GetSeq($val)
754 $val is a hashref containing all the attributes of the table 'subscription'
755 this function transforms {X},{Y},{Z} to 150,0,0 for example.
757 the sequence in integer format
764 my $calculated = $val->{numberingmethod};
765 my $x=$val->{'lastvalue1'};
766 $calculated =~ s/\{X\}/$x/g;
767 my $y=$val->{'lastvalue2'};
768 $calculated =~ s/\{Y\}/$y/g;
769 my $z=$val->{'lastvalue3'};
770 $calculated =~ s/\{Z\}/$z/g;
774 =head2 GetSubscriptionExpirationDate
778 $sensddate = GetSubscriptionExpirationDate($subscriptionid)
780 this function return the expiration date for a subscription given on input args.
788 sub GetSubscriptionExpirationDate {
789 my ($subscriptionid) = @_;
790 my $dbh = C4::Context->dbh;
791 my $subscription = GetSubscription($subscriptionid);
792 my $enddate=$subscription->{startdate};
793 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
794 if ($subscription->{numberlength}) {
795 #calculate the date of the last issue.
796 for (my $i=1;$i<=$subscription->{numberlength};$i++) {
797 $enddate = GetNextDate($enddate,$subscription);
801 $enddate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
802 $enddate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
807 =head2 CountSubscriptionFromBiblionumber
811 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
812 this count the number of subscription for a biblionumber given.
814 the number of subscriptions with biblionumber given on input arg.
819 sub CountSubscriptionFromBiblionumber {
820 my ($biblionumber) = @_;
821 my $dbh = C4::Context->dbh;
827 my $sth = $dbh->prepare($query);
828 $sth->execute($biblionumber);
829 my $subscriptionsnumber = $sth->fetchrow;
830 return $subscriptionsnumber;
834 =head2 ModSubscriptionHistory
838 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
840 this function modify the history of a subscription. Put your new values on input arg.
845 sub ModSubscriptionHistory {
846 my ($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote)=@_;
847 my $dbh=C4::Context->dbh;
849 UPDATE subscriptionhistory
850 SET histstartdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
851 WHERE subscriptionid=?
853 my $sth = $dbh->prepare($query);
854 $recievedlist =~ s/^,//g;
855 $missinglist =~ s/^,//g;
856 $opacnote =~ s/^,//g;
857 $sth->execute($histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote,$subscriptionid);
860 =head2 ModSerialStatus
864 ModSerialStatus($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes)
866 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
867 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
872 sub ModSerialStatus {
873 my ($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes)=@_;
874 # 1st, get previous status :
875 my $dbh = C4::Context->dbh;
877 SELECT subscriptionid,status
881 my $sth = $dbh->prepare($query);
882 $sth->execute($serialid);
883 my ($subscriptionid,$oldstatus) = $sth->fetchrow;
884 # change status & update subscriptionhistory
886 DelIssue($serialseq, $subscriptionid)
890 SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=?
893 $sth = $dbh->prepare($query);
894 $sth->execute($serialseq,$publisheddate,$planneddate,$status,$notes,$serialid);
896 SELECT missinglist,recievedlist
897 FROM subscriptionhistory
898 WHERE subscriptionid=?
900 $sth = $dbh->prepare($query);
901 $sth->execute($subscriptionid);
902 my ($missinglist,$recievedlist) = $sth->fetchrow;
904 $recievedlist .= ",$serialseq";
906 $missinglist .= ",$serialseq" if ($status eq 4) ;
907 $missinglist .= ",not issued $serialseq" if ($status eq 5);
909 UPDATE subscriptionhistory
910 SET recievedlist=?, missinglist=?
911 WHERE subscriptionid=?
913 $sth=$dbh->prepare($query);
914 $sth->execute($recievedlist,$missinglist,$subscriptionid);
916 # create new waited entry if needed (ie : was a "waited" and has changed)
917 if ($oldstatus eq 1 && $status ne 1) {
921 WHERE subscriptionid = ?
923 $sth = $dbh->prepare($query);
924 $sth->execute($subscriptionid);
925 my $val = $sth->fetchrow_hashref;
927 my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3) = GetNextSeq($val);
928 # next date (calculated from actual date & frequency parameters)
929 my $nextpublisheddate = GetNextDate($publisheddate,$val);
930 NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextpublisheddate,0);
933 SET lastvalue1=?, lastvalue2=?, lastvalue3=?,
934 innerloop1=?, innerloop2=?, innerloop3=?
935 WHERE subscriptionid = ?
937 $sth = $dbh->prepare($query);
938 $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3,$subscriptionid);
942 =head2 ModSubscription
946 this function modify a subscription. Put all new values on input args.
951 sub ModSubscription {
952 my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
953 $periodicity,$dow,$numberlength,$weeklength,$monthlength,
954 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
955 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
956 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
957 $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid)= @_;
958 my $dbh = C4::Context->dbh;
961 SET librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
962 periodicity=?,dow=?,numberlength=?,weeklength=?,monthlength=?,
963 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
964 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
965 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
966 numberingmethod=?, status=?, biblionumber=?, notes=?, letter=?
967 WHERE subscriptionid = ?
969 my $sth=$dbh->prepare($query);
970 $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
971 $periodicity,$dow,$numberlength,$weeklength,$monthlength,
972 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
973 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
974 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
975 $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid);
980 =head2 NewSubscription
984 $subscriptionid = &NewSubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
985 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
986 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
987 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
988 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
989 $numberingmethod, $status, $notes)
991 Create a new subscription with value given on input args.
994 the id of this new subscription
999 sub NewSubscription {
1000 my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1001 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1002 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1003 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1004 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1005 $numberingmethod, $status, $notes) = @_;
1006 my $dbh = C4::Context->dbh;
1007 #save subscription (insert into database)
1009 INSERT INTO subscription
1010 (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
1011 startdate,periodicity,dow,numberlength,weeklength,monthlength,
1012 add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
1013 add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
1014 add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
1015 numberingmethod, status, notes)
1016 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1018 my $sth=$dbh->prepare($query);
1020 $auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1021 format_date_in_iso($startdate),$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1022 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1023 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1024 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1025 $numberingmethod, $status, $notes);
1027 #then create the 1st waited number
1028 my $subscriptionid = $dbh->{'mysql_insertid'};
1030 INSERT INTO subscriptionhistory
1031 (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote)
1032 VALUES (?,?,?,?,?,?,?,?)
1034 $sth = $dbh->prepare($query);
1035 $sth->execute($biblionumber, $subscriptionid, format_date_in_iso($startdate), 0, "", "", "", $notes);
1037 # reread subscription to get a hash (for calculation of the 1st issue number)
1041 WHERE subscriptionid = ?
1043 $sth = $dbh->prepare($query);
1044 $sth->execute($subscriptionid);
1045 my $val = $sth->fetchrow_hashref;
1047 # calculate issue number
1048 my $serialseq = GetSeq($val);
1051 (serialseq,subscriptionid,biblionumber,status, planneddate)
1054 $sth = $dbh->prepare($query);
1055 $sth->execute($serialseq, $subscriptionid, $val->{'biblionumber'}, 1, format_date_in_iso($startdate));
1056 return $subscriptionid;
1060 =head2 ReNewSubscription
1064 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1066 this function renew a subscription with values given on input args.
1071 sub ReNewSubscription {
1072 my ($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note) = @_;
1073 my $dbh = C4::Context->dbh;
1074 my $subscription = GetSubscription($subscriptionid);
1077 FROM biblio,biblioitems
1078 WHERE biblio.biblionumber=biblioitems.biblionumber
1079 AND biblio.biblionumber=?
1081 my $sth = $dbh->prepare($query);
1082 $sth->execute($subscription->{biblionumber});
1083 my $biblio = $sth->fetchrow_hashref;
1084 NewSuggestion($user,$subscription->{bibliotitle},$biblio->{author},$biblio->{publishercode},$biblio->{note},'','','','','',$subscription->{biblionumber});
1085 # renew subscription
1088 SET startdate=?,numberlength=?,weeklength=?,monthlength=?
1089 WHERE subscriptionid=?
1091 $sth=$dbh->prepare($query);
1092 $sth->execute(format_date_in_iso($startdate),$numberlength,$weeklength,$monthlength, $subscriptionid);
1100 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate)
1102 Create a new issue stored on the database.
1103 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1109 my ($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate) = @_;
1110 my $dbh = C4::Context->dbh;
1113 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate)
1114 VALUES (?,?,?,?,?,?)
1116 my $sth = $dbh->prepare($query);
1117 $sth->execute($serialseq,$subscriptionid,$biblionumber,$status,$publisheddate, $planneddate);
1119 SELECT missinglist,recievedlist
1120 FROM subscriptionhistory
1121 WHERE subscriptionid=?
1123 $sth = $dbh->prepare($query);
1124 $sth->execute($subscriptionid);
1125 my ($missinglist,$recievedlist) = $sth->fetchrow;
1127 $recievedlist .= ",$serialseq";
1130 $missinglist .= ",$serialseq";
1133 UPDATE subscriptionhistory
1134 SET recievedlist=?, missinglist=?
1135 WHERE subscriptionid=?
1137 $sth=$dbh->prepare($query);
1138 $sth->execute($recievedlist,$missinglist,$subscriptionid);
1141 sub serialchangestatus {
1142 my ($serialid,$serialseq,$planneddate,$status,$notes)=@_;
1143 # 1st, get previous status : if we change from "waited" to something else, then we will have to create a new "waited" entry
1144 my $dbh = C4::Context->dbh;
1145 my $sth = $dbh->prepare("select subscriptionid,status from serial where serialid=?");
1146 $sth->execute($serialid);
1147 my ($subscriptionid,$oldstatus) = $sth->fetchrow;
1148 # change status & update subscriptionhistory
1150 delissue($serialseq, $subscriptionid)
1152 $sth = $dbh->prepare("update serial set serialseq=?,planneddate=?,status=?,notes=? where serialid = ?");
1153 $sth->execute($serialseq,$planneddate,$status,$notes,$serialid);
1154 $sth = $dbh->prepare("select missinglist,recievedlist from subscriptionhistory where subscriptionid=?");
1155 $sth->execute($subscriptionid);
1156 my ($missinglist,$recievedlist) = $sth->fetchrow;
1158 $recievedlist .= "| $serialseq";
1159 $recievedlist =~ s/^\| //g;
1161 $missinglist .= "| $serialseq" if ($status eq 4) ;
1162 $missinglist .= "| not issued $serialseq" if ($status eq 5);
1163 $missinglist =~ s/^\| //g;
1164 $sth=$dbh->prepare("update subscriptionhistory set recievedlist=?, missinglist=? where subscriptionid=?");
1165 $sth->execute($recievedlist,$missinglist,$subscriptionid);
1167 # create new waited entry if needed (ie : was a "waited" and has changed)
1168 if ($oldstatus eq 1 && $status ne 1) {
1169 $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1170 $sth->execute($subscriptionid);
1171 my $val = $sth->fetchrow_hashref;
1173 my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3) = New_Get_Next_Seq($val);
1174 my $nextplanneddate = Get_Next_Date($planneddate,$val);
1175 newissue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextplanneddate);
1176 $sth = $dbh->prepare("update subscription set lastvalue1=?, lastvalue2=?,lastvalue3=? where subscriptionid = ?");
1177 $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$subscriptionid);
1182 =head2 ItemizeSerials
1186 ItemizeSerials($serialid, $info);
1187 $info is a hashref containing barcode branch, itemcallnumber, status, location
1188 $serialid the serialid
1190 1 if the itemize is a succes.
1191 0 and @error else. @error containts the list of errors found.
1196 sub ItemizeSerials {
1197 my ($serialid, $info) =@_;
1198 my $now = ParseDate("today");
1199 $now = UnixDate($now,"%Y-%m-%d");
1201 my $dbh= C4::Context->dbh;
1207 my $sth=$dbh->prepare($query);
1208 $sth->execute($serialid);
1209 my $data=$sth->fetchrow_hashref;
1210 if(C4::Context->preference("RoutingSerials")){
1211 # check for existing biblioitem relating to serial issue
1212 my($count, @results) = getbiblioitembybiblionumber($data->{'biblionumber'});
1214 for(my $i=0;$i<$count;$i++){
1215 if($results[$i]->{'volumeddesc'} eq $data->{'serialseq'}.' ('.$data->{'planneddate'}.')'){
1216 $bibitemno = $results[$i]->{'biblioitemnumber'};
1220 if($bibitemno == 0){
1221 # warn "need to add new biblioitem so copy last one and make minor changes";
1222 my $sth=$dbh->prepare("SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC");
1223 $sth->execute($data->{'biblionumber'});
1225 my $biblioitem = $sth->fetchrow_hashref;
1226 $biblioitem->{'volumedate'} = format_date_in_iso($data->{planneddate});
1227 $biblioitem->{'volumeddesc'} = $data->{serialseq}.' ('.format_date($data->{'planneddate'}).')';
1228 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1229 if ($info->{barcode}){ # only make biblioitem if we are going to make item also
1230 $bibitemno = newbiblioitem($biblioitem);
1235 my $bibid=MARCfind_MARCbibid_from_oldbiblionumber($dbh,$data->{biblionumber});
1236 my $fwk=MARCfind_frameworkcode($dbh,$bibid);
1237 if ($info->{barcode}){
1239 my $exists = itemdata($info->{'barcode'});
1240 push @errors,"barcode_not_unique" if($exists);
1242 my $marcrecord = MARC::Record->new();
1243 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.barcode",$fwk);
1244 my $newField = MARC::Field->new(
1246 "$subfield" => $info->{barcode}
1248 $marcrecord->insert_fields_ordered($newField);
1249 if ($info->{branch}){
1250 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.homebranch",$fwk);
1251 #warn "items.homebranch : $tag , $subfield";
1252 if ($marcrecord->field($tag)) {
1253 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{branch})
1255 my $newField = MARC::Field->new(
1257 "$subfield" => $info->{branch}
1259 $marcrecord->insert_fields_ordered($newField);
1261 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.holdingbranch",$fwk);
1262 #warn "items.holdingbranch : $tag , $subfield";
1263 if ($marcrecord->field($tag)) {
1264 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{branch})
1266 my $newField = MARC::Field->new(
1268 "$subfield" => $info->{branch}
1270 $marcrecord->insert_fields_ordered($newField);
1273 if ($info->{itemcallnumber}){
1274 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.itemcallnumber",$fwk);
1275 #warn "items.itemcallnumber : $tag , $subfield";
1276 if ($marcrecord->field($tag)) {
1277 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{itemcallnumber})
1279 my $newField = MARC::Field->new(
1281 "$subfield" => $info->{itemcallnumber}
1283 $marcrecord->insert_fields_ordered($newField);
1286 if ($info->{notes}){
1287 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.itemnotes",$fwk);
1288 # warn "items.itemnotes : $tag , $subfield";
1289 if ($marcrecord->field($tag)) {
1290 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{notes})
1292 my $newField = MARC::Field->new(
1294 "$subfield" => $info->{notes}
1296 $marcrecord->insert_fields_ordered($newField);
1299 if ($info->{location}){
1300 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.location",$fwk);
1301 # warn "items.location : $tag , $subfield";
1302 if ($marcrecord->field($tag)) {
1303 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{location})
1305 my $newField = MARC::Field->new(
1307 "$subfield" => $info->{location}
1309 $marcrecord->insert_fields_ordered($newField);
1312 if ($info->{status}){
1313 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.notforloan",$fwk);
1314 # warn "items.notforloan : $tag , $subfield";
1315 if ($marcrecord->field($tag)) {
1316 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{status})
1318 my $newField = MARC::Field->new(
1320 "$subfield" => $info->{status}
1322 $marcrecord->insert_fields_ordered($newField);
1325 if(C4::Context->preference("RoutingSerials")){
1326 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.dateaccessioned",$fwk);
1327 if ($marcrecord->field($tag)) {
1328 $marcrecord->field($tag)->add_subfields("$subfield" => $now)
1330 my $newField = MARC::Field->new(
1334 $marcrecord->insert_fields_ordered($newField);
1337 NEWnewitem($dbh,$marcrecord,$bibid);
1344 =head2 HasSubscriptionExpired
1348 1 or 0 = HasSubscriptionExpired($subscriptionid)
1350 the subscription has expired when the next issue to arrive is out of subscription limit.
1353 1 if true, 0 if false.
1358 sub HasSubscriptionExpired {
1359 my ($subscriptionid) = @_;
1360 my $dbh = C4::Context->dbh;
1361 my $subscription = GetSubscription($subscriptionid);
1362 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1363 if ($subscription->{numberlength}) {
1367 WHERE subscriptionid=? AND planneddate>=?
1369 my $sth = $dbh->prepare($query);
1370 $sth->execute($subscriptionid,$subscription->{startdate});
1371 my $res = $sth->fetchrow;
1372 if ($subscription->{numberlength}>=$res) {
1378 #a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
1380 SELECT max(planneddate)
1382 WHERE subscriptionid=?
1384 my $sth = $dbh->prepare($query);
1385 $sth->execute($subscriptionid);
1386 my $res = ParseDate(format_date_in_iso($sth->fetchrow));
1387 my $endofsubscriptiondate;
1388 $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
1389 $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
1390 return 1 if ($res >= $endofsubscriptiondate);
1395 =head2 SetDistributedto
1399 SetDistributedto($distributedto,$subscriptionid);
1400 This function update the value of distributedto for a subscription given on input arg.
1405 sub SetDistributedto {
1406 my ($distributedto,$subscriptionid) = @_;
1407 my $dbh = C4::Context->dbh;
1411 WHERE subscriptionid=?
1413 my $sth = $dbh->prepare($query);
1414 $sth->execute($distributedto,$subscriptionid);
1417 =head2 DelSubscription
1421 DelSubscription($subscriptionid)
1422 this function delete the subscription which has $subscriptionid as id.
1427 sub DelSubscription {
1428 my ($subscriptionid) = @_;
1429 my $dbh = C4::Context->dbh;
1430 $subscriptionid=$dbh->quote($subscriptionid);
1431 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1432 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1433 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1440 DelIssue($serialseq,$subscriptionid)
1441 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1447 my ($serialseq,$subscriptionid) = @_;
1448 my $dbh = C4::Context->dbh;
1452 AND subscriptionid= ?
1454 my $sth = $dbh->prepare($query);
1455 $sth->execute($serialseq,$subscriptionid);
1458 sub GetMissingIssues {
1459 my ($supplierid,$serialid) = @_;
1460 my $dbh = C4::Context->dbh;
1464 $byserial = "and serialid = ".$serialid;
1467 $sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
1468 FROM subscription, serial, biblio
1469 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1470 WHERE subscription.subscriptionid = serial.subscriptionid AND
1471 serial.STATUS = 4 and
1472 subscription.aqbooksellerid=$supplierid and
1473 biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
1476 $sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
1477 FROM subscription, serial, biblio
1478 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1479 WHERE subscription.subscriptionid = serial.subscriptionid AND
1480 serial.STATUS =4 and
1481 biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
1489 while (my $line = $sth->fetchrow_hashref) {
1490 $odd++ unless $line->{title} eq $last_title;
1491 $last_title = $line->{title} if ($line->{title});
1492 $line->{planneddate} = format_date($line->{planneddate});
1493 $line->{claimdate} = format_date($line->{claimdate});
1494 $line->{'odd'} = 1 if $odd %2 ;
1496 push @issuelist,$line;
1498 return $count,@issuelist;
1501 sub removeMissingIssue {
1502 my ($sequence,$subscriptionid) = @_;
1503 my $dbh = C4::Context->dbh;
1504 my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1505 $sth->execute($subscriptionid);
1506 my $data = $sth->fetchrow_hashref;
1507 my $missinglist = $data->{'missinglist'};
1508 my $missinglistbefore = $missinglist;
1509 # warn $missinglist." before";
1510 $missinglist =~ s/($sequence)//;
1511 # warn $missinglist." after";
1512 if($missinglist ne $missinglistbefore){
1513 $missinglist =~ s/\|\s\|/\|/g;
1514 $missinglist =~ s/^\| //g;
1515 $missinglist =~ s/\|$//g;
1516 my $sth2= $dbh->prepare("UPDATE subscriptionhistory
1518 WHERE subscriptionid = ?");
1519 $sth2->execute($missinglist,$subscriptionid);
1524 my ($serialid) = @_;
1525 my $dbh = C4::Context->dbh;
1526 my $sth = $dbh->prepare("UPDATE serial SET claimdate = now()
1529 $sth->execute($serialid);
1532 sub getsupplierbyserialid {
1533 my ($serialid) = @_;
1534 my $dbh = C4::Context->dbh;
1535 my $sth = $dbh->prepare("SELECT serialid, serial.subscriptionid, aqbooksellerid
1536 FROM serial, subscription
1537 WHERE serial.subscriptionid = subscription.subscriptionid
1540 $sth->execute($serialid);
1541 my $line = $sth->fetchrow_hashref;
1542 my $result = $line->{'aqbooksellerid'};
1547 my ($subscriptionid) = @_;
1548 my $dbh = C4::Context->dbh;
1549 my $sth = $dbh->prepare("SELECT count(routingid) routingids FROM subscriptionroutinglist, subscription
1550 WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1551 AND subscription.subscriptionid = ? ORDER BY ranking ASC
1553 $sth->execute($subscriptionid);
1554 my $line = $sth->fetchrow_hashref;
1555 my $result = $line->{'routingids'};
1559 sub addroutingmember {
1560 my ($bornum,$subscriptionid) = @_;
1562 my $dbh = C4::Context->dbh;
1563 my $sth = $dbh->prepare("SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?");
1564 $sth->execute($subscriptionid);
1565 while(my $line = $sth->fetchrow_hashref){
1566 if($line->{'rank'}>0){
1567 $rank = $line->{'rank'}+1;
1572 $sth = $dbh->prepare("INSERT INTO subscriptionroutinglist VALUES (null,?,?,?,null)");
1573 $sth->execute($subscriptionid,$bornum,$rank);
1576 sub reorder_members {
1577 my ($subscriptionid,$routingid,$rank) = @_;
1578 my $dbh = C4::Context->dbh;
1579 my $sth = $dbh->prepare("SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC");
1580 $sth->execute($subscriptionid);
1582 while(my $line = $sth->fetchrow_hashref){
1583 push(@result,$line->{'routingid'});
1585 # To find the matching index
1587 my $key = -1; # to allow for 0 being a valid response
1588 for ($i = 0; $i < @result; $i++) {
1589 if ($routingid == $result[$i]) {
1590 $key = $i; # save the index
1594 # if index exists in array then move it to new position
1595 if($key > -1 && $rank > 0){
1596 my $new_rank = $rank-1; # $new_rank is what you want the new index to be in the array
1597 my $moving_item = splice(@result, $key, 1);
1598 splice(@result, $new_rank, 0, $moving_item);
1600 for(my $j = 0; $j < @result; $j++){
1601 my $sth = $dbh->prepare("UPDATE subscriptionroutinglist SET ranking = '" . ($j+1) . "' WHERE routingid = '". $result[$j]."'");
1606 sub delroutingmember {
1607 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
1608 my ($routingid,$subscriptionid) = @_;
1609 my $dbh = C4::Context->dbh;
1611 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
1612 $sth->execute($routingid);
1613 reorder_members($subscriptionid,$routingid);
1615 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
1616 $sth->execute($subscriptionid);
1620 sub getroutinglist {
1621 my ($subscriptionid) = @_;
1622 my $dbh = C4::Context->dbh;
1623 my $sth = $dbh->prepare("SELECT routingid, borrowernumber,
1624 ranking, biblionumber FROM subscriptionroutinglist, subscription
1625 WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1626 AND subscription.subscriptionid = ? ORDER BY ranking ASC
1628 $sth->execute($subscriptionid);
1631 while (my $line = $sth->fetchrow_hashref) {
1633 push(@routinglist,$line);
1635 return ($count,@routinglist);
1638 # is the subscription about to expire? - check if penultimate issue.
1640 my ($subscriptionid) = @_;
1641 my $dbh = C4::Context->dbh;
1642 my $subscription = getsubscription($subscriptionid);
1643 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1644 if ($subscription->{numberlength}) {
1645 my $sth = $dbh->prepare("select count(*) from serial where subscriptionid=? and planneddate>=?");
1646 $sth->execute($subscriptionid,$subscription->{startdate});
1647 my $res = $sth->fetchrow;
1648 warn "length: ".$subscription->{numberlength}." vs count: ".$res;
1649 if ($subscription->{numberlength}==$res) {
1655 # a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
1656 my $sth = $dbh->prepare("select max(planneddate) from serial where subscriptionid=?");
1657 $sth->execute($subscriptionid);
1658 my $res = ParseDate(format_date_in_iso($sth->fetchrow));
1659 my $endofsubscriptiondate;
1660 $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
1661 $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
1662 warn "last: ".$endofsubscriptiondate." vs currentdate: ".$res;
1663 my $per = $subscription->{'periodicity'};
1665 if ($per == 1) { $x = '1 day'; }
1666 if ($per == 2) { $x = '1 week'; }
1667 if ($per == 3) { $x = '2 weeks'; }
1668 if ($per == 4) { $x = '3 weeks'; }
1669 if ($per == 5) { $x = '1 month'; }
1670 if ($per == 6) { $x = '2 months'; }
1671 if ($per == 7 || $per == 8) { $x = '3 months'; }
1672 if ($per == 9) { $x = '6 months'; }
1673 if ($per == 10) { $x = '1 year'; }
1674 if ($per == 11) { $x = '2 years'; }
1675 my $datebeforeend = DateCalc($endofsubscriptiondate,"- ".$x); # if ($subscription->{weeklength});
1676 warn "DATE BEFORE END: $datebeforeend";
1677 return 1 if ($res >= $datebeforeend && $res < $endofsubscriptiondate);
1682 sub old_newsubscription {
1683 my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1684 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1685 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1686 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1687 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1688 $numberingmethod, $status, $callnumber, $notes, $hemisphere) = @_;
1689 my $dbh = C4::Context->dbh;
1691 my $sth=$dbh->prepare("insert into subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
1692 startdate,periodicity,firstacquidate,dow,irregularity,numberpattern,numberlength,weeklength,monthlength,
1693 add1,every1,whenmorethan1,setto1,lastvalue1,
1694 add2,every2,whenmorethan2,setto2,lastvalue2,
1695 add3,every3,whenmorethan3,setto3,lastvalue3,
1696 numberingmethod, status, callnumber, notes, hemisphere) values
1697 (?,?,?,?,?,?,?,?,?,?,?,
1698 ?,?,?,?,?,?,?,?,?,?,?,
1699 ?,?,?,?,?,?,?,?,?,?,?,?)");
1700 $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1701 format_date_in_iso($startdate),$periodicity,format_date_in_iso($firstacquidate),$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1702 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1703 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1704 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1705 $numberingmethod, $status,$callnumber, $notes, $hemisphere);
1706 #then create the 1st waited number
1707 my $subscriptionid = $dbh->{'mysql_insertid'};
1708 my $enddate = subscriptionexpirationdate($subscriptionid);
1710 $sth = $dbh->prepare("insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)");
1711 $sth->execute($biblionumber, $subscriptionid, format_date_in_iso($startdate), format_date_in_iso($enddate), "", "", "", $notes);
1712 # reread subscription to get a hash (for calculation of the 1st issue number)
1713 $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1714 $sth->execute($subscriptionid);
1715 my $val = $sth->fetchrow_hashref;
1717 # calculate issue number
1718 my $serialseq = Get_Seq($val);
1719 $sth = $dbh->prepare("insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)");
1720 $sth->execute($serialseq, $subscriptionid, $val->{'biblionumber'}, 1, format_date_in_iso($startdate));
1721 return $subscriptionid;
1724 sub old_modsubscription {
1725 my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
1726 $periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1727 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1728 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1729 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1730 $numberingmethod, $status, $biblionumber, $callnumber, $notes, $hemisphere, $subscriptionid)= @_;
1731 my $dbh = C4::Context->dbh;
1732 my $sth=$dbh->prepare("update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
1733 periodicity=?,firstacquidate=?,dow=?,irregularity=?,numberpattern=?,numberlength=?,weeklength=?,monthlength=?,
1734 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
1735 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
1736 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
1737 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, hemisphere=? where subscriptionid = ?");
1738 $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
1739 $periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1740 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1741 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1742 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1743 $numberingmethod, $status, $biblionumber, $callnumber, $notes, $hemisphere, $subscriptionid);
1747 $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1748 $sth->execute($subscriptionid);
1749 my $val = $sth->fetchrow_hashref;
1751 # calculate issue number
1752 my $serialseq = Get_Seq($val);
1753 $sth = $dbh->prepare("UPDATE serial SET serialseq = ? WHERE subscriptionid = ?");
1754 $sth->execute($serialseq,$subscriptionid);
1756 my $enddate = subscriptionexpirationdate($subscriptionid);
1757 $sth = $dbh->prepare("update subscriptionhistory set enddate=?");
1758 $sth->execute(format_date_in_iso($enddate));
1761 sub old_getserials {
1762 my ($subscriptionid) = @_;
1763 my $dbh = C4::Context->dbh;
1764 # status = 2 is "arrived"
1765 my $sth=$dbh->prepare("select serialid,serialseq, status, planneddate,notes,routingnotes from serial where subscriptionid = ? and status <>2 and status <>4 and status <>5");
1766 $sth->execute($subscriptionid);
1769 while(my $line = $sth->fetchrow_hashref) {
1770 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
1771 $line->{"planneddate"} = format_date($line->{"planneddate"});
1772 $line->{"num"} = $num;
1774 push @serials,$line;
1776 $sth=$dbh->prepare("select count(*) from serial where subscriptionid=?");
1777 $sth->execute($subscriptionid);
1778 my ($totalissues) = $sth->fetchrow;
1779 return ($totalissues,@serials);
1782 sub Get_Next_Date(@) {
1783 my ($planneddate,$subscription) = @_;
1784 my @irreg = split(/\|/,$subscription->{irregularity});
1786 my ($year, $month, $day) = UnixDate($planneddate, "%Y", "%m", "%d");
1787 my $dayofweek = Date_DayOfWeek($month,$day,$year);
1789 # warn "DOW $dayofweek";
1790 if ($subscription->{periodicity} == 1) {
1791 for(my $i=0;$i<@irreg;$i++){
1792 if($dayofweek == 7){ $dayofweek = 0; }
1793 if(in_array(($dayofweek+1), @irreg)){
1794 $planneddate = DateCalc($planneddate,"1 day");
1798 $resultdate=DateCalc($planneddate,"1 day");
1800 if ($subscription->{periodicity} == 2) {
1801 my $wkno = Date_WeekOfYear($month,$day,$year,1);
1802 for(my $i = 0;$i < @irreg; $i++){
1803 if($wkno > 52) { $wkno = 0; } # need to rollover at January
1804 if($irreg[$i] == ($wkno+1)){
1805 $planneddate = DateCalc($planneddate,"1 week");
1809 $resultdate=DateCalc($planneddate,"1 week");
1811 if ($subscription->{periodicity} == 3) {
1812 my $wkno = Date_WeekOfYear($month,$day,$year,1);
1813 for(my $i = 0;$i < @irreg; $i++){
1814 if($wkno > 52) { $wkno = 0; } # need to rollover at January
1815 if($irreg[$i] == ($wkno+1)){
1816 $planneddate = DateCalc($planneddate,"2 weeks");
1820 $resultdate=DateCalc($planneddate,"2 weeks");
1822 if ($subscription->{periodicity} == 4) {
1823 my $wkno = Date_WeekOfYear($month,$day,$year,1);
1824 for(my $i = 0;$i < @irreg; $i++){
1825 if($wkno > 52) { $wkno = 0; } # need to rollover at January
1826 if($irreg[$i] == ($wkno+1)){
1827 $planneddate = DateCalc($planneddate,"3 weeks");
1831 $resultdate=DateCalc($planneddate,"3 weeks");
1833 if ($subscription->{periodicity} == 5) {
1834 for(my $i = 0;$i < @irreg; $i++){
1837 if($month == 12) { $month = 0; } # need to rollover to check January
1838 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1839 $planneddate = DateCalc($planneddate,"1 month");
1840 $month++; # to check if following ones are to be skipped too
1843 $resultdate=DateCalc($planneddate,"1 month");
1844 # warn "Planneddate2: $planneddate";
1846 if ($subscription->{periodicity} == 6) {
1847 for(my $i = 0;$i < @irreg; $i++){
1848 if($month == 12) { $month = 0; } # need to rollover to check January
1849 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1850 $planneddate = DateCalc($planneddate,"2 months");
1851 $month++; # to check if following ones are to be skipped too
1854 $resultdate=DateCalc($planneddate,"2 months");
1856 if ($subscription->{periodicity} == 7) {
1857 for(my $i = 0;$i < @irreg; $i++){
1858 if($month == 12) { $month = 0; } # need to rollover to check January
1859 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1860 $planneddate = DateCalc($planneddate,"3 months");
1861 $month++; # to check if following ones are to be skipped too
1864 $resultdate=DateCalc($planneddate,"3 months");
1866 if ($subscription->{periodicity} == 8) {
1867 for(my $i = 0;$i < @irreg; $i++){
1868 if($month == 12) { $month = 0; } # need to rollover to check January
1869 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1870 $planneddate = DateCalc($planneddate,"3 months");
1871 $month++; # to check if following ones are to be skipped too
1874 $resultdate=DateCalc($planneddate,"3 months");
1876 if ($subscription->{periodicity} == 9) {
1877 for(my $i = 0;$i < @irreg; $i++){
1878 if($month == 12) { $month = 0; } # need to rollover to check January
1879 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1880 $planneddate = DateCalc($planneddate,"6 months");
1881 $month++; # to check if following ones are to be skipped too
1884 $resultdate=DateCalc($planneddate,"6 months");
1886 if ($subscription->{periodicity} == 10) {
1887 $resultdate=DateCalc($planneddate,"1 year");
1889 if ($subscription->{periodicity} == 11) {
1890 $resultdate=DateCalc($planneddate,"2 years");
1892 # warn "date: ".$resultdate;
1893 return format_date_in_iso($resultdate);
1897 END { } # module clean-up code here (global destructor)