1 package C4::Bull; #assumes C4/Bull.pm
4 # Copyright 2000-2002 Katipo Communications
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it under the
9 # terms of the GNU General Public License as published by the Free Software
10 # Foundation; either version 2 of the License, or (at your option) any later
13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License along with
18 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
19 # Suite 330, Boston, MA 02111-1307 USA
29 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
31 # set the version for version checking
36 C4::Bull - Give functions for serializing.
44 Give all XYZ functions
49 @EXPORT = qw(&newsubscription &modsubscription &delsubscription &getsubscriptions &getsubscription
50 &getsubscriptionfrombiblionumber &get_subscription_list_from_biblionumber
51 &get_full_subscription_list_from_biblionumber
52 &modsubscriptionhistory &newissue &serialsitemize
53 &getserials &getlatestserials &serialchangestatus
54 &Find_Next_Date &Get_Next_Seq
55 &hassubscriptionexpired &subscriptionexpirationdate &subscriptionrenew
56 &getSupplierListWithLateIssues &GetLateIssues &serialdelete &getlatestserials
59 sub getSupplierListWithLateIssues {
60 my $dbh = C4::Context->dbh;
61 my $sth = $dbh->prepare("SELECT DISTINCT id, name
62 FROM subscription, serial
63 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
64 WHERE subscription.subscriptionid = serial.subscriptionid AND
65 (planneddate < now( ) OR serial.STATUS = 3)
69 while (my ($id,$name) = $sth->fetchrow) {
70 $supplierlist{$id} = $name;
75 my ($supplierid) = @_;
76 my $dbh = C4::Context->dbh;
79 $sth = $dbh->prepare("SELECT name,title,planneddate,serialseq,serial.subscriptionid
80 FROM subscription, serial, biblio
81 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
82 WHERE subscription.subscriptionid = serial.subscriptionid AND
83 ((planneddate < now() and serial.STATUS =1) OR serial.STATUS = 3) and
84 subscription.aqbooksellerid=$supplierid and
85 biblio.biblionumber = subscription.biblionumber order by title
88 $sth = $dbh->prepare("SELECT name,title,planneddate,serialseq,serial.subscriptionid
89 FROM subscription, serial, biblio
90 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
91 WHERE subscription.subscriptionid = serial.subscriptionid AND
92 ((planneddate < now() and serial.STATUS <=3) OR serial.STATUS = 3) and
93 biblio.biblionumber = subscription.biblionumber order by title
100 while (my $line = $sth->fetchrow_hashref) {
101 $odd++ unless $line->{title} eq $last_title;
102 $line->{title} = "" if $line->{title} eq $last_title;
103 $last_title = $line->{title} if ($line->{title});
104 $line->{planneddate} = format_date($line->{planneddate});
105 $line->{'odd'} = 1 if $odd %2 ;
106 push @issuelist,$line;
111 sub newsubscription {
112 my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
113 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
114 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
115 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
116 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
117 $numberingmethod, $status, $notes) = @_;
118 my $dbh = C4::Context->dbh;
120 my $sth=$dbh->prepare("insert into subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
121 startdate,periodicity,dow,numberlength,weeklength,monthlength,
122 add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
123 add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
124 add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
125 numberingmethod, status, notes) values
127 ?,?,?,?,?,?,?,?,?,?,
128 ?,?,?,?,?,?,?,?,?,?,?,?,?)");
129 $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
130 format_date_in_iso($startdate),$periodicity,$dow,$numberlength,$weeklength,$monthlength,
131 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
132 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
133 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
134 $numberingmethod, $status, $notes);
135 #then create the 1st waited number
136 my $subscriptionid = $dbh->{'mysql_insertid'};
137 $sth = $dbh->prepare("insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)");
138 $sth->execute($biblionumber, $subscriptionid, format_date_in_iso($startdate), 0, "", "", "", $notes);
139 # reread subscription to get a hash (for calculation of the 1st issue number)
140 $sth = $dbh->prepare("SELECT * from subscription where subscriptionid = ? ");
141 $sth->execute($subscriptionid);
142 my $val = $sth->fetchrow_hashref;
144 # calculate issue number
145 my $serialseq = Get_Seq($val);
146 $sth = $dbh->prepare("insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)");
147 $sth->execute($serialseq, $subscriptionid, $val->{'biblionumber'}, 1, format_date_in_iso($startdate));
148 return $subscriptionid;
151 sub getsubscription {
152 my ($subscriptionid) = @_;
153 my $dbh = C4::Context->dbh;
154 my $sth = $dbh->prepare('SELECT subscription.*,subscriptionhistory.*,aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,biblio.title as bibliotitle
156 left join subscriptionhistory on subscription.subscriptionid=subscriptionhistory.subscriptionid
157 left join aqbudget on subscription.aqbudgetid=aqbudget.aqbudgetid
158 left join aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
159 left join biblio on biblio.biblionumber=subscription.biblionumber
160 where subscription.subscriptionid = ?');
161 $sth->execute($subscriptionid);
162 my $subs = $sth->fetchrow_hashref;
166 sub getsubscriptionfrombiblionumber {
167 my ($biblionumber) = @_;
168 my $dbh = C4::Context->dbh;
169 my $sth = $dbh->prepare('SELECT count(*) from subscription where biblionumber=?');
170 $sth->execute($biblionumber);
171 my $subscriptionsnumber = $sth->fetchrow;
172 return $subscriptionsnumber;
175 sub get_subscription_list_from_biblionumber {
176 my ($biblionumber) = @_;
177 my $dbh = C4::Context->dbh;
178 my $sth = $dbh->prepare('SELECT subscription.*,subscriptionhistory.*, aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,biblio.title as bibliotitle
180 left join subscriptionhistory on subscription.subscriptionid=subscriptionhistory.subscriptionid
181 left join aqbudget on subscription.aqbudgetid=aqbudget.aqbudgetid
182 left join aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
183 left join biblio on biblio.biblionumber=subscription.biblionumber
184 where subscription.biblionumber = ?');
185 $sth->execute($biblionumber);
187 while (my $subs = $sth->fetchrow_hashref) {
188 $subs->{startdate} = format_date($subs->{startdate});
189 $subs->{histstartdate} = format_date($subs->{histstartdate});
190 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
191 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
192 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
193 $subs->{"periodicity".$subs->{periodicity}} = 1;
194 $subs->{"status".$subs->{'status'}} = 1;
195 if ($subs->{enddate} eq '0000-00-00') {
198 $subs->{enddate} = format_date($subs->{enddate});
205 sub get_full_subscription_list_from_biblionumber {
206 my ($biblionumber) = @_;
207 my $dbh = C4::Context->dbh;
208 my $sth = $dbh->prepare('
209 SELECT serial.serialseq,serial.planneddate, serial.publisheddate, serial.status, serial.notes,
210 year(serial.publisheddate) as year,
211 aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,biblio.title as bibliotitle
213 LEFT JOIN subscription ON
214 (serial.subscriptionid=subscription.subscriptionid AND subscription.biblionumber=serial.biblionumber)
215 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
216 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
217 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
218 WHERE subscription.biblionumber = ?
219 ORDER BY year,serial.publisheddate,serial.subscriptionid,serial.planneddate');
220 $sth->execute($biblionumber);
224 my $aqbooksellername;
229 while (my $subs = $sth->fetchrow_hashref) {
230 ### BUG To FIX: When there is no published date, will create many null ids!!!
232 if ($year and ($year==$subs->{year})){
233 if ($first eq 1){$first=0;}
234 my $temp=$res[scalar(@res)-1]->{'serials'};
236 {'publisheddate' =>format_date($subs->{'publisheddate'}),
237 'planneddate' => format_date($subs->{'planneddate'}),
238 'serialseq' => $subs->{'serialseq'},
239 "status".$subs->{'status'} => 1,
240 'notes' => $subs->{'notes'} eq $previousnote?"":$subs->{notes},
243 $first=1 if (not $year);
244 $year= $subs->{'year'};
245 $startdate= format_date($subs->{'startdate'});
246 $aqbooksellername= $subs->{'aqbooksellername'};
247 $bibliotitle= $subs->{'bibliotitle'};
250 {'publisheddate' =>format_date($subs->{'publisheddate'}),
251 'planneddate' => format_date($subs->{'planneddate'}),
252 'serialseq' => $subs->{'serialseq'},
253 "status".$subs->{'status'} => 1,
254 'notes' => $subs->{'notes'} eq $previousnote?"":$subs->{notes},
259 'startdate'=>$startdate,
260 'aqbooksellername'=>$aqbooksellername,
261 'bibliotitle'=>$bibliotitle,
266 $previousnote=$subs->{notes};
272 sub modsubscription {
273 my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
274 $periodicity,$dow,$numberlength,$weeklength,$monthlength,
275 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
276 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
277 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
278 $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid)= @_;
279 my $dbh = C4::Context->dbh;
280 my $sth=$dbh->prepare("update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
281 periodicity=?,dow=?,numberlength=?,weeklength=?,monthlength=?,
282 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
283 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
284 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
285 numberingmethod=?, status=?, biblionumber=?, notes=?, letter=? where subscriptionid = ?");
286 $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
287 $periodicity,$dow,$numberlength,$weeklength,$monthlength,
288 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
289 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
290 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
291 $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid);
296 sub delsubscription {
297 my ($subscriptionid) = @_;
298 my $dbh = C4::Context->dbh;
299 $subscriptionid=$dbh->quote($subscriptionid);
300 $dbh->do("delete from subscription where subscriptionid=$subscriptionid");
301 $dbh->do("delete from subscriptionhistory where subscriptionid=$subscriptionid");
302 $dbh->do("delete from serial where subscriptionid=$subscriptionid");
304 sub getsubscriptions {
305 my ($title,$ISSN,$biblionumber) = @_;
306 return unless $title or $ISSN or $biblionumber;
307 my $dbh = C4::Context->dbh;
310 $sth = $dbh->prepare("SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber from subscription,biblio,biblioitems where biblio.biblionumber = biblioitems.biblionumber and biblio.biblionumber=subscription.biblionumber and biblio.biblionumber=? order by title");
311 $sth->execute($biblionumber);
313 if ($ISSN and $title)
315 $sth = $dbh->prepare("SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber from subscription,biblio,biblioitems where biblio.biblionumber = biblioitems.biblionumber and biblio.biblionumber=subscription.biblionumber and (biblio.title like ? or biblioitems.issn = ? order by title )");
316 $sth->execute("%$title%",$ISSN);
322 $sth = $dbh->prepare("SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber from subscription,biblio,biblioitems where biblio.biblionumber = biblioitems.biblionumber and biblio.biblionumber=subscription.biblionumber and biblioitems.issn = ? order by title");
323 $sth->execute($ISSN);
327 $sth = $dbh->prepare("SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber from subscription,biblio,biblioitems where biblio.biblionumber = biblioitems.biblionumber and
328 biblio.biblionumber=subscription.biblionumber and biblio.title like ? order by title");
329 $sth->execute("%$title%");
334 my $previoustitle="";
336 while (my $line = $sth->fetchrow_hashref) {
337 if ($previoustitle eq $line->{title}) {
340 $line->{toggle} = 1 if $odd==1;
342 $previoustitle=$line->{title};
344 $line->{toggle} = 1 if $odd==1;
346 push @results, $line;
351 sub modsubscriptionhistory {
352 my ($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote)=@_;
353 my $dbh=C4::Context->dbh;
354 my $sth = $dbh->prepare("
355 UPDATE subscriptionhistory
356 SET histstartdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
357 WHERE subscriptionid=?");
358 $recievedlist =~ s/^,//g;
359 $missinglist =~ s/^,//g;
360 $opacnote =~ s/^,//g;
361 $sth->execute($histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote,$subscriptionid);
364 # get every serial not arrived for a given subscription
365 # as well as the number of issues registered in the database (all types)
366 # this number is used to see if a subscription can be deleted (=it must have only 1 issue)
368 my ($subscriptionid) = @_;
369 my $dbh = C4::Context->dbh;
370 # OK, now add the last 5 issues arrives/missing
371 my $sth=$dbh->prepare("select serialid,serialseq, status, planneddate,notes from serial where subscriptionid = ? and (status in (2,4,5)) order by serialid desc");
372 $sth->execute($subscriptionid);
375 while((my $line = $sth->fetchrow_hashref) && $counter <5) {
377 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
378 $line->{"planneddate"} = format_date($line->{"planneddate"});
382 # status = 2 is "arrived"
383 my $sth=$dbh->prepare("
384 SELECT serialid,serialseq, status, publisheddate, planneddate,notes
386 WHERE subscriptionid = ? AND status NOT IN (2,4,5)");
387 $sth->execute($subscriptionid);
388 while(my $line = $sth->fetchrow_hashref) {
389 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
390 $line->{"publisheddate"} = format_date($line->{"publisheddate"});
391 $line->{"planneddate"} = format_date($line->{"planneddate"});
394 $sth=$dbh->prepare("SELECT count(*) FROM serial WHERE subscriptionid=?");
395 $sth->execute($subscriptionid);
396 my ($totalissues) = $sth->fetchrow;
397 return ($totalissues,@serials);
400 # get the $limit's latest serials arrived or missing for a given subscription
401 sub getlatestserials{
402 my ($subscriptionid,$limit) =@_;
403 my $dbh = C4::Context->dbh;
404 # status = 2 is "arrived"
405 my $strsth="SELECT serialid,serialseq, status, planneddate FROM serial WHERE subscriptionid = ? AND (status =2 or status=4) ORDER BY planneddate DESC LIMIT 0,$limit";
406 my $sth=$dbh->prepare($strsth);
407 $sth->execute($subscriptionid);
409 while(my $line = $sth->fetchrow_hashref) {
410 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
411 $line->{"planneddate"} = format_date($line->{"planneddate"});
414 $sth=$dbh->prepare("SELECT count(*) from serial where subscriptionid=?");
415 $sth->execute($subscriptionid);
416 my ($totalissues) = $sth->fetchrow;
420 sub serialchangestatus {
421 my ($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes)=@_;
422 # warn "($serialid,$serialseq,$planneddate,$status)";
423 # 1st, get previous status : if we change from "waited" to something else, then we will have to create a new "waited" entry
424 my $dbh = C4::Context->dbh;
425 my $sth = $dbh->prepare("SELECT subscriptionid,status from serial where serialid=?");
426 $sth->execute($serialid);
427 my ($subscriptionid,$oldstatus) = $sth->fetchrow;
428 # change status & update subscriptionhistory
430 delissue($serialseq, $subscriptionid)
432 $sth = $dbh->prepare("update serial set serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? where serialid = ?");
433 $sth->execute($serialseq,$publisheddate,$planneddate,$status,$notes,$serialid);
434 $sth = $dbh->prepare("SELECT missinglist,recievedlist from subscriptionhistory where subscriptionid=?");
435 $sth->execute($subscriptionid);
436 my ($missinglist,$recievedlist) = $sth->fetchrow;
438 $recievedlist .= ",$serialseq";
440 $missinglist .= ",$serialseq" if ($status eq 4) ;
441 $missinglist .= ",not issued $serialseq" if ($status eq 5);
442 $sth=$dbh->prepare("update subscriptionhistory set recievedlist=?, missinglist=? where subscriptionid=?");
443 $sth->execute($recievedlist,$missinglist,$subscriptionid);
445 # create new waited entry if needed (ie : was a "waited" and has changed)
446 if ($oldstatus eq 1 && $status ne 1) {
447 $sth = $dbh->prepare("SELECT * from subscription where subscriptionid = ? ");
448 $sth->execute($subscriptionid);
449 my $val = $sth->fetchrow_hashref;
451 my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3) = Get_Next_Seq($val);
452 # next date (calculated from actual date & frequency parameters)
453 my $nextpublisheddate = Get_Next_Date($publisheddate,$val);
454 newissue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextpublisheddate,0);
455 $sth = $dbh->prepare("update subscription set lastvalue1=?, lastvalue2=?,lastvalue3=?,
456 innerloop1=?,innerloop2=?,innerloop3=?
457 where subscriptionid = ?");
458 $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3,$subscriptionid);
463 my ($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate) = @_;
464 my $dbh = C4::Context->dbh;
465 my $sth = $dbh->prepare("
467 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate)
468 VALUES (?,?,?,?,?,?)");
469 $sth->execute($serialseq,$subscriptionid,$biblionumber,$status,$publisheddate, $planneddate);
470 $sth = $dbh->prepare("SELECT missinglist,recievedlist from subscriptionhistory where subscriptionid=?");
471 $sth->execute($subscriptionid);
472 my ($missinglist,$recievedlist) = $sth->fetchrow;
474 $recievedlist .= ",$serialseq";
477 $missinglist .= ",$serialseq";
479 $sth=$dbh->prepare("update subscriptionhistory set recievedlist=?, missinglist=? where subscriptionid=?");
480 $sth->execute($recievedlist,$missinglist,$subscriptionid);
483 =head2 serialsitemize
485 serialitemize($serialid, $info);
486 $info is a hashref containing barcode branch, itemcallnumber, status, location
487 $serialid the serialid
490 my ($serialid, $info) =@_;
492 my $dbh= C4::Context->dbh;
493 my $sth=$dbh->prepare("SELECT * from serial WHERE serialid=?");
494 $sth->execute($serialid);
495 my $data=$sth->fetchrow_hashref;
496 my $bibid=MARCfind_MARCbibid_from_oldbiblionumber($dbh,$data->{biblionumber});
497 my $fwk=MARCfind_frameworkcode($dbh,$bibid);
498 if ($info->{barcode}){
500 my $exists = itemdata($info->{'barcode'});
501 push @errors,"barcode_not_unique" if($exists);
503 my $marcrecord = MARC::Record->new();
504 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.barcode",$fwk);
505 # warn "items.barcode : $tag , $subfield";
506 my $newField = MARC::Field->new(
508 "$subfield" => $info->{barcode}
510 $marcrecord->insert_fields_ordered($newField);
511 if ($info->{branch}){
512 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.homebranch",$fwk);
513 # warn "items.homebranch : $tag , $subfield";
514 if ($marcrecord->field($tag)) {
515 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{branch})
517 my $newField = MARC::Field->new(
519 "$subfield" => $info->{branch}
521 $marcrecord->insert_fields_ordered($newField);
523 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.holdingbranch",$fwk);
524 # warn "items.holdingbranch : $tag , $subfield";
525 if ($marcrecord->field($tag)) {
526 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{branch})
528 my $newField = MARC::Field->new(
530 "$subfield" => $info->{branch}
532 $marcrecord->insert_fields_ordered($newField);
535 if ($info->{itemcallnumber}){
536 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.itemcallnumber",$fwk);
537 # warn "items.itemcallnumber : $tag , $subfield";
538 if ($marcrecord->field($tag)) {
539 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{itemcallnumber})
541 my $newField = MARC::Field->new(
543 "$subfield" => $info->{itemcallnumber}
545 $marcrecord->insert_fields_ordered($newField);
549 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.itemnotes",$fwk);
550 # warn "items.itemnotes : $tag , $subfield";
551 if ($marcrecord->field($tag)) {
552 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{notes})
554 my $newField = MARC::Field->new(
556 "$subfield" => $info->{notes}
558 $marcrecord->insert_fields_ordered($newField);
561 if ($info->{location}){
562 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.location",$fwk);
563 # warn "items.location : $tag , $subfield";
564 if ($marcrecord->field($tag)) {
565 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{location})
567 my $newField = MARC::Field->new(
569 "$subfield" => $info->{location}
571 $marcrecord->insert_fields_ordered($newField);
574 if ($info->{status}){
575 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.notforloan",$fwk);
576 # warn "items.notforloan : $tag , $subfield";
577 if ($marcrecord->field($tag)) {
578 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{status})
580 my $newField = MARC::Field->new(
582 "$subfield" => $info->{status}
584 $marcrecord->insert_fields_ordered($newField);
587 NEWnewitem($dbh,$marcrecord,$bibid);
595 my ($serialseq,$subscriptionid) = @_;
596 my $dbh = C4::Context->dbh;
597 my $sth = $dbh->prepare("delete from serial where serialseq= ? and subscriptionid= ? ");
598 $sth->execute($serialseq,$subscriptionid);
602 sub Get_Next_Date(@) {
603 my ($planneddate,$subscription) = @_;
605 if ($subscription->{periodicity} == 1) {
606 $resultdate=DateCalc($planneddate,"1 day");
608 if ($subscription->{periodicity} == 2) {
609 $resultdate=DateCalc($planneddate,"1 week");
611 if ($subscription->{periodicity} == 3) {
612 $resultdate=DateCalc($planneddate,"2 weeks");
614 if ($subscription->{periodicity} == 4) {
615 $resultdate=DateCalc($planneddate,"3 weeks");
617 if ($subscription->{periodicity} == 5) {
618 $resultdate=DateCalc($planneddate,"1 month");
620 if ($subscription->{periodicity} == 6) {
621 $resultdate=DateCalc($planneddate,"2 months");
623 if ($subscription->{periodicity} == 7) {
624 $resultdate=DateCalc($planneddate,"3 months");
626 if ($subscription->{periodicity} == 8) {
627 $resultdate=DateCalc($planneddate,"3 months");
629 if ($subscription->{periodicity} == 9) {
630 $resultdate=DateCalc($planneddate,"6 months");
632 if ($subscription->{periodicity} == 10) {
633 $resultdate=DateCalc($planneddate,"1 year");
635 if ($subscription->{periodicity} == 11) {
636 $resultdate=DateCalc($planneddate,"2 years");
638 return format_date_in_iso($resultdate);
643 my $calculated = $val->{numberingmethod};
644 my $x=$val->{'lastvalue1'};
645 $calculated =~ s/\{X\}/$x/g;
646 my $y=$val->{'lastvalue2'};
647 $calculated =~ s/\{Y\}/$y/g;
648 my $z=$val->{'lastvalue3'};
649 $calculated =~ s/\{Z\}/$z/g;
655 my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
656 $calculated = $val->{numberingmethod};
657 # calculate the (expected) value of the next issue recieved.
658 $newlastvalue1 = $val->{lastvalue1};
659 # check if we have to increase the new value.
660 $newinnerloop1 = $val->{innerloop1}+1;
661 $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
662 $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
663 $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
664 $calculated =~ s/\{X\}/$newlastvalue1/g;
666 $newlastvalue2 = $val->{lastvalue2};
667 # check if we have to increase the new value.
668 $newinnerloop2 = $val->{innerloop2}+1;
669 $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
670 $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
671 $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
672 $calculated =~ s/\{Y\}/$newlastvalue2/g;
674 $newlastvalue3 = $val->{lastvalue3};
675 # check if we have to increase the new value.
676 $newinnerloop3 = $val->{innerloop3}+1;
677 $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
678 $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
679 $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
680 $calculated =~ s/\{Z\}/$newlastvalue3/g;
681 return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
684 # the subscription has expired when the next issue to arrive is out of subscription limit.
685 sub hassubscriptionexpired {
686 my ($subscriptionid) = @_;
687 my $dbh = C4::Context->dbh;
688 my $subscription = getsubscription($subscriptionid);
689 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
690 if ($subscription->{numberlength}) {
691 my $sth = $dbh->prepare("SELECT count(*) from serial where subscriptionid=? and planneddate>=?");
692 $sth->execute($subscriptionid,$subscription->{startdate});
693 my $res = $sth->fetchrow;
694 if ($subscription->{numberlength}>=$res) {
700 #a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
701 my $sth = $dbh->prepare("SELECT max(planneddate) from serial where subscriptionid=?");
702 $sth->execute($subscriptionid);
703 my $res = ParseDate(format_date_in_iso($sth->fetchrow));
704 my $endofsubscriptiondate;
705 $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
706 $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
707 return 1 if ($res >= $endofsubscriptiondate);
712 sub subscriptionexpirationdate {
713 my ($subscriptionid) = @_;
714 my $dbh = C4::Context->dbh;
715 my $subscription = getsubscription($subscriptionid);
716 my $enddate=$subscription->{startdate};
717 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
718 if ($subscription->{numberlength}) {
719 #calculate the date of the last issue.
720 for (my $i=1;$i<=$subscription->{numberlength};$i++) {
721 $enddate = Get_Next_Date($enddate,$subscription);
724 $enddate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
725 $enddate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
727 # $enddate=format_date_in_iso($enddate);
728 # warn "END : $enddate";
732 sub subscriptionrenew {
733 my ($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note) = @_;
734 my $dbh = C4::Context->dbh;
735 my $subscription = getsubscription($subscriptionid);
736 my $sth = $dbh->prepare("SELECT * from biblio,biblioitems where biblio.biblionumber=biblioitems.biblionumber and biblio.biblionumber=?");
737 $sth->execute($subscription->{biblionumber});
738 my $biblio = $sth->fetchrow_hashref;
739 newsuggestion($user,$subscription->{bibliotitle},$biblio->{author},$biblio->{publishercode},$biblio->{note},'','','','','',$subscription->{biblionumber});
741 $sth=$dbh->prepare("update subscription set startdate=?,numberlength=?,weeklength=?,monthlength=? where subscriptionid=?");
742 $sth->execute(format_date_in_iso($startdate),$numberlength,$weeklength,$monthlength, $subscriptionid);
744 END { } # module clean-up code here (global destructor)