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
61 &GetDistributedTo &SetDistributedto
64 =head2 GetSuppliersWithLateIssues
68 %supplierlist = &GetSuppliersWithLateIssues
70 this function get all suppliers with late issues.
73 the supplierlist into a hash. this hash containts id & name of the supplier
78 sub GetSuppliersWithLateIssues {
79 my $dbh = C4::Context->dbh;
81 SELECT DISTINCT id, name
82 FROM subscription, serial
83 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
84 WHERE subscription.subscriptionid = serial.subscriptionid
85 AND (planneddate < now() OR serial.STATUS = 3)
87 my $sth = $dbh->prepare($query);
90 while (my ($id,$name) = $sth->fetchrow) {
91 $supplierlist{$id} = $name;
100 @issuelist = &GetLateIssues($supplierid)
102 this function select late issues on database
105 the issuelist into an table. Each line of this table containts a ref to a hash which it containts
106 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
112 my ($supplierid) = @_;
113 my $dbh = C4::Context->dbh;
117 SELECT name,title,planneddate,serialseq,serial.subscriptionid
118 FROM subscription, serial, biblio
119 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
120 WHERE subscription.subscriptionid = serial.subscriptionid
121 AND ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
122 AND subscription.aqbooksellerid=$supplierid
123 AND biblio.biblionumber = subscription.biblionumber
126 $sth = $dbh->prepare($query);
129 SELECT name,title,planneddate,serialseq,serial.subscriptionid
130 FROM subscription, serial, biblio
131 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
132 WHERE subscription.subscriptionid = serial.subscriptionid
133 AND ((planneddate < now() AND serial.STATUS <=3) OR serial.STATUS = 3)
134 AND biblio.biblionumber = subscription.biblionumber
137 $sth = $dbh->prepare($query);
143 while (my $line = $sth->fetchrow_hashref) {
144 $odd++ unless $line->{title} eq $last_title;
145 $line->{title} = "" if $line->{title} eq $last_title;
146 $last_title = $line->{title} if ($line->{title});
147 $line->{planneddate} = format_date($line->{planneddate});
148 $line->{'odd'} = 1 if $odd %2 ;
149 push @issuelist,$line;
154 =head2 GetSubscriptionHistoryFromSubscriptionId
158 $sth = GetSubscriptionHistoryFromSubscriptionId()
159 this function just prepare the SQL request.
160 After this function, don't forget to execute it by using $sth->execute($subscriptionid)
162 $sth = $dbh->prepare($query).
167 sub GetSubscriptionHistoryFromSubscriptionId() {
168 my $dbh = C4::Context->dbh;
171 FROM subcriptionhistory
172 WHERE subscriptionid = ?
174 return $dbh->prepare($query);
177 =head2 GetSerialStatusFromSerialId
181 $sth = GetSerialStatusFromSerialId();
182 this function just prepare the SQL request.
183 After this function, don't forget to execute it by using $sth->execute($serialid)
185 $sth = $dbh->prepare($query).
190 sub GetSerialStatusFromSerialId(){
191 my $dbh = C4::Context->dbh;
197 return $dbh->prepare($query);
201 =head2 GetSubscription
205 $subs = GetSubscription($subscriptionid)
206 this function get the subscription which has $subscriptionid as id.
208 a hashref. This hash containts
209 subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
214 sub GetSubscription {
215 my ($subscriptionid) = @_;
216 my $dbh = C4::Context->dbh;
218 SELECT subscription.*,
219 subscriptionhistory.*,
221 aqbooksellers.name AS aqbooksellername,
222 biblio.title AS bibliotitle
224 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
225 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
226 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
227 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
228 WHERE subscription.subscriptionid = ?
230 my $sth = $dbh->prepare($query);
231 $sth->execute($subscriptionid);
232 my $subs = $sth->fetchrow_hashref;
236 =head2 GetSubscriptionsFromBiblionumber
240 \@res = GetSubscriptionsFromBiblionumber($biblionumber)
241 this function get the subscription list. it reads on subscription table.
243 table of subscription which has the biblionumber given on input arg.
244 each line of this table is a hashref. All hashes containt
245 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
250 sub GetSubscriptionsFromBiblionumber {
251 my ($biblionumber) = @_;
252 my $dbh = C4::Context->dbh;
254 SELECT subscription.*,
255 subscriptionhistory.*,
257 aqbooksellers.name AS aqbooksellername,
258 biblio.title AS bibliotitle
260 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
261 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
262 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
263 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
264 WHERE subscription.biblionumber = ?
266 my $sth = $dbh->prepare($query);
267 $sth->execute($biblionumber);
269 while (my $subs = $sth->fetchrow_hashref) {
270 $subs->{startdate} = format_date($subs->{startdate});
271 $subs->{histstartdate} = format_date($subs->{histstartdate});
272 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
273 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
274 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
275 $subs->{"periodicity".$subs->{periodicity}} = 1;
276 $subs->{"status".$subs->{'status'}} = 1;
277 if ($subs->{enddate} eq '0000-00-00') {
280 $subs->{enddate} = format_date($subs->{enddate});
286 =head2 GetFullSubscriptionsFromBiblionumber
290 \@res = GetFullSubscriptionsFromBiblionumber($biblionumber)
291 this function read on serial table.
296 sub GetFullSubscriptionsFromBiblionumber {
297 my ($biblionumber) = @_;
298 my $dbh = C4::Context->dbh;
300 SELECT serial.serialseq,
302 serial.publisheddate,
305 year(serial.publisheddate) AS year,
306 aqbudget.bookfundid,aqbooksellers.name AS aqbooksellername,
307 biblio.title AS bibliotitle
309 LEFT JOIN subscription ON
310 (serial.subscriptionid=subscription.subscriptionid AND subscription.biblionumber=serial.biblionumber)
311 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
312 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
313 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
314 WHERE subscription.biblionumber = ?
315 ORDER BY year,serial.publisheddate,serial.subscriptionid,serial.planneddate
318 my $sth = $dbh->prepare($query);
319 $sth->execute($biblionumber);
323 my $aqbooksellername;
328 while (my $subs = $sth->fetchrow_hashref) {
329 ### BUG To FIX: When there is no published date, will create many null ids!!!
331 if ($year and ($year==$subs->{year})){
332 if ($first eq 1){$first=0;}
333 my $temp=$res[scalar(@res)-1]->{'serials'};
335 {'publisheddate' =>format_date($subs->{'publisheddate'}),
336 'planneddate' => format_date($subs->{'planneddate'}),
337 'serialseq' => $subs->{'serialseq'},
338 "status".$subs->{'status'} => 1,
339 'notes' => $subs->{'notes'} eq $previousnote?"":$subs->{notes},
342 $first=1 if (not $year);
343 $year= $subs->{'year'};
344 $startdate= format_date($subs->{'startdate'});
345 $aqbooksellername= $subs->{'aqbooksellername'};
346 $bibliotitle= $subs->{'bibliotitle'};
349 {'publisheddate' =>format_date($subs->{'publisheddate'}),
350 'planneddate' => format_date($subs->{'planneddate'}),
351 'serialseq' => $subs->{'serialseq'},
352 "status".$subs->{'status'} => 1,
353 'notes' => $subs->{'notes'} eq $previousnote?"":$subs->{notes},
358 'startdate'=>$startdate,
359 'aqbooksellername'=>$aqbooksellername,
360 'bibliotitle'=>$bibliotitle,
365 $previousnote=$subs->{notes};
371 =head2 GetSubscriptions
375 @results = GetSubscriptions($title,$ISSN,$biblionumber);
376 this function get all subscriptions which has title like $title,ISSN like $ISSN and biblionumber like $biblionumber.
378 a table of hashref. Each hash containt the subscription.
383 sub GetSubscriptions {
384 my ($title,$ISSN,$biblionumber) = @_;
385 return unless $title or $ISSN or $biblionumber;
386 my $dbh = C4::Context->dbh;
390 SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber
391 FROM subscription,biblio,biblioitems
392 WHERE biblio.biblionumber = biblioitems.biblionumber
393 AND biblio.biblionumber = subscription.biblionumber
394 AND biblio.biblionumber=?
397 $sth = $dbh->prepare($query);
398 $sth->execute($biblionumber);
400 if ($ISSN and $title){
402 SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber
403 FROM subscription,biblio,biblioitems
404 WHERE biblio.biblionumber = biblioitems.biblionumber
405 AND biblio.biblionumber= subscription.biblionumber
406 AND (biblio.title LIKE ? or biblioitems.issn = ?)
409 $sth = $dbh->prepare($query);
410 $sth->execute("%$title%",$ISSN);
415 SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber
416 FROM subscription,biblio,biblioitems
417 WHERE biblio.biblionumber = biblioitems.biblionumber
418 AND biblio.biblionumber=subscription.biblionumber
419 AND biblioitems.issn = ?
422 $sth = $dbh->prepare($query);
423 $sth->execute($ISSN);
426 SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber
427 FROM subscription,biblio,biblioitems
428 WHERE biblio.biblionumber = biblioitems.biblionumber
429 AND biblio.biblionumber=subscription.biblionumber
430 AND biblio.title LIKE ?
433 $sth = $dbh->prepare($query);
434 $sth->execute("%$title%");
439 my $previoustitle="";
441 while (my $line = $sth->fetchrow_hashref) {
442 if ($previoustitle eq $line->{title}) {
445 $line->{toggle} = 1 if $odd==1;
447 $previoustitle=$line->{title};
449 $line->{toggle} = 1 if $odd==1;
451 push @results, $line;
460 ($totalissues,@serials) = GetSerials($subscriptionid);
461 this function get every serial not arrived for a given subscription
462 as well as the number of issues registered in the database (all types)
463 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
469 my ($subscriptionid) = @_;
470 my $dbh = C4::Context->dbh;
471 # OK, now add the last 5 issues arrives/missing
473 SELECT serialid,serialseq, status, planneddate,notes
475 WHERE subscriptionid = ?
476 AND (status in (2,4,5))
477 ORDER BY serialid DESC
479 my $sth=$dbh->prepare($query);
480 $sth->execute($subscriptionid);
483 while((my $line = $sth->fetchrow_hashref) && $counter <5) {
485 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
486 $line->{"planneddate"} = format_date($line->{"planneddate"});
489 # status = 2 is "arrived"
491 SELECT serialid,serialseq, status, publisheddate, planneddate,notes
493 WHERE subscriptionid = ? AND status NOT IN (2,4,5)
495 my $sth=$dbh->prepare($query);
496 $sth->execute($subscriptionid);
497 while(my $line = $sth->fetchrow_hashref) {
498 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
499 $line->{"publisheddate"} = format_date($line->{"publisheddate"});
500 $line->{"planneddate"} = format_date($line->{"planneddate"});
506 WHERE subscriptionid=?
508 $sth=$dbh->prepare($query);
509 $sth->execute($subscriptionid);
510 my ($totalissues) = $sth->fetchrow;
511 return ($totalissues,@serials);
514 =head2 GetLatestSerials
518 \@serials = GetLatestSerials($subscriptionid,$limit)
519 get the $limit's latest serials arrived or missing for a given subscription
521 a ref to a table which it containts all of the latest serials stored into a hash.
526 sub GetLatestSerials {
527 my ($subscriptionid,$limit) = @_;
528 my $dbh = C4::Context->dbh;
529 # status = 2 is "arrived"
531 SELECT serialid,serialseq, status, planneddate
533 WHERE subscriptionid = ?
534 AND (status =2 or status=4)
535 ORDER BY planneddate DESC LIMIT 0,$limit
537 my $sth=$dbh->prepare($strsth);
538 $sth->execute($subscriptionid);
540 while(my $line = $sth->fetchrow_hashref) {
541 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
542 $line->{"planneddate"} = format_date($line->{"planneddate"});
548 # WHERE subscriptionid=?
550 # $sth=$dbh->prepare($query);
551 # $sth->execute($subscriptionid);
552 # my ($totalissues) = $sth->fetchrow;
556 =head2 GetDistributedTo
560 $distributedto=GetDistributedTo($subscriptionid)
561 This function select the old previous value of distributedto in the database.
566 sub GetDistributedTo {
567 my $dbh = C4::Context->dbh;
569 my $subscriptionid = @_;
573 WHERE subscriptionid=?
575 my $sth = $dbh->prepare($query);
576 $sth->execute($subscriptionid);
577 return ($distributedto) = $sth->fetchrow;
585 $val is a hashref containing all the attributes of the table 'subscription'
586 This function get the next issue for the subscription given on input arg
588 all the input params updated.
595 my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
596 $calculated = $val->{numberingmethod};
597 # calculate the (expected) value of the next issue recieved.
598 $newlastvalue1 = $val->{lastvalue1};
599 # check if we have to increase the new value.
600 $newinnerloop1 = $val->{innerloop1}+1;
601 $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
602 $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
603 $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
604 $calculated =~ s/\{X\}/$newlastvalue1/g;
606 $newlastvalue2 = $val->{lastvalue2};
607 # check if we have to increase the new value.
608 $newinnerloop2 = $val->{innerloop2}+1;
609 $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
610 $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
611 $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
612 $calculated =~ s/\{Y\}/$newlastvalue2/g;
614 $newlastvalue3 = $val->{lastvalue3};
615 # check if we have to increase the new value.
616 $newinnerloop3 = $val->{innerloop3}+1;
617 $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
618 $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
619 $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
620 $calculated =~ s/\{Z\}/$newlastvalue3/g;
621 return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
628 $resultdate = GetNextDate($planneddate,$subscription)
630 this function get the date after $planneddate.
632 the date on ISO format.
638 my ($planneddate,$subscription) = @_;
640 if ($subscription->{periodicity} == 1) {
641 $resultdate=DateCalc($planneddate,"1 day");
643 if ($subscription->{periodicity} == 2) {
644 $resultdate=DateCalc($planneddate,"1 week");
646 if ($subscription->{periodicity} == 3) {
647 $resultdate=DateCalc($planneddate,"2 weeks");
649 if ($subscription->{periodicity} == 4) {
650 $resultdate=DateCalc($planneddate,"3 weeks");
652 if ($subscription->{periodicity} == 5) {
653 $resultdate=DateCalc($planneddate,"1 month");
655 if ($subscription->{periodicity} == 6) {
656 $resultdate=DateCalc($planneddate,"2 months");
658 if ($subscription->{periodicity} == 7) {
659 $resultdate=DateCalc($planneddate,"3 months");
661 if ($subscription->{periodicity} == 8) {
662 $resultdate=DateCalc($planneddate,"3 months");
664 if ($subscription->{periodicity} == 9) {
665 $resultdate=DateCalc($planneddate,"6 months");
667 if ($subscription->{periodicity} == 10) {
668 $resultdate=DateCalc($planneddate,"1 year");
670 if ($subscription->{periodicity} == 11) {
671 $resultdate=DateCalc($planneddate,"2 years");
673 return format_date_in_iso($resultdate);
680 $calculated = GetSeq($val)
681 $val is a hashref containing all the attributes of the table 'subscription'
682 this function transforms {X},{Y},{Z} to 150,0,0 for example.
684 the sequence in integer format
691 my $calculated = $val->{numberingmethod};
692 my $x=$val->{'lastvalue1'};
693 $calculated =~ s/\{X\}/$x/g;
694 my $y=$val->{'lastvalue2'};
695 $calculated =~ s/\{Y\}/$y/g;
696 my $z=$val->{'lastvalue3'};
697 $calculated =~ s/\{Z\}/$z/g;
701 =head2 GetSubscriptionExpirationDate
705 $sensddate = GetSubscriptionExpirationDate($subscriptionid)
707 this function return the expiration date for a subscription given on input args.
715 sub GetSubscriptionExpirationDate {
716 my ($subscriptionid) = @_;
717 my $dbh = C4::Context->dbh;
718 my $subscription = GetSubscription($subscriptionid);
719 my $enddate=$subscription->{startdate};
720 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
721 if ($subscription->{numberlength}) {
722 #calculate the date of the last issue.
723 for (my $i=1;$i<=$subscription->{numberlength};$i++) {
724 $enddate = GetNextDate($enddate,$subscription);
728 $enddate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
729 $enddate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
734 =head2 CountSubscriptionFromBiblionumber
738 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
739 this count the number of subscription for a biblionumber given.
741 the number of subscriptions with biblionumber given on input arg.
746 sub CountSubscriptionFromBiblionumber {
747 my ($biblionumber) = @_;
748 my $dbh = C4::Context->dbh;
754 my $sth = $dbh->prepare($query);
755 $sth->execute($biblionumber);
756 my $subscriptionsnumber = $sth->fetchrow;
757 return $subscriptionsnumber;
761 =head2 ModSubscriptionHistory
765 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
767 this function modify the history of a subscription. Put your new values on input arg.
772 sub ModSubscriptionHistory {
773 my ($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote)=@_;
774 my $dbh=C4::Context->dbh;
776 UPDATE subscriptionhistory
777 SET histstartdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
778 WHERE subscriptionid=?
780 my $sth = $dbh->prepare($query);
781 $recievedlist =~ s/^,//g;
782 $missinglist =~ s/^,//g;
783 $opacnote =~ s/^,//g;
784 $sth->execute($histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote,$subscriptionid);
787 =head2 ModSerialStatus
791 ModSerialStatus($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes)
793 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
794 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
799 sub ModSerialStatus {
800 my ($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes)=@_;
801 # 1st, get previous status :
802 my $dbh = C4::Context->dbh;
804 SELECT subscriptionid,status
808 my $sth = $dbh->prepare($query);
809 $sth->execute($serialid);
810 my ($subscriptionid,$oldstatus) = $sth->fetchrow;
811 # change status & update subscriptionhistory
813 DelIssue($serialseq, $subscriptionid)
817 SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=?
820 $sth = $dbh->prepare($query);
821 $sth->execute($serialseq,$publisheddate,$planneddate,$status,$notes,$serialid);
823 SELECT missinglist,recievedlist
824 FROM subscriptionhistory
825 WHERE subscriptionid=?
827 $sth = $dbh->prepare($query);
828 $sth->execute($subscriptionid);
829 my ($missinglist,$recievedlist) = $sth->fetchrow;
831 $recievedlist .= ",$serialseq";
833 $missinglist .= ",$serialseq" if ($status eq 4) ;
834 $missinglist .= ",not issued $serialseq" if ($status eq 5);
836 UPDATE subscriptionhistory
837 SET recievedlist=?, missinglist=?
838 WHERE subscriptionid=?
840 $sth=$dbh->prepare($query);
841 $sth->execute($recievedlist,$missinglist,$subscriptionid);
843 # create new waited entry if needed (ie : was a "waited" and has changed)
844 if ($oldstatus eq 1 && $status ne 1) {
848 WHERE subscriptionid = ?
850 $sth = $dbh->prepare($query);
851 $sth->execute($subscriptionid);
852 my $val = $sth->fetchrow_hashref;
854 my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3) = GetNextSeq($val);
855 # next date (calculated from actual date & frequency parameters)
856 my $nextpublisheddate = GetNextDate($publisheddate,$val);
857 NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextpublisheddate,0);
860 SET lastvalue1=?, lastvalue2=?, lastvalue3=?,
861 innerloop1=?, innerloop2=?, innerloop3=?
862 WHERE subscriptionid = ?
864 $sth = $dbh->prepare($query);
865 $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3,$subscriptionid);
869 =head2 ModSubscription
873 this function modify a subscription. Put all new values on input args.
878 sub ModSubscription {
879 my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
880 $periodicity,$dow,$numberlength,$weeklength,$monthlength,
881 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
882 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
883 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
884 $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid)= @_;
885 my $dbh = C4::Context->dbh;
888 SET librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
889 periodicity=?,dow=?,numberlength=?,weeklength=?,monthlength=?,
890 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
891 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
892 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
893 numberingmethod=?, status=?, biblionumber=?, notes=?, letter=?
894 WHERE subscriptionid = ?
896 my $sth=$dbh->prepare($query);
897 $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
898 $periodicity,$dow,$numberlength,$weeklength,$monthlength,
899 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
900 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
901 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
902 $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid);
907 =head2 NewSubscription
911 $subscriptionid = &NewSubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
912 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
913 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
914 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
915 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
916 $numberingmethod, $status, $notes)
918 Create a new subscription with value given on input args.
921 the id of this new subscription
926 sub NewSubscription {
927 my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
928 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
929 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
930 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
931 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
932 $numberingmethod, $status, $notes) = @_;
933 my $dbh = C4::Context->dbh;
934 #save subscription (insert into database)
936 INSERT INTO subscription
937 (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
938 startdate,periodicity,dow,numberlength,weeklength,monthlength,
939 add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
940 add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
941 add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
942 numberingmethod, status, notes)
943 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
945 my $sth=$dbh->prepare($query);
947 $auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
948 format_date_in_iso($startdate),$periodicity,$dow,$numberlength,$weeklength,$monthlength,
949 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
950 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
951 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
952 $numberingmethod, $status, $notes);
954 #then create the 1st waited number
955 my $subscriptionid = $dbh->{'mysql_insertid'};
957 INSERT INTO subscriptionhistory
958 (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote)
959 VALUES (?,?,?,?,?,?,?,?)
961 $sth = $dbh->prepare($query);
962 $sth->execute($biblionumber, $subscriptionid, format_date_in_iso($startdate), 0, "", "", "", $notes);
964 # reread subscription to get a hash (for calculation of the 1st issue number)
968 WHERE subscriptionid = ?
970 $sth = $dbh->prepare($query);
971 $sth->execute($subscriptionid);
972 my $val = $sth->fetchrow_hashref;
974 # calculate issue number
975 my $serialseq = GetSeq($val);
978 (serialseq,subscriptionid,biblionumber,status, planneddate)
981 $sth = $dbh->prepare($query);
982 $sth->execute($serialseq, $subscriptionid, $val->{'biblionumber'}, 1, format_date_in_iso($startdate));
983 return $subscriptionid;
987 =head2 ReNewSubscription
991 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
993 this function renew a subscription with values given on input args.
998 sub ReNewSubscription {
999 my ($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note) = @_;
1000 my $dbh = C4::Context->dbh;
1001 my $subscription = GetSubscription($subscriptionid);
1004 FROM biblio,biblioitems
1005 WHERE biblio.biblionumber=biblioitems.biblionumber
1006 AND biblio.biblionumber=?
1008 my $sth = $dbh->prepare($query);
1009 $sth->execute($subscription->{biblionumber});
1010 my $biblio = $sth->fetchrow_hashref;
1011 NewSuggestion($user,$subscription->{bibliotitle},$biblio->{author},$biblio->{publishercode},$biblio->{note},'','','','','',$subscription->{biblionumber});
1012 # renew subscription
1015 SET startdate=?,numberlength=?,weeklength=?,monthlength=?
1016 WHERE subscriptionid=?
1018 $sth=$dbh->prepare($query);
1019 $sth->execute(format_date_in_iso($startdate),$numberlength,$weeklength,$monthlength, $subscriptionid);
1027 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate)
1029 Create a new issue stored on the database.
1030 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1036 my ($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate) = @_;
1037 my $dbh = C4::Context->dbh;
1040 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate)
1041 VALUES (?,?,?,?,?,?)
1043 my $sth = $dbh->prepare($query);
1044 $sth->execute($serialseq,$subscriptionid,$biblionumber,$status,$publisheddate, $planneddate);
1046 SELECT missinglist,recievedlist
1047 FROM subscriptionhistory
1048 WHERE subscriptionid=?
1050 $sth = $dbh->prepare($query);
1051 $sth->execute($subscriptionid);
1052 my ($missinglist,$recievedlist) = $sth->fetchrow;
1054 $recievedlist .= ",$serialseq";
1057 $missinglist .= ",$serialseq";
1060 UPDATE subscriptionhistory
1061 SET recievedlist=?, missinglist=?
1062 WHERE subscriptionid=?
1064 $sth=$dbh->prepare($query);
1065 $sth->execute($recievedlist,$missinglist,$subscriptionid);
1068 =head2 ItemizeSerials
1072 ItemizeSerials($serialid, $info);
1073 $info is a hashref containing barcode branch, itemcallnumber, status, location
1074 $serialid the serialid
1076 1 if the itemize is a succes.
1077 0 and @error else. @error containts the list of errors found.
1082 sub ItemizeSerials {
1083 my ($serialid, $info) =@_;
1084 my $dbh= C4::Context->dbh;
1090 my $sth=$dbh->prepare($query);
1091 $sth->execute($serialid);
1092 my $data=$sth->fetchrow_hashref;
1093 my $bibid=MARCfind_MARCbibid_from_oldbiblionumber($dbh,$data->{biblionumber});
1094 my $fwk=MARCfind_frameworkcode($dbh,$bibid);
1095 if ($info->{barcode}){
1097 my $exists = itemdata($info->{'barcode'});
1098 push @errors,"barcode_not_unique" if($exists);
1100 my $marcrecord = MARC::Record->new();
1101 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.barcode",$fwk);
1102 my $newField = MARC::Field->new(
1104 "$subfield" => $info->{barcode}
1106 $marcrecord->insert_fields_ordered($newField);
1107 if ($info->{branch}){
1108 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.homebranch",$fwk);
1109 #warn "items.homebranch : $tag , $subfield";
1110 if ($marcrecord->field($tag)) {
1111 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{branch})
1113 my $newField = MARC::Field->new(
1115 "$subfield" => $info->{branch}
1117 $marcrecord->insert_fields_ordered($newField);
1119 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.holdingbranch",$fwk);
1120 #warn "items.holdingbranch : $tag , $subfield";
1121 if ($marcrecord->field($tag)) {
1122 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{branch})
1124 my $newField = MARC::Field->new(
1126 "$subfield" => $info->{branch}
1128 $marcrecord->insert_fields_ordered($newField);
1131 if ($info->{itemcallnumber}){
1132 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.itemcallnumber",$fwk);
1133 #warn "items.itemcallnumber : $tag , $subfield";
1134 if ($marcrecord->field($tag)) {
1135 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{itemcallnumber})
1137 my $newField = MARC::Field->new(
1139 "$subfield" => $info->{itemcallnumber}
1141 $marcrecord->insert_fields_ordered($newField);
1144 if ($info->{notes}){
1145 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.itemnotes",$fwk);
1146 # warn "items.itemnotes : $tag , $subfield";
1147 if ($marcrecord->field($tag)) {
1148 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{notes})
1150 my $newField = MARC::Field->new(
1152 "$subfield" => $info->{notes}
1154 $marcrecord->insert_fields_ordered($newField);
1157 if ($info->{location}){
1158 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.location",$fwk);
1159 # warn "items.location : $tag , $subfield";
1160 if ($marcrecord->field($tag)) {
1161 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{location})
1163 my $newField = MARC::Field->new(
1165 "$subfield" => $info->{location}
1167 $marcrecord->insert_fields_ordered($newField);
1170 if ($info->{status}){
1171 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.notforloan",$fwk);
1172 # warn "items.notforloan : $tag , $subfield";
1173 if ($marcrecord->field($tag)) {
1174 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{status})
1176 my $newField = MARC::Field->new(
1178 "$subfield" => $info->{status}
1180 $marcrecord->insert_fields_ordered($newField);
1183 NEWnewitem($dbh,$marcrecord,$bibid);
1190 =head2 HasSubscriptionExpired
1194 1 or 0 = HasSubscriptionExpired($subscriptionid)
1196 the subscription has expired when the next issue to arrive is out of subscription limit.
1199 1 if true, 0 if false.
1204 sub HasSubscriptionExpired {
1205 my ($subscriptionid) = @_;
1206 my $dbh = C4::Context->dbh;
1207 my $subscription = GetSubscription($subscriptionid);
1208 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1209 if ($subscription->{numberlength}) {
1213 WHERE subscriptionid=? AND planneddate>=?
1215 my $sth = $dbh->prepare($query);
1216 $sth->execute($subscriptionid,$subscription->{startdate});
1217 my $res = $sth->fetchrow;
1218 if ($subscription->{numberlength}>=$res) {
1224 #a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
1226 SELECT max(planneddate)
1228 WHERE subscriptionid=?
1230 my $sth = $dbh->prepare($query);
1231 $sth->execute($subscriptionid);
1232 my $res = ParseDate(format_date_in_iso($sth->fetchrow));
1233 my $endofsubscriptiondate;
1234 $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
1235 $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
1236 return 1 if ($res >= $endofsubscriptiondate);
1241 =head2 SetDistributedto
1245 SetDistributedto($distributedto,$subscriptionid);
1246 This function update the value of distributedto for a subscription given on input arg.
1251 sub SetDistributedto {
1252 my ($distributedto,$subscriptionid) = @_;
1253 my $dbh = C4::Context->dbh;
1257 WHERE subscriptionid=?
1259 my $sth = $dbh->prepare($query);
1260 $sth->execute($distributedto,$subscriptionid);
1263 =head2 DelSubscription
1267 DelSubscription($subscriptionid)
1268 this function delete the subscription which has $subscriptionid as id.
1273 sub DelSubscription {
1274 my ($subscriptionid) = @_;
1275 my $dbh = C4::Context->dbh;
1276 $subscriptionid=$dbh->quote($subscriptionid);
1277 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1278 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1279 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1286 DelIssue($serialseq,$subscriptionid)
1287 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1293 my ($serialseq,$subscriptionid) = @_;
1294 my $dbh = C4::Context->dbh;
1298 AND subscriptionid= ?
1300 my $sth = $dbh->prepare($query);
1301 $sth->execute($serialseq,$subscriptionid);
1304 END { } # module clean-up code here (global destructor)