Adding some fields in GetSubscriptions
[koha.git] / C4 / Serials.pm
1 package C4::Serials;    #assumes C4/Serials.pm
2
3 # Copyright 2000-2002 Katipo Communications
4 #
5 # This file is part of Koha.
6 #
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
10 # version.
11 #
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.
15 #
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
19
20
21 use strict;
22 use C4::Dates qw(format_date);
23 use Date::Calc qw(:all);
24 use POSIX qw(strftime);
25 use C4::Suggestions;
26 use C4::Koha;
27 use C4::Biblio;
28 use C4::Items;
29 use C4::Search;
30 use C4::Letters;
31 use C4::Log; # logaction
32 use C4::Debug;
33
34 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
35
36 BEGIN {
37         $VERSION = 3.01;        # set version for version checking
38         require Exporter;
39         @ISA    = qw(Exporter);
40         @EXPORT = qw(
41     &NewSubscription    &ModSubscription    &DelSubscription    &GetSubscriptions
42     &GetSubscription    &CountSubscriptionFromBiblionumber      &GetSubscriptionsFromBiblionumber
43     &GetFullSubscriptionsFromBiblionumber   &GetFullSubscription &ModSubscriptionHistory
44     &HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
45     
46     &GetNextSeq         &NewIssue           &ItemizeSerials    &GetSerials
47     &GetLatestSerials   &ModSerialStatus    &GetNextDate       &GetSerials2
48     &ReNewSubscription  &GetLateIssues      &GetLateOrMissingIssues
49     &GetSerialInformation                   &AddItem2Serial
50     &PrepareSerialsData &GetNextExpected    &ModNextExpected
51     
52     &UpdateClaimdateIssues
53     &GetSuppliersWithLateIssues             &getsupplierbyserialid
54     &GetDistributedTo   &SetDistributedTo
55     &getroutinglist     &delroutingmember   &addroutingmember
56     &reorder_members
57     &check_routing &updateClaim &removeMissingIssue
58     &CountIssues
59
60         );
61 }
62
63 =head2 GetSuppliersWithLateIssues
64
65 =head1 NAME
66
67 C4::Serials - Give functions for serializing.
68
69 =head1 SYNOPSIS
70
71   use C4::Serials;
72
73 =head1 DESCRIPTION
74
75 Give all XYZ functions
76
77 =head1 FUNCTIONS
78
79 =over 4
80
81 %supplierlist = &GetSuppliersWithLateIssues
82
83 this function get all suppliers with late issues.
84
85 return :
86 the supplierlist into a hash. this hash containts id & name of the supplier
87
88 =back
89
90 =cut
91
92 sub GetSuppliersWithLateIssues {
93     my $dbh   = C4::Context->dbh;
94     my $query = qq|
95         SELECT DISTINCT id, name
96         FROM            subscription 
97         LEFT JOIN       serial ON serial.subscriptionid=subscription.subscriptionid
98         LEFT JOIN       aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
99         WHERE           subscription.subscriptionid = serial.subscriptionid
100         AND             (planneddate < now() OR serial.STATUS = 3 OR serial.STATUS = 4)
101         ORDER BY name
102     |;
103     my $sth = $dbh->prepare($query);
104     $sth->execute;
105     my %supplierlist;
106     while ( my ( $id, $name ) = $sth->fetchrow ) {
107         $supplierlist{$id} = $name;
108     }
109     return %supplierlist;
110 }
111
112 =head2 GetLateIssues
113
114 =over 4
115
116 @issuelist = &GetLateIssues($supplierid)
117
118 this function select late issues on database
119
120 return :
121 the issuelist into an table. Each line of this table containts a ref to a hash which it containts
122 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
123
124 =back
125
126 =cut
127
128 sub GetLateIssues {
129     my ($supplierid) = @_;
130     my $dbh = C4::Context->dbh;
131     my $sth;
132     if ($supplierid) {
133         my $query = qq|
134             SELECT     name,title,planneddate,serialseq,serial.subscriptionid
135             FROM       subscription
136             LEFT JOIN  serial ON subscription.subscriptionid = serial.subscriptionid
137             LEFT JOIN  biblio ON biblio.biblionumber = subscription.biblionumber
138             LEFT JOIN  aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
139             WHERE      ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
140             AND        subscription.aqbooksellerid=$supplierid
141             ORDER BY   title
142         |;
143         $sth = $dbh->prepare($query);
144     }
145     else {
146         my $query = qq|
147             SELECT     name,title,planneddate,serialseq,serial.subscriptionid
148             FROM       subscription
149             LEFT JOIN  serial ON subscription.subscriptionid = serial.subscriptionid
150             LEFT JOIN  biblio ON biblio.biblionumber = subscription.biblionumber
151             LEFT JOIN  aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
152             WHERE      ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
153             ORDER BY   title
154         |;
155         $sth = $dbh->prepare($query);
156     }
157     $sth->execute;
158     my @issuelist;
159     my $last_title;
160     my $odd   = 0;
161     my $count = 0;
162     while ( my $line = $sth->fetchrow_hashref ) {
163         $odd++ unless $line->{title} eq $last_title;
164         $line->{title} = "" if $line->{title} eq $last_title;
165         $last_title = $line->{title} if ( $line->{title} );
166         $line->{planneddate} = format_date( $line->{planneddate} );
167         $count++;
168         push @issuelist, $line;
169     }
170     return $count, @issuelist;
171 }
172
173 =head2 GetSubscriptionHistoryFromSubscriptionId
174
175 =over 4
176
177 $sth = GetSubscriptionHistoryFromSubscriptionId()
178 this function just prepare the SQL request.
179 After this function, don't forget to execute it by using $sth->execute($subscriptionid)
180 return :
181 $sth = $dbh->prepare($query).
182
183 =back
184
185 =cut
186
187 sub GetSubscriptionHistoryFromSubscriptionId() {
188     my $dbh   = C4::Context->dbh;
189     my $query = qq|
190         SELECT *
191         FROM   subscriptionhistory
192         WHERE  subscriptionid = ?
193     |;
194     return $dbh->prepare($query);
195 }
196
197 =head2 GetSerialStatusFromSerialId
198
199 =over 4
200
201 $sth = GetSerialStatusFromSerialId();
202 this function just prepare the SQL request.
203 After this function, don't forget to execute it by using $sth->execute($serialid)
204 return :
205 $sth = $dbh->prepare($query).
206
207 =back
208
209 =cut
210
211 sub GetSerialStatusFromSerialId() {
212     my $dbh   = C4::Context->dbh;
213     my $query = qq|
214         SELECT status
215         FROM   serial
216         WHERE  serialid = ?
217     |;
218     return $dbh->prepare($query);
219 }
220
221 =head2 GetSerialInformation
222
223 =over 4
224
225 $data = GetSerialInformation($serialid);
226 returns a hash containing :
227   items : items marcrecord (can be an array)
228   serial table field
229   subscription table field
230   + information about subscription expiration
231   
232 =back
233
234 =cut
235
236 sub GetSerialInformation {
237     my ($serialid) = @_;
238     my $dbh        = C4::Context->dbh;
239     my $query      = qq|
240         SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid |;
241        if (C4::Context->preference('IndependantBranches') && 
242               C4::Context->userenv && 
243               C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
244                 $query.="
245       , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
246         }
247             $query .= qq|             
248         FROM   serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
249         WHERE  serialid = ?
250     |;
251     my $rq = $dbh->prepare($query);
252     $rq->execute($serialid);
253     my $data = $rq->fetchrow_hashref;
254     # create item information if we have serialsadditems for this subscription
255     if ( $data->{'serialsadditems'} ) {
256         my $queryitem=$dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
257         $queryitem->execute($serialid);
258         my $itemnumbers=$queryitem->fetchall_arrayref([0]);
259         if (scalar(@$itemnumbers)>0){
260             foreach my $itemnum (@$itemnumbers) {
261                 #It is ASSUMED that GetMarcItem ALWAYS WORK...
262                 #Maybe GetMarcItem should return values on failure
263                 $debug and warn "itemnumber :$itemnum->[0], bibnum :".$data->{'biblionumber'};
264                 my $itemprocessed =
265                   PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0] , $data );
266                 $itemprocessed->{'itemnumber'}   = $itemnum->[0];
267                 $itemprocessed->{'itemid'}       = $itemnum->[0];
268                 $itemprocessed->{'serialid'}     = $serialid;
269                 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
270                 push @{ $data->{'items'} }, $itemprocessed;
271             }
272         }
273         else {
274             my $itemprocessed =
275               PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
276             $itemprocessed->{'itemid'}       = "N$serialid";
277             $itemprocessed->{'serialid'}     = $serialid;
278             $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
279             $itemprocessed->{'countitems'}   = 0;
280             push @{ $data->{'items'} }, $itemprocessed;
281         }
282     }
283     $data->{ "status" . $data->{'serstatus'} } = 1;
284     $data->{'subscriptionexpired'} =
285       HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'}==1;
286     $data->{'abouttoexpire'} =
287       abouttoexpire( $data->{'subscriptionid'} );
288     return $data;
289 }
290
291 =head2 AddItem2Serial
292
293 =over 4
294
295 $data = AddItem2Serial($serialid,$itemnumber);
296 Adds an itemnumber to Serial record
297
298 =back
299
300 =cut
301
302 sub AddItem2Serial {
303     my ( $serialid, $itemnumber ) = @_;
304     my $dbh   = C4::Context->dbh;
305     my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
306     $rq->execute($serialid, $itemnumber);
307     return $rq->rows;
308 }
309
310 =head2 UpdateClaimdateIssues
311
312 =over 4
313
314 UpdateClaimdateIssues($serialids,[$date]);
315
316 Update Claimdate for issues in @$serialids list with date $date 
317 (Take Today if none)
318
319 =back
320
321 =cut
322
323 sub UpdateClaimdateIssues {
324     my ( $serialids, $date ) = @_;
325     my $dbh   = C4::Context->dbh;
326     $date = strftime("%Y-%m-%d",localtime) unless ($date);
327     my $query = "
328         UPDATE serial SET claimdate=$date,status=7
329         WHERE  serialid in (".join (",",@$serialids) .")";
330     my $rq = $dbh->prepare($query);
331     $rq->execute;
332     return $rq->rows;
333 }
334
335 =head2 GetSubscription
336
337 =over 4
338
339 $subs = GetSubscription($subscriptionid)
340 this function get the subscription which has $subscriptionid as id.
341 return :
342 a hashref. This hash containts
343 subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
344
345 =back
346
347 =cut
348
349 sub GetSubscription {
350     my ($subscriptionid) = @_;
351     my $dbh              = C4::Context->dbh;
352     my $query            = qq(
353         SELECT  subscription.*,
354                 subscriptionhistory.*,
355                 aqbooksellers.name AS aqbooksellername,
356                 biblio.title AS bibliotitle,
357                 subscription.biblionumber as bibnum);
358        if (C4::Context->preference('IndependantBranches') && 
359               C4::Context->userenv && 
360               C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
361                 $query.="
362       , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
363         }
364             $query .= qq(             
365        FROM subscription
366        LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
367        LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
368        LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
369        WHERE subscription.subscriptionid = ?
370     );
371 #     if (C4::Context->preference('IndependantBranches') && 
372 #         C4::Context->userenv && 
373 #         C4::Context->userenv->{'flags'} != 1){
374 # #       $debug and warn "flags: ".C4::Context->userenv->{'flags'};
375 #       $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
376 #     }
377         $debug and warn "query : $query\nsubsid :$subscriptionid";
378     my $sth = $dbh->prepare($query);
379     $sth->execute($subscriptionid);
380     return $sth->fetchrow_hashref;
381 }
382
383 =head2 GetFullSubscription
384
385 =over 4
386
387    \@res = GetFullSubscription($subscriptionid)
388    this function read on serial table.
389
390 =back
391
392 =cut
393
394 sub GetFullSubscription {
395     my ($subscriptionid) = @_;
396     my $dbh            = C4::Context->dbh;
397     my $query          = qq|
398   SELECT    serial.serialid,
399             serial.serialseq,
400             serial.planneddate, 
401             serial.publisheddate, 
402             serial.status, 
403             serial.notes as notes,
404             year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
405             aqbooksellers.name as aqbooksellername,
406             biblio.title as bibliotitle,
407             subscription.branchcode AS branchcode,
408             subscription.subscriptionid AS subscriptionid |;
409     if (C4::Context->preference('IndependantBranches') && 
410         C4::Context->userenv && 
411         C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
412       $query.="
413       , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
414     }
415     $query.=qq|
416   FROM      serial 
417   LEFT JOIN subscription ON 
418           (serial.subscriptionid=subscription.subscriptionid )
419   LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id 
420   LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber 
421   WHERE     serial.subscriptionid = ? 
422   ORDER BY year DESC,
423           IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
424           serial.subscriptionid
425           |;
426         $debug and warn "GetFullSubscription query: $query";   
427     my $sth = $dbh->prepare($query);
428     $sth->execute($subscriptionid);
429     return $sth->fetchall_arrayref({});
430 }
431
432
433 =head2 PrepareSerialsData
434
435 =over 4
436
437    \@res = PrepareSerialsData($serialinfomation)
438    where serialinformation is a hashref array
439
440 =back
441
442 =cut
443
444 sub PrepareSerialsData{
445     my ($lines)=@_;
446     my %tmpresults;
447     my $year;
448     my @res;
449     my $startdate;
450     my $aqbooksellername;
451     my $bibliotitle;
452     my @loopissues;
453     my $first;
454     my $previousnote = "";
455     
456     foreach  my $subs ( @$lines ) {
457         $subs->{'publisheddate'} =
458           ( $subs->{'publisheddate'}
459             ? format_date( $subs->{'publisheddate'} )
460             : "XXX" );
461         $subs->{'planneddate'} = format_date( $subs->{'planneddate'} );
462         $subs->{ "status" . $subs->{'status'} } = 1;
463
464 #         $subs->{'notes'} = $subs->{'notes'} eq $previousnote?"":$subs->{notes};
465         if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
466             $year = $subs->{'year'};
467         }
468         else {
469             $year = "manage";
470         }
471         if ( $tmpresults{$year} ) {
472             push @{ $tmpresults{$year}->{'serials'} }, $subs;
473         }
474         else {
475             $tmpresults{$year} = {
476                 'year' => $year,
477
478                 #               'startdate'=>format_date($subs->{'startdate'}),
479                 'aqbooksellername' => $subs->{'aqbooksellername'},
480                 'bibliotitle'      => $subs->{'bibliotitle'},
481                 'serials'          => [$subs],
482                 'first'            => $first,
483 #                 'branchcode'       => $subs->{'branchcode'},
484 #                 'subscriptionid'   => $subs->{'subscriptionid'},
485             };
486         }
487
488         #         $previousnote=$subs->{notes};
489     }
490     foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
491         push @res, $tmpresults{$key};
492     }
493     $res[0]->{'first'}=1;  
494     return \@res;
495 }
496
497 =head2 GetSubscriptionsFromBiblionumber
498
499 \@res = GetSubscriptionsFromBiblionumber($biblionumber)
500 this function get the subscription list. it reads on subscription table.
501 return :
502 table of subscription which has the biblionumber given on input arg.
503 each line of this table is a hashref. All hashes containt
504 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
505
506 =cut
507
508 sub GetSubscriptionsFromBiblionumber {
509     my ($biblionumber) = @_;
510     my $dbh            = C4::Context->dbh;
511     my $query          = qq(
512         SELECT subscription.*,
513                branches.branchname,
514                subscriptionhistory.*,
515                aqbooksellers.name AS aqbooksellername,
516                biblio.title AS bibliotitle
517        FROM subscription
518        LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
519        LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
520        LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
521        LEFT JOIN branches ON branches.branchcode=subscription.branchcode
522        WHERE subscription.biblionumber = ?
523     );
524 #     if (C4::Context->preference('IndependantBranches') && 
525 #         C4::Context->userenv && 
526 #         C4::Context->userenv->{'flags'} != 1){
527 #        $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
528 #     }
529     my $sth = $dbh->prepare($query);
530     $sth->execute($biblionumber);
531     my @res;
532     while ( my $subs = $sth->fetchrow_hashref ) {
533         $subs->{startdate}     = format_date( $subs->{startdate} );
534         $subs->{histstartdate} = format_date( $subs->{histstartdate} );
535         $subs->{histenddate} = format_date( $subs->{histenddate} );
536         $subs->{opacnote}     =~ s/\n/\<br\/\>/g;
537         $subs->{missinglist}  =~ s/\n/\<br\/\>/g;
538         $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
539         $subs->{ "periodicity" . $subs->{periodicity} } = 1;
540         $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
541         $subs->{ "status" . $subs->{'status'} } = 1;
542         $subs->{'cannotedit'}=(C4::Context->preference('IndependantBranches') && 
543                 C4::Context->userenv && 
544                 C4::Context->userenv->{flags} % 2 !=1  && 
545                 C4::Context->userenv->{branch} && $subs->{branchcode} &&
546                 (C4::Context->userenv->{branch} ne $subs->{branchcode}));
547         if ( $subs->{enddate} eq '0000-00-00' ) {
548             $subs->{enddate} = '';
549         }
550         else {
551             $subs->{enddate} = format_date( $subs->{enddate} );
552         }
553         $subs->{'abouttoexpire'}=abouttoexpire($subs->{'subscriptionid'});
554         $subs->{'subscriptionexpired'}=HasSubscriptionExpired($subs->{'subscriptionid'});
555         push @res, $subs;
556     }
557     return \@res;
558 }
559
560 =head2 GetFullSubscriptionsFromBiblionumber
561
562 =over 4
563
564    \@res = GetFullSubscriptionsFromBiblionumber($biblionumber)
565    this function read on serial table.
566
567 =back
568
569 =cut
570
571 sub GetFullSubscriptionsFromBiblionumber {
572     my ($biblionumber) = @_;
573     my $dbh            = C4::Context->dbh;
574     my $query          = qq|
575   SELECT    serial.serialid,
576             serial.serialseq,
577             serial.planneddate, 
578             serial.publisheddate, 
579             serial.status, 
580             serial.notes as notes,
581             year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
582             biblio.title as bibliotitle,
583             subscription.branchcode AS branchcode,
584             subscription.subscriptionid AS subscriptionid|;
585      if (C4::Context->preference('IndependantBranches') && 
586         C4::Context->userenv && 
587         C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
588       $query.="
589       , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
590      }
591       
592      $query.=qq|      
593   FROM      serial 
594   LEFT JOIN subscription ON 
595           (serial.subscriptionid=subscription.subscriptionid)
596   LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id 
597   LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber 
598   WHERE     subscription.biblionumber = ? 
599   ORDER BY year DESC,
600           IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
601           serial.subscriptionid
602           |;
603     my $sth = $dbh->prepare($query);
604     $sth->execute($biblionumber);
605     return $sth->fetchall_arrayref({});
606 }
607
608 =head2 GetSubscriptions
609
610 =over 4
611
612 @results = GetSubscriptions($title,$ISSN,$biblionumber);
613 this function get all subscriptions which has title like $title,ISSN like $ISSN and biblionumber like $biblionumber.
614 return:
615 a table of hashref. Each hash containt the subscription.
616
617 =back
618
619 =cut
620
621 sub GetSubscriptions {
622     my ( $string, $issn,$biblionumber) = @_;
623     #return unless $title or $ISSN or $biblionumber;
624     my $dbh = C4::Context->dbh;
625     my $sth;
626     my $sql = qq(
627             SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
628             FROM   subscription
629             LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
630             LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
631     );
632         my @bind_params;
633         my $sqlwhere;
634     if ($biblionumber) {
635         $sqlwhere="   WHERE biblio.biblionumber=?";
636                 push @bind_params,$biblionumber;
637     }
638     if ($string){
639                 my @sqlstrings; 
640                 my @strings_to_search;
641                 @strings_to_search=map {"%$_%"} split (/ /,$string);
642                 foreach my $index qw(biblio.title subscription.callnumber subscription.location subscription.notes subscription.internalnotes){
643                                 push @bind_params,@strings_to_search; 
644                                 my $tmpstring= "AND $index LIKE ? "x scalar(@strings_to_search);
645                                 $debug && warn "$tmpstring";
646                                 $tmpstring=~s/^AND //;
647                                 push @sqlstrings,$tmpstring;
648                 }
649                 $sqlwhere.= ($sqlwhere?" AND ":" WHERE ")."(".join(") OR (",@sqlstrings).")";
650         }
651     if ($issn){
652                 my @sqlstrings; 
653                 my @strings_to_search;
654                 @strings_to_search=map {"%$_%"} split (/ /,$issn);
655                 foreach my $index qw(biblioitems.issn){
656                                 push @bind_params,@strings_to_search; 
657                                 my $tmpstring= "OR $index LIKE ? "x scalar(@strings_to_search);
658                                 $debug && warn "$tmpstring";
659                                 $tmpstring=~s/^OR //;
660                                 push @sqlstrings,$tmpstring;
661                 }
662                 $sqlwhere.= ($sqlwhere?" AND ":" WHERE ")."(".join(") OR (",@sqlstrings).")";
663         }    
664         $sql.="$sqlwhere ORDER BY title";
665     $debug and warn "GetSubscriptions query: $sql params : ", join (" ",@bind_params);
666     $sth = $dbh->prepare($sql);
667     $sth->execute(@bind_params);
668     my @results;
669     my $previoustitle = "";
670     my $odd           = 1;
671     while ( my $line = $sth->fetchrow_hashref ) {
672         if ( $previoustitle eq $line->{title} ) {
673             $line->{title}  = "";
674             $line->{issn}   = "";
675         }
676         else {
677             $previoustitle = $line->{title};
678             $odd           = -$odd;
679         }
680         $line->{toggle} = 1 if $odd == 1;
681         $line->{'cannotedit'}=(C4::Context->preference('IndependantBranches') && 
682                 C4::Context->userenv && 
683                 C4::Context->userenv->{flags} % 2 !=1  && 
684                 C4::Context->userenv->{branch} && $line->{branchcode} &&
685                 (C4::Context->userenv->{branch} ne $line->{branchcode}));
686         push @results, $line;
687     }
688     return @results;
689 }
690
691 =head2 GetSerials
692
693 =over 4
694
695 ($totalissues,@serials) = GetSerials($subscriptionid);
696 this function get every serial not arrived for a given subscription
697 as well as the number of issues registered in the database (all types)
698 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
699
700 FIXME: We should return \@serials.
701
702 =back
703
704 =cut
705
706 sub GetSerials {
707     my ($subscriptionid,$count) = @_;
708     my $dbh = C4::Context->dbh;
709
710     # status = 2 is "arrived"
711     my $counter = 0;
712     $count=5 unless ($count);
713     my @serials;
714     my $query =
715       "SELECT serialid,serialseq, status, publisheddate, planneddate,notes, routingnotes
716                         FROM   serial
717                         WHERE  subscriptionid = ? AND status NOT IN (2,4,5) 
718                         ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
719     my $sth = $dbh->prepare($query);
720     $sth->execute($subscriptionid);
721     while ( my $line = $sth->fetchrow_hashref ) {
722         $line->{ "status" . $line->{status} } =
723           1;    # fills a "statusX" value, used for template status select list
724         $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
725         $line->{"planneddate"}   = format_date( $line->{"planneddate"} );
726         push @serials, $line;
727     }
728     # OK, now add the last 5 issues arrives/missing
729     $query =
730       "SELECT   serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
731        FROM     serial
732        WHERE    subscriptionid = ?
733        AND      (status in (2,4,5))
734        ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
735       ";
736     $sth = $dbh->prepare($query);
737     $sth->execute($subscriptionid);
738     while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
739         $counter++;
740         $line->{ "status" . $line->{status} } =
741           1;    # fills a "statusX" value, used for template status select list
742         $line->{"planneddate"}   = format_date( $line->{"planneddate"} );
743         $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
744         push @serials, $line;
745     }
746
747     $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
748     $sth = $dbh->prepare($query);
749     $sth->execute($subscriptionid);
750     my ($totalissues) = $sth->fetchrow;
751     return ( $totalissues, @serials );
752 }
753
754 =head2 GetSerials2
755
756 =over 4
757
758 ($totalissues,@serials) = GetSerials2($subscriptionid,$status);
759 this function get every serial waited for a given subscription
760 as well as the number of issues registered in the database (all types)
761 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
762
763 =back
764
765 =cut
766 sub GetSerials2 {
767     my ($subscription,$status) = @_;
768     my $dbh = C4::Context->dbh;
769     my $query = qq|
770                  SELECT   serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
771                  FROM     serial 
772                  WHERE    subscriptionid=$subscription AND status IN ($status)
773                  ORDER BY publisheddate,serialid DESC
774                     |;
775         $debug and warn "GetSerials2 query: $query";
776     my $sth=$dbh->prepare($query);
777     $sth->execute;
778     my @serials;
779     while(my $line = $sth->fetchrow_hashref) {
780         $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
781         $line->{"planneddate"} = format_date($line->{"planneddate"});
782         $line->{"publisheddate"} = format_date($line->{"publisheddate"});
783         push @serials,$line;
784     }
785     my ($totalissues) = scalar(@serials);
786     return ($totalissues,@serials);
787 }
788
789 =head2 GetLatestSerials
790
791 =over 4
792
793 \@serials = GetLatestSerials($subscriptionid,$limit)
794 get the $limit's latest serials arrived or missing for a given subscription
795 return :
796 a ref to a table which it containts all of the latest serials stored into a hash.
797
798 =back
799
800 =cut
801
802 sub GetLatestSerials {
803     my ( $subscriptionid, $limit ) = @_;
804     my $dbh = C4::Context->dbh;
805
806     # status = 2 is "arrived"
807     my $strsth = "SELECT   serialid,serialseq, status, planneddate, notes
808                         FROM     serial
809                         WHERE    subscriptionid = ?
810                         AND      (status =2 or status=4)
811                         ORDER BY planneddate DESC LIMIT 0,$limit
812                 ";
813     my $sth = $dbh->prepare($strsth);
814     $sth->execute($subscriptionid);
815     my @serials;
816     while ( my $line = $sth->fetchrow_hashref ) {
817         $line->{ "status" . $line->{status} } =
818           1;    # fills a "statusX" value, used for template status select list
819         $line->{"planneddate"} = format_date( $line->{"planneddate"} );
820         push @serials, $line;
821     }
822
823     #     my $query = qq|
824     #         SELECT count(*)
825     #         FROM   serial
826     #         WHERE  subscriptionid=?
827     #     |;
828     #     $sth=$dbh->prepare($query);
829     #     $sth->execute($subscriptionid);
830     #     my ($totalissues) = $sth->fetchrow;
831     return \@serials;
832 }
833
834 =head2 GetDistributedTo
835
836 =over 4
837
838 $distributedto=GetDistributedTo($subscriptionid)
839 This function select the old previous value of distributedto in the database.
840
841 =back
842
843 =cut
844
845 sub GetDistributedTo {
846     my $dbh = C4::Context->dbh;
847     my $distributedto;
848     my $subscriptionid = @_;
849     my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
850     my $sth   = $dbh->prepare($query);
851     $sth->execute($subscriptionid);
852     return ($distributedto) = $sth->fetchrow;
853 }
854
855 =head2 GetNextSeq
856
857 =over 4
858
859 GetNextSeq($val)
860 $val is a hashref containing all the attributes of the table 'subscription'
861 This function get the next issue for the subscription given on input arg
862 return:
863 all the input params updated.
864
865 =back
866
867 =cut
868
869 # sub GetNextSeq {
870 #     my ($val) =@_;
871 #     my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
872 #     $calculated = $val->{numberingmethod};
873 # # calculate the (expected) value of the next issue recieved.
874 #     $newlastvalue1 = $val->{lastvalue1};
875 # # check if we have to increase the new value.
876 #     $newinnerloop1 = $val->{innerloop1}+1;
877 #     $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
878 #     $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
879 #     $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
880 #     $calculated =~ s/\{X\}/$newlastvalue1/g;
881 #
882 #     $newlastvalue2 = $val->{lastvalue2};
883 # # check if we have to increase the new value.
884 #     $newinnerloop2 = $val->{innerloop2}+1;
885 #     $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
886 #     $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
887 #     $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
888 #     $calculated =~ s/\{Y\}/$newlastvalue2/g;
889 #
890 #     $newlastvalue3 = $val->{lastvalue3};
891 # # check if we have to increase the new value.
892 #     $newinnerloop3 = $val->{innerloop3}+1;
893 #     $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
894 #     $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
895 #     $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
896 #     $calculated =~ s/\{Z\}/$newlastvalue3/g;
897 #     return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
898 # }
899
900 sub GetNextSeq {
901     my ($val) = @_;
902     my (
903         $calculated,    $newlastvalue1, $newlastvalue2, $newlastvalue3,
904         $newinnerloop1, $newinnerloop2, $newinnerloop3
905     );
906     my $pattern = $val->{numberpattern};
907     my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
908     my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
909     $calculated    = $val->{numberingmethod};
910     $newlastvalue1 = $val->{lastvalue1};
911     $newlastvalue2 = $val->{lastvalue2};
912     $newlastvalue3 = $val->{lastvalue3};
913   $newlastvalue1 = $val->{lastvalue1};
914   # check if we have to increase the new value.
915   $newinnerloop1 = $val->{innerloop1} + 1;
916   $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
917   $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
918   $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
919   $calculated =~ s/\{X\}/$newlastvalue1/g;
920   
921   $newlastvalue2 = $val->{lastvalue2};
922   # check if we have to increase the new value.
923   $newinnerloop2 = $val->{innerloop2} + 1;
924   $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
925   $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
926   $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
927   if ( $pattern == 6 ) {
928     if ( $val->{hemisphere} == 2 ) {
929        my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
930        $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
931     }
932     else {
933        my $newlastvalue2seq = $seasons[$newlastvalue2];
934        $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
935     }
936   }
937   else {
938     $calculated =~ s/\{Y\}/$newlastvalue2/g;
939   }
940   
941   
942   $newlastvalue3 = $val->{lastvalue3};
943   # check if we have to increase the new value.
944   $newinnerloop3 = $val->{innerloop3} + 1;
945   $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
946   $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
947   $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
948   $calculated =~ s/\{Z\}/$newlastvalue3/g;
949     
950   return ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3 ,
951            $newinnerloop1, $newinnerloop2, $newinnerloop3);
952 }
953
954 =head2 GetSeq
955
956 =over 4
957
958 $calculated = GetSeq($val)
959 $val is a hashref containing all the attributes of the table 'subscription'
960 this function transforms {X},{Y},{Z} to 150,0,0 for example.
961 return:
962 the sequence in integer format
963
964 =back
965
966 =cut
967
968 sub GetSeq {
969     my ($val)      = @_;
970     my $pattern = $val->{numberpattern};
971     my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
972     my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
973     my $calculated = $val->{numberingmethod};
974     my $x          = $val->{'lastvalue1'};
975     $calculated =~ s/\{X\}/$x/g;
976     my $newlastvalue2 = $val->{'lastvalue2'};
977     if ( $pattern == 6 ) {
978         if ( $val->{hemisphere} == 2 ) {
979             my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
980             $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
981         }
982         else {
983             my $newlastvalue2seq = $seasons[$newlastvalue2];
984             $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
985         }
986     }
987     else {
988         $calculated =~ s/\{Y\}/$newlastvalue2/g;
989     }
990     my $z = $val->{'lastvalue3'};
991     $calculated =~ s/\{Z\}/$z/g;
992     return $calculated;
993 }
994
995 =head2 GetExpirationDate
996
997 $sensddate = GetExpirationDate($subscriptionid)
998
999 this function return the expiration date for a subscription given on input args.
1000
1001 return
1002 the enddate
1003
1004 =cut
1005
1006 sub GetExpirationDate {
1007     my ($subscriptionid) = @_;
1008     my $dbh              = C4::Context->dbh;
1009     my $subscription     = GetSubscription($subscriptionid);
1010     my $enddate          = $$subscription{enddate}||$$subscription{histenddate};
1011
1012     return $enddate if ($enddate && $enddate ne "0000-00-00");
1013          
1014           # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1015          $enddate=$$subscription{startdate};
1016          my @date=split (/-/,$$subscription{startdate});
1017          return if (scalar(@date)!=3 ||not check_date(@date));
1018      if (($subscription->{periodicity} % 16) >0){
1019       if ( $subscription->{numberlength} ) {
1020           #calculate the date of the last issue.
1021           my $length = $subscription->{numberlength};
1022           for ( my $i = 1 ; $i <= $length ; $i++ ) {
1023               $enddate = GetNextDate( $enddate, $subscription );
1024           }
1025       }
1026       elsif ( $subscription->{monthlength} ){
1027                    if ($$subscription{startdate}){
1028                        my @enddate = Add_Delta_YM($date[0],$date[1],$date[2],0,$subscription->{monthlength});
1029                        $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1030                    }
1031       } elsif   ( $subscription->{weeklength} ){
1032                    if ($$subscription{startdate}){
1033                         my @date=split (/-/,$subscription->{startdate});
1034                         my @enddate = Add_Delta_Days($date[0],$date[1],$date[2],$subscription->{weeklength}*7);
1035                         $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1036                         }
1037           }
1038           return $enddate;
1039         } else {
1040        return ;  
1041     }  
1042 }
1043
1044 =head2 CountSubscriptionFromBiblionumber
1045
1046 =over 4
1047
1048 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1049 this count the number of subscription for a biblionumber given.
1050 return :
1051 the number of subscriptions with biblionumber given on input arg.
1052
1053 =back
1054
1055 =cut
1056
1057 sub CountSubscriptionFromBiblionumber {
1058     my ($biblionumber) = @_;
1059     my $dbh = C4::Context->dbh;
1060     my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1061     my $sth   = $dbh->prepare($query);
1062     $sth->execute($biblionumber);
1063     my $subscriptionsnumber = $sth->fetchrow;
1064     return $subscriptionsnumber;
1065 }
1066
1067 =head2 ModSubscriptionHistory
1068
1069 =over 4
1070
1071 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1072
1073 this function modify the history of a subscription. Put your new values on input arg.
1074
1075 =back
1076
1077 =cut
1078
1079 sub ModSubscriptionHistory {
1080     my (
1081         $subscriptionid, $histstartdate, $enddate, $recievedlist,
1082         $missinglist,    $opacnote,      $librariannote
1083     ) = @_;
1084     my $dbh   = C4::Context->dbh;
1085     my $query = "UPDATE subscriptionhistory 
1086                     SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1087                     WHERE subscriptionid=?
1088                 ";
1089     my $sth = $dbh->prepare($query);
1090     $recievedlist =~ s/^; //;
1091     $missinglist  =~ s/^; //;
1092     $opacnote     =~ s/^; //;
1093     $sth->execute(
1094         $histstartdate, $enddate,       $recievedlist, $missinglist,
1095         $opacnote,      $librariannote, $subscriptionid
1096     );
1097     return $sth->rows;
1098 }
1099
1100 =head2 ModSerialStatus
1101
1102 =over 4
1103
1104 ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes)
1105
1106 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1107 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1108
1109 =back
1110
1111 =cut
1112
1113 sub ModSerialStatus {
1114     my ( $serialid, $serialseq,  $planneddate,$publisheddate, $status, $notes )
1115       = @_;
1116
1117     #It is a usual serial
1118     # 1st, get previous status :
1119     my $dbh   = C4::Context->dbh;
1120     my $query = "SELECT subscriptionid,status FROM serial WHERE  serialid=?";
1121     my $sth   = $dbh->prepare($query);
1122     $sth->execute($serialid);
1123     my ( $subscriptionid, $oldstatus ) = $sth->fetchrow;
1124
1125     # change status & update subscriptionhistory
1126     my $val;
1127     if ( $status eq 6 ) {
1128         DelIssue( {'serialid'=>$serialid, 'subscriptionid'=>$subscriptionid,'serialseq'=>$serialseq} );
1129     }
1130     else {
1131         my $query =
1132 "UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE  serialid = ?";
1133         $sth = $dbh->prepare($query);
1134         $sth->execute( $serialseq, $publisheddate, $planneddate, $status,
1135             $notes, $serialid );
1136         $query = "SELECT * FROM   subscription WHERE  subscriptionid = ?";
1137         $sth = $dbh->prepare($query);
1138         $sth->execute($subscriptionid);
1139         my $val = $sth->fetchrow_hashref;
1140         unless ( $val->{manualhistory} ) {
1141             $query =
1142 "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE  subscriptionid=?";
1143             $sth = $dbh->prepare($query);
1144             $sth->execute($subscriptionid);
1145             my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1146             if ( $status eq 2 ) {
1147
1148                 $recievedlist .= "; $serialseq"
1149                   unless ( index( "$recievedlist", "$serialseq" ) >= 0 );
1150             }
1151
1152 #         warn "missinglist : $missinglist serialseq :$serialseq, ".index("$missinglist","$serialseq");
1153             $missinglist .= "; $serialseq"
1154               if ( $status eq 4
1155                 and not index( "$missinglist", "$serialseq" ) >= 0 );
1156             $missinglist .= "; not issued $serialseq"
1157               if ( $status eq 5
1158                 and index( "$missinglist", "$serialseq" ) >= 0 );
1159             $query =
1160 "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE  subscriptionid=?";
1161             $sth = $dbh->prepare($query);
1162             $recievedlist =~ s/^; //;
1163             $missinglist  =~ s/^; //;
1164             $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1165         }
1166     }
1167
1168     # create new waited entry if needed (ie : was a "waited" and has changed)
1169     if ( $oldstatus eq 1 && $status ne 1 ) {
1170         my $query = "SELECT * FROM   subscription WHERE  subscriptionid = ?";
1171         $sth = $dbh->prepare($query);
1172         $sth->execute($subscriptionid);
1173         my $val = $sth->fetchrow_hashref;
1174
1175         # next issue number
1176 #     warn "Next Seq";    
1177         my (
1178             $newserialseq,  $newlastvalue1, $newlastvalue2, $newlastvalue3,
1179             $newinnerloop1, $newinnerloop2, $newinnerloop3
1180         ) = GetNextSeq($val);
1181 #     warn "Next Seq End";    
1182
1183         # next date (calculated from actual date & frequency parameters)
1184 #         warn "publisheddate :$publisheddate ";
1185         my $nextpublisheddate = GetNextDate( $publisheddate, $val );
1186         NewIssue( $newserialseq, $subscriptionid, $val->{'biblionumber'},
1187             1, $nextpublisheddate, $nextpublisheddate );
1188         $query =
1189 "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1190                     WHERE  subscriptionid = ?";
1191         $sth = $dbh->prepare($query);
1192         $sth->execute(
1193             $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1,
1194             $newinnerloop2, $newinnerloop3, $subscriptionid
1195         );
1196
1197 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1198         if ( $val->{letter} && $status eq 2 && $oldstatus ne 2 ) {
1199             SendAlerts( 'issue', $val->{subscriptionid}, $val->{letter} );
1200         }
1201     }
1202 }
1203
1204 =head2 GetNextExpected
1205
1206 =over 4
1207
1208 $nextexpected = GetNextExpected($subscriptionid)
1209
1210 Get the planneddate for the current expected issue of the subscription.
1211
1212 returns a hashref:
1213
1214 $nextexepected = {
1215     serialid => int
1216     planneddate => C4::Dates object
1217     }
1218
1219 =back
1220
1221 =cut
1222
1223 sub GetNextExpected($) {
1224     my ($subscriptionid) = @_;
1225     my $dbh = C4::Context->dbh;
1226     my $sth = $dbh->prepare('SELECT serialid, planneddate FROM serial WHERE subscriptionid=? AND status=?');
1227     # Each subscription has only one 'expected' issue, with serial.status==1.
1228     $sth->execute( $subscriptionid, 1 );
1229     my ( $nextissue ) = $sth->fetchrow_hashref;
1230     if(not $nextissue){
1231          $sth = $dbh->prepare('SELECT serialid,planneddate FROM serial WHERE subscriptionid  = ? ORDER BY planneddate DESC LIMIT 1');
1232          $sth->execute( $subscriptionid );  
1233          $nextissue = $sth->fetchrow_hashref;       
1234     }
1235     $nextissue->{planneddate} = C4::Dates->new($nextissue->{planneddate},'iso');
1236     return $nextissue;
1237     
1238 }
1239 =head2 ModNextExpected
1240
1241 =over 4
1242
1243 ModNextExpected($subscriptionid,$date)
1244
1245 Update the planneddate for the current expected issue of the subscription.
1246 This will modify all future prediction results.  
1247
1248 C<$date> is a C4::Dates object.
1249
1250 =back
1251
1252 =cut
1253
1254 sub ModNextExpected($$) {
1255     my ($subscriptionid,$date) = @_;
1256     my $dbh = C4::Context->dbh;
1257     #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1258     my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1259     # Each subscription has only one 'expected' issue, with serial.status==1.
1260     $sth->execute( $date->output('iso'),$date->output('iso'), $subscriptionid, 1);
1261     return 0;
1262
1263 }
1264
1265 =head2 ModSubscription
1266
1267 =over 4
1268
1269 this function modify a subscription. Put all new values on input args.
1270
1271 =back
1272
1273 =cut
1274
1275 sub ModSubscription {
1276     my (
1277         $auser,           $branchcode,   $aqbooksellerid, $cost,
1278         $aqbudgetid,      $startdate,    $periodicity,    $firstacquidate,
1279         $dow,             $irregularity, $numberpattern,  $numberlength,
1280         $weeklength,      $monthlength,  $add1,           $every1,
1281         $whenmorethan1,   $setto1,       $lastvalue1,     $innerloop1,
1282         $add2,            $every2,       $whenmorethan2,  $setto2,
1283         $lastvalue2,      $innerloop2,   $add3,           $every3,
1284         $whenmorethan3,   $setto3,       $lastvalue3,     $innerloop3,
1285         $numberingmethod, $status,       $biblionumber,   $callnumber,
1286         $notes,           $letter,       $hemisphere,     $manualhistory,
1287         $internalnotes,   $serialsadditems,
1288         $staffdisplaycount,$opacdisplaycount, $graceperiod, $location,$enddate,$subscriptionid
1289     ) = @_;
1290 #     warn $irregularity;
1291     my $dbh   = C4::Context->dbh;
1292     my $query = "UPDATE subscription
1293                     SET librarian=?, branchcode=?,aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
1294                         periodicity=?,firstacquidate=?,dow=?,irregularity=?, numberpattern=?, numberlength=?,weeklength=?,monthlength=?,
1295                         add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
1296                         add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
1297                         add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
1298                         numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, 
1299                                                 letter=?, hemisphere=?,manualhistory=?,internalnotes=?,serialsadditems=?,
1300                                                 staffdisplaycount = ?,opacdisplaycount = ?, graceperiod = ?, location = ?
1301                                                 ,enddate=?
1302                     WHERE subscriptionid = ?";
1303      #warn "query :".$query;
1304     my $sth = $dbh->prepare($query);
1305     $sth->execute(
1306         $auser,           $branchcode,   $aqbooksellerid, $cost,
1307         $aqbudgetid,      $startdate,    $periodicity,    $firstacquidate,
1308         $dow,             "$irregularity", $numberpattern,  $numberlength,
1309         $weeklength,      $monthlength,  $add1,           $every1,
1310         $whenmorethan1,   $setto1,       $lastvalue1,     $innerloop1,
1311         $add2,            $every2,       $whenmorethan2,  $setto2,
1312         $lastvalue2,      $innerloop2,   $add3,           $every3,
1313         $whenmorethan3,   $setto3,       $lastvalue3,     $innerloop3,
1314         $numberingmethod, $status,       $biblionumber,   $callnumber,
1315         $notes,           $letter,       $hemisphere,     ($manualhistory?$manualhistory:0),
1316         $internalnotes,   $serialsadditems,
1317         $staffdisplaycount, $opacdisplaycount, $graceperiod, $location,$enddate,
1318         $subscriptionid
1319     );
1320     my $rows=$sth->rows;
1321     $sth->finish;
1322     
1323     logaction("SERIAL", "MODIFY", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1324     return $rows;
1325 }
1326
1327 =head2 NewSubscription
1328
1329 =over 4
1330
1331 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1332     $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1333     $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1334     $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1335     $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1336     $numberingmethod, $status, $notes, $serialsadditems,
1337     $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate);
1338
1339 Create a new subscription with value given on input args.
1340
1341 return :
1342 the id of this new subscription
1343
1344 =back
1345
1346 =cut
1347
1348 sub NewSubscription {
1349     my (
1350         $auser,         $branchcode,   $aqbooksellerid,  $cost,
1351         $aqbudgetid,    $biblionumber, $startdate,       $periodicity,
1352         $dow,           $numberlength, $weeklength,      $monthlength,
1353         $add1,          $every1,       $whenmorethan1,   $setto1,
1354         $lastvalue1,    $innerloop1,   $add2,            $every2,
1355         $whenmorethan2, $setto2,       $lastvalue2,      $innerloop2,
1356         $add3,          $every3,       $whenmorethan3,   $setto3,
1357         $lastvalue3,    $innerloop3,   $numberingmethod, $status,
1358         $notes,         $letter,       $firstacquidate,  $irregularity,
1359         $numberpattern, $callnumber,   $hemisphere,      $manualhistory,
1360         $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1361         $graceperiod, $location,$enddate
1362     ) = @_;
1363     my $dbh = C4::Context->dbh;
1364
1365     #save subscription (insert into database)
1366     my $query = qq|
1367         INSERT INTO subscription
1368             (librarian,branchcode,aqbooksellerid,cost,aqbudgetid,biblionumber,
1369             startdate,periodicity,dow,numberlength,weeklength,monthlength,
1370             add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
1371             add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
1372             add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
1373             numberingmethod, status, notes, letter,firstacquidate,irregularity,
1374             numberpattern, callnumber, hemisphere,manualhistory,internalnotes,serialsadditems,
1375             staffdisplaycount,opacdisplaycount,graceperiod,location,enddate)
1376         VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1377         |;
1378     my $sth = $dbh->prepare($query);
1379     $sth->execute(
1380         $auser,                         $branchcode,
1381         $aqbooksellerid,                $cost,
1382         $aqbudgetid,                    $biblionumber,
1383         $startdate, $periodicity,
1384         $dow,                           $numberlength,
1385         $weeklength,                    $monthlength,
1386         $add1,                          $every1,
1387         $whenmorethan1,                 $setto1,
1388         $lastvalue1,                    $innerloop1,
1389         $add2,                          $every2,
1390         $whenmorethan2,                 $setto2,
1391         $lastvalue2,                    $innerloop2,
1392         $add3,                          $every3,
1393         $whenmorethan3,                 $setto3,
1394         $lastvalue3,                    $innerloop3,
1395         $numberingmethod,               "$status",
1396         $notes,                         $letter,
1397         $firstacquidate,                $irregularity,
1398         $numberpattern,                 $callnumber,
1399         $hemisphere,                    $manualhistory,
1400         $internalnotes,                 $serialsadditems,
1401                 $staffdisplaycount,                             $opacdisplaycount,
1402         $graceperiod,                   $location,
1403                 $enddate
1404     );
1405
1406     #then create the 1st waited number
1407     my $subscriptionid = $dbh->{'mysql_insertid'};
1408     $query             = qq(
1409         INSERT INTO subscriptionhistory
1410             (biblionumber, subscriptionid, histstartdate,  opacnote, librariannote)
1411         VALUES (?,?,?,?,?)
1412         );
1413     $sth = $dbh->prepare($query);
1414     $sth->execute( $biblionumber, $subscriptionid,
1415         $startdate,
1416         $notes,$internalnotes );
1417
1418    # reread subscription to get a hash (for calculation of the 1st issue number)
1419     $query = qq(
1420         SELECT *
1421         FROM   subscription
1422         WHERE  subscriptionid = ?
1423     );
1424     $sth = $dbh->prepare($query);
1425     $sth->execute($subscriptionid);
1426     my $val = $sth->fetchrow_hashref;
1427
1428     # calculate issue number
1429     my $serialseq = GetSeq($val);
1430     $query     = qq|
1431         INSERT INTO serial
1432             (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1433         VALUES (?,?,?,?,?,?)
1434     |;
1435     $sth = $dbh->prepare($query);
1436     $sth->execute(
1437         "$serialseq", $subscriptionid, $biblionumber, 1,
1438         $firstacquidate,
1439         $firstacquidate
1440     );
1441     
1442     logaction("SERIAL", "ADD", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1443     
1444 #set serial flag on biblio if not already set.
1445     my ($null, ($bib)) = GetBiblio($biblionumber);
1446     if( ! $bib->{'serial'} ) {
1447         my $record = GetMarcBiblio($biblionumber);
1448         my ($tag,$subf) = GetMarcFromKohaField('biblio.serial',$bib->{'frameworkcode'});
1449         if($tag) {
1450             eval {
1451             $record->field($tag)->update( $subf => 1 );
1452             };
1453         }
1454         ModBiblio($record,$biblionumber,$bib->{'frameworkcode'});
1455     }    
1456     return $subscriptionid;
1457 }
1458
1459 =head2 ReNewSubscription
1460
1461 =over 4
1462
1463 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1464
1465 this function renew a subscription with values given on input args.
1466
1467 =back
1468
1469 =cut
1470
1471 sub ReNewSubscription {
1472     my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength,
1473         $monthlength, $note )
1474       = @_;
1475     my $dbh          = C4::Context->dbh;
1476     my $subscription = GetSubscription($subscriptionid);
1477      my $query        = qq|
1478          SELECT *
1479          FROM   biblio 
1480          LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1481          WHERE    biblio.biblionumber=?
1482      |;
1483      my $sth = $dbh->prepare($query);
1484      $sth->execute( $subscription->{biblionumber} );
1485      my $biblio = $sth->fetchrow_hashref;
1486      if (C4::Context->preference("RenewSerialAddsSuggestion")){
1487         NewSuggestion(
1488             $user,             $subscription->{bibliotitle},
1489             $biblio->{author}, $biblio->{publishercode},
1490             $biblio->{note},   '',
1491             '',                '',
1492             '',                '',
1493             $subscription->{biblionumber}
1494         );
1495     }
1496
1497     # renew subscription
1498     $query = qq|
1499         UPDATE subscription
1500         SET    startdate=?,numberlength=?,weeklength=?,monthlength=?
1501         WHERE  subscriptionid=?
1502     |;
1503     $sth = $dbh->prepare($query);
1504     $sth->execute( $startdate,
1505         $numberlength, $weeklength, $monthlength, $subscriptionid );
1506         
1507     logaction("SERIAL", "RENEW", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1508 }
1509
1510 =head2 NewIssue
1511
1512 =over 4
1513
1514 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate,  $notes)
1515
1516 Create a new issue stored on the database.
1517 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1518
1519 =back
1520
1521 =cut
1522
1523 sub NewIssue {
1524     my ( $serialseq, $subscriptionid, $biblionumber, $status, 
1525         $planneddate, $publisheddate, $notes )
1526       = @_;
1527     ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1528     
1529     my $dbh   = C4::Context->dbh;
1530     my $query = qq|
1531         INSERT INTO serial
1532             (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1533         VALUES (?,?,?,?,?,?,?)
1534     |;
1535     my $sth = $dbh->prepare($query);
1536     $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status,
1537         $publisheddate, $planneddate,$notes );
1538     my $serialid=$dbh->{'mysql_insertid'};
1539     $query = qq|
1540         SELECT missinglist,recievedlist
1541         FROM   subscriptionhistory
1542         WHERE  subscriptionid=?
1543     |;
1544     $sth = $dbh->prepare($query);
1545     $sth->execute($subscriptionid);
1546     my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1547
1548     if ( $status eq 2 ) {
1549       ### TODO Add a feature that improves recognition and description.
1550       ### As such count (serialseq) i.e. : N18,2(N19),N20
1551       ### Would use substr and index But be careful to previous presence of ()
1552         $recievedlist .= "; $serialseq" unless (index($recievedlist,$serialseq)>0);
1553     }
1554     if ( $status eq 4 ) {
1555         $missinglist .= "; $serialseq" unless (index($missinglist,$serialseq)>0);
1556     }
1557     $query = qq|
1558         UPDATE subscriptionhistory
1559         SET    recievedlist=?, missinglist=?
1560         WHERE  subscriptionid=?
1561     |;
1562     $sth = $dbh->prepare($query);
1563     $recievedlist =~ s/^; //;
1564     $missinglist  =~ s/^; //;
1565     $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1566     return $serialid;
1567 }
1568
1569 =head2 ItemizeSerials
1570
1571 =over 4
1572
1573 ItemizeSerials($serialid, $info);
1574 $info is a hashref containing  barcode branch, itemcallnumber, status, location
1575 $serialid the serialid
1576 return :
1577 1 if the itemize is a succes.
1578 0 and @error else. @error containts the list of errors found.
1579
1580 =back
1581
1582 =cut
1583
1584 sub ItemizeSerials {
1585     my ( $serialid, $info ) = @_;
1586     my $now = POSIX::strftime( "%Y-%m-%d",localtime );
1587
1588     my $dbh   = C4::Context->dbh;
1589     my $query = qq|
1590         SELECT *
1591         FROM   serial
1592         WHERE  serialid=?
1593     |;
1594     my $sth = $dbh->prepare($query);
1595     $sth->execute($serialid);
1596     my $data = $sth->fetchrow_hashref;
1597     if ( C4::Context->preference("RoutingSerials") ) {
1598
1599         # check for existing biblioitem relating to serial issue
1600         my ( $count, @results ) =
1601           GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1602         my $bibitemno = 0;
1603         for ( my $i = 0 ; $i < $count ; $i++ ) {
1604             if (  $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' ('
1605                 . $data->{'planneddate'}
1606                 . ')' )
1607             {
1608                 $bibitemno = $results[$i]->{'biblioitemnumber'};
1609                 last;
1610             }
1611         }
1612         if ( $bibitemno == 0 ) {
1613
1614     # warn "need to add new biblioitem so copy last one and make minor changes";
1615             my $sth =
1616               $dbh->prepare(
1617 "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC"
1618               );
1619             $sth->execute( $data->{'biblionumber'} );
1620             my $biblioitem = $sth->fetchrow_hashref;
1621             $biblioitem->{'volumedate'} =
1622                $data->{planneddate} ;
1623             $biblioitem->{'volumeddesc'} =
1624               $data->{serialseq} . ' ('
1625               . format_date( $data->{'planneddate'} ) . ')';
1626             $biblioitem->{'dewey'} = $info->{itemcallnumber};
1627
1628             #FIXME  HDL : I don't understand why you need to call newbiblioitem, as the biblioitem should already be somewhere.
1629             # so I comment it, we can speak of it when you want
1630             # newbiblioitems has been removed from Biblio.pm, as it has a deprecated API now
1631 #             if ( $info->{barcode} )
1632 #             {    # only make biblioitem if we are going to make item also
1633 #                 $bibitemno = newbiblioitem($biblioitem);
1634 #             }
1635         }
1636     }
1637
1638     my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1639     if ( $info->{barcode} ) {
1640         my @errors;
1641         my $exists = itemdata( $info->{'barcode'} );
1642         push @errors, "barcode_not_unique" if ($exists);
1643         unless ($exists) {
1644             my $marcrecord = MARC::Record->new();
1645             my ( $tag, $subfield ) =
1646               GetMarcFromKohaField( "items.barcode", $fwk );
1647             my $newField =
1648               MARC::Field->new( "$tag", '', '',
1649                 "$subfield" => $info->{barcode} );
1650             $marcrecord->insert_fields_ordered($newField);
1651             if ( $info->{branch} ) {
1652                 my ( $tag, $subfield ) =
1653                   GetMarcFromKohaField( "items.homebranch",
1654                     $fwk );
1655
1656                 #warn "items.homebranch : $tag , $subfield";
1657                 if ( $marcrecord->field($tag) ) {
1658                     $marcrecord->field($tag)
1659                       ->add_subfields( "$subfield" => $info->{branch} );
1660                 }
1661                 else {
1662                     my $newField =
1663                       MARC::Field->new( "$tag", '', '',
1664                         "$subfield" => $info->{branch} );
1665                     $marcrecord->insert_fields_ordered($newField);
1666                 }
1667                 ( $tag, $subfield ) =
1668                   GetMarcFromKohaField( "items.holdingbranch",
1669                     $fwk );
1670
1671                 #warn "items.holdingbranch : $tag , $subfield";
1672                 if ( $marcrecord->field($tag) ) {
1673                     $marcrecord->field($tag)
1674                       ->add_subfields( "$subfield" => $info->{branch} );
1675                 }
1676                 else {
1677                     my $newField =
1678                       MARC::Field->new( "$tag", '', '',
1679                         "$subfield" => $info->{branch} );
1680                     $marcrecord->insert_fields_ordered($newField);
1681                 }
1682             }
1683             if ( $info->{itemcallnumber} ) {
1684                 my ( $tag, $subfield ) =
1685                   GetMarcFromKohaField( "items.itemcallnumber",
1686                     $fwk );
1687
1688                 #warn "items.itemcallnumber : $tag , $subfield";
1689                 if ( $marcrecord->field($tag) ) {
1690                     $marcrecord->field($tag)
1691                       ->add_subfields( "$subfield" => $info->{itemcallnumber} );
1692                 }
1693                 else {
1694                     my $newField =
1695                       MARC::Field->new( "$tag", '', '',
1696                         "$subfield" => $info->{itemcallnumber} );
1697                     $marcrecord->insert_fields_ordered($newField);
1698                 }
1699             }
1700             if ( $info->{notes} ) {
1701                 my ( $tag, $subfield ) =
1702                   GetMarcFromKohaField( "items.itemnotes", $fwk );
1703
1704                 # warn "items.itemnotes : $tag , $subfield";
1705                 if ( $marcrecord->field($tag) ) {
1706                     $marcrecord->field($tag)
1707                       ->add_subfields( "$subfield" => $info->{notes} );
1708                 }
1709                 else {
1710                     my $newField =
1711                       MARC::Field->new( "$tag", '', '',
1712                         "$subfield" => $info->{notes} );
1713                     $marcrecord->insert_fields_ordered($newField);
1714                 }
1715             }
1716             if ( $info->{location} ) {
1717                 my ( $tag, $subfield ) =
1718                   GetMarcFromKohaField( "items.location", $fwk );
1719
1720                 # warn "items.location : $tag , $subfield";
1721                 if ( $marcrecord->field($tag) ) {
1722                     $marcrecord->field($tag)
1723                       ->add_subfields( "$subfield" => $info->{location} );
1724                 }
1725                 else {
1726                     my $newField =
1727                       MARC::Field->new( "$tag", '', '',
1728                         "$subfield" => $info->{location} );
1729                     $marcrecord->insert_fields_ordered($newField);
1730                 }
1731             }
1732             if ( $info->{status} ) {
1733                 my ( $tag, $subfield ) =
1734                   GetMarcFromKohaField( "items.notforloan",
1735                     $fwk );
1736
1737                 # warn "items.notforloan : $tag , $subfield";
1738                 if ( $marcrecord->field($tag) ) {
1739                     $marcrecord->field($tag)
1740                       ->add_subfields( "$subfield" => $info->{status} );
1741                 }
1742                 else {
1743                     my $newField =
1744                       MARC::Field->new( "$tag", '', '',
1745                         "$subfield" => $info->{status} );
1746                     $marcrecord->insert_fields_ordered($newField);
1747                 }
1748             }
1749             if ( C4::Context->preference("RoutingSerials") ) {
1750                 my ( $tag, $subfield ) =
1751                   GetMarcFromKohaField( "items.dateaccessioned",
1752                     $fwk );
1753                 if ( $marcrecord->field($tag) ) {
1754                     $marcrecord->field($tag)
1755                       ->add_subfields( "$subfield" => $now );
1756                 }
1757                 else {
1758                     my $newField =
1759                       MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1760                     $marcrecord->insert_fields_ordered($newField);
1761                 }
1762             }
1763             AddItemFromMarc( $marcrecord, $data->{'biblionumber'} );
1764             return 1;
1765         }
1766         return ( 0, @errors );
1767     }
1768 }
1769
1770 =head2 HasSubscriptionStrictlyExpired
1771
1772 =over 4
1773
1774 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1775
1776 the subscription has stricly expired when today > the end subscription date 
1777
1778 return :
1779 1 if true, 0 if false, -1 if the expiration date is not set.
1780
1781 =back
1782
1783 =cut
1784 sub HasSubscriptionStrictlyExpired {
1785     # Getting end of subscription date
1786     my ($subscriptionid) = @_;
1787     my $dbh              = C4::Context->dbh;
1788     my $subscription     = GetSubscription($subscriptionid);
1789     my $expirationdate   = GetExpirationDate($subscriptionid);
1790    
1791     # If the expiration date is set
1792     if ($expirationdate != 0) {
1793         my ($endyear, $endmonth, $endday) = split('-', $expirationdate);
1794
1795         # Getting today's date
1796         my ($nowyear, $nowmonth, $nowday) = Today();
1797
1798         # if today's date > expiration date, then the subscription has stricly expired
1799         if (Delta_Days($nowyear, $nowmonth, $nowday,
1800                          $endyear, $endmonth, $endday) < 0) {
1801             return 1;   
1802         } else {
1803             return 0;
1804         }
1805     } else {
1806         # There are some cases where the expiration date is not set
1807         # As we can't determine if the subscription has expired on a date-basis,
1808         # we return -1;
1809         return -1;
1810     }
1811 }
1812
1813 =head2 HasSubscriptionExpired
1814
1815 =over 4
1816
1817 $has_expired = HasSubscriptionExpired($subscriptionid)
1818
1819 the subscription has expired when the next issue to arrive is out of subscription limit.
1820
1821 return :
1822 0 if the subscription has not expired
1823 1 if the subscription has expired
1824 2 if has subscription does not have a valid expiration date set
1825
1826 =back
1827
1828 =cut
1829
1830 sub HasSubscriptionExpired {
1831     my ($subscriptionid) = @_;
1832     my $dbh              = C4::Context->dbh;
1833     my $subscription     = GetSubscription($subscriptionid);
1834     if (($subscription->{periodicity} % 16)>0){
1835       my $expirationdate   = GetExpirationDate($subscriptionid);
1836       my $query = qq|
1837             SELECT max(planneddate)
1838             FROM   serial
1839             WHERE  subscriptionid=?
1840       |;
1841       my $sth = $dbh->prepare($query);
1842       $sth->execute($subscriptionid);
1843       my ($res) = $sth->fetchrow  ;
1844           return 0 unless $res;
1845       my @res=split (/-/,$res);
1846       my @endofsubscriptiondate=split(/-/,$expirationdate);
1847       return 2 if (scalar(@res)!=3 || scalar(@endofsubscriptiondate)!=3||not check_date(@res) || not check_date(@endofsubscriptiondate));
1848       return 1 if ( (@endofsubscriptiondate && Delta_Days($res[0],$res[1],$res[2],
1849                   $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) <= 0)
1850                   || (!$res));
1851       return 0;
1852     } else {
1853       if ($subscription->{'numberlength'}){
1854         my $countreceived=countissuesfrom($subscriptionid,$subscription->{'startdate'});
1855         return 1 if ($countreceived >$subscription->{'numberlength'});
1856               return 0;
1857       } else {
1858               return 0;
1859       }
1860     }
1861     return 0;   # Notice that you'll never get here.
1862 }
1863
1864 =head2 SetDistributedto
1865
1866 =over 4
1867
1868 SetDistributedto($distributedto,$subscriptionid);
1869 This function update the value of distributedto for a subscription given on input arg.
1870
1871 =back
1872
1873 =cut
1874
1875 sub SetDistributedto {
1876     my ( $distributedto, $subscriptionid ) = @_;
1877     my $dbh   = C4::Context->dbh;
1878     my $query = qq|
1879         UPDATE subscription
1880         SET    distributedto=?
1881         WHERE  subscriptionid=?
1882     |;
1883     my $sth = $dbh->prepare($query);
1884     $sth->execute( $distributedto, $subscriptionid );
1885 }
1886
1887 =head2 DelSubscription
1888
1889 =over 4
1890
1891 DelSubscription($subscriptionid)
1892 this function delete the subscription which has $subscriptionid as id.
1893
1894 =back
1895
1896 =cut
1897
1898 sub DelSubscription {
1899     my ($subscriptionid) = @_;
1900     my $dbh = C4::Context->dbh;
1901     $subscriptionid = $dbh->quote($subscriptionid);
1902     $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1903     $dbh->do(
1904         "DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1905     $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1906     
1907     logaction("SERIAL", "DELETE", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1908 }
1909
1910 =head2 DelIssue
1911
1912 =over 4
1913
1914 DelIssue($serialseq,$subscriptionid)
1915 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1916
1917 =back
1918
1919 =cut
1920
1921 sub DelIssue {
1922     my ( $dataissue) = @_;
1923     my $dbh   = C4::Context->dbh;
1924     ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1925     
1926     my $query = qq|
1927         DELETE FROM serial
1928         WHERE       serialid= ?
1929         AND         subscriptionid= ?
1930     |;
1931     my $mainsth = $dbh->prepare($query);
1932     $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'});
1933
1934     #Delete element from subscription history
1935     $query = "SELECT * FROM   subscription WHERE  subscriptionid = ?";
1936     my $sth   = $dbh->prepare($query);
1937     $sth->execute($dataissue->{'subscriptionid'});
1938     my $val = $sth->fetchrow_hashref;
1939     unless ( $val->{manualhistory} ) {
1940         my $query = qq|
1941           SELECT * FROM subscriptionhistory
1942           WHERE       subscriptionid= ?
1943       |;
1944         my $sth = $dbh->prepare($query);
1945         $sth->execute($dataissue->{'subscriptionid'});
1946         my $data = $sth->fetchrow_hashref;
1947         my $serialseq= $dataissue->{'serialseq'};
1948         $data->{'missinglist'}  =~ s/\b$serialseq\b//;
1949         $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1950         my $strsth = "UPDATE subscriptionhistory SET "
1951           . join( ",",
1952             map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data )
1953           . " WHERE subscriptionid=?";
1954         $sth = $dbh->prepare($strsth);
1955         $sth->execute($dataissue->{'subscriptionid'});
1956     }
1957     
1958     return $mainsth->rows;
1959 }
1960
1961 =head2 GetLateOrMissingIssues
1962
1963 =over 4
1964
1965 ($count,@issuelist) = &GetLateMissingIssues($supplierid,$serialid)
1966
1967 this function select missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1968
1969 return :
1970 a count of the number of missing issues
1971 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1972 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1973
1974 =back
1975
1976 =cut
1977
1978 sub GetLateOrMissingIssues {
1979     my ( $supplierid, $serialid,$order ) = @_;
1980     my $dbh = C4::Context->dbh;
1981     my $sth;
1982     my $byserial = '';
1983     if ($serialid) {
1984         $byserial = "and serialid = " . $serialid;
1985     }
1986     if ($order){
1987       $order.=", title";
1988     } else {
1989       $order="title";
1990     }
1991     if ($supplierid) {
1992         $sth = $dbh->prepare(
1993 "SELECT
1994    serialid,
1995    aqbooksellerid,
1996    name,
1997    biblio.title,
1998    planneddate,
1999    serialseq,
2000    serial.status,
2001    serial.subscriptionid,
2002    claimdate
2003 FROM      serial 
2004 LEFT JOIN subscription  ON serial.subscriptionid=subscription.subscriptionid 
2005 LEFT JOIN biblio        ON subscription.biblionumber=biblio.biblionumber
2006 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
2007 WHERE subscription.subscriptionid = serial.subscriptionid 
2008 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3 OR serial.STATUS = 7))
2009 AND subscription.aqbooksellerid=$supplierid
2010 $byserial
2011 ORDER BY $order"
2012         );
2013     }
2014     else {
2015         $sth = $dbh->prepare(
2016 "SELECT 
2017    serialid,
2018    aqbooksellerid,
2019    name,
2020    biblio.title,
2021    planneddate,
2022    serialseq,
2023    serial.status,
2024    serial.subscriptionid,
2025    claimdate
2026 FROM serial 
2027 LEFT JOIN subscription 
2028 ON serial.subscriptionid=subscription.subscriptionid 
2029 LEFT JOIN biblio 
2030 ON subscription.biblionumber=biblio.biblionumber
2031 LEFT JOIN aqbooksellers 
2032 ON subscription.aqbooksellerid = aqbooksellers.id
2033 WHERE 
2034    subscription.subscriptionid = serial.subscriptionid 
2035 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3 OR serial.STATUS = 7))
2036 $byserial
2037 ORDER BY $order"
2038         );
2039     }
2040     $sth->execute;
2041     my @issuelist;
2042     my $last_title;
2043     my $odd   = 0;
2044     my $count = 0;
2045     while ( my $line = $sth->fetchrow_hashref ) {
2046         $odd++ unless $line->{title} eq $last_title;
2047         $last_title = $line->{title} if ( $line->{title} );
2048         $line->{planneddate} = format_date( $line->{planneddate} );
2049         $line->{claimdate}   = format_date( $line->{claimdate} );
2050         $line->{"status".$line->{status}}   = 1;
2051         $line->{'odd'} = 1 if $odd % 2;
2052         $count++;
2053         push @issuelist, $line;
2054     }
2055     return $count, @issuelist;
2056 }
2057
2058 =head2 removeMissingIssue
2059
2060 =over 4
2061
2062 removeMissingIssue($subscriptionid)
2063
2064 this function removes an issue from being part of the missing string in 
2065 subscriptionlist.missinglist column
2066
2067 called when a missing issue is found from the serials-recieve.pl file
2068
2069 =back
2070
2071 =cut
2072
2073 sub removeMissingIssue {
2074     my ( $sequence, $subscriptionid ) = @_;
2075     my $dbh = C4::Context->dbh;
2076     my $sth =
2077       $dbh->prepare(
2078         "SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
2079     $sth->execute($subscriptionid);
2080     my $data              = $sth->fetchrow_hashref;
2081     my $missinglist       = $data->{'missinglist'};
2082     my $missinglistbefore = $missinglist;
2083
2084     # warn $missinglist." before";
2085     $missinglist =~ s/($sequence)//;
2086
2087     # warn $missinglist." after";
2088     if ( $missinglist ne $missinglistbefore ) {
2089         $missinglist =~ s/\|\s\|/\|/g;
2090         $missinglist =~ s/^\| //g;
2091         $missinglist =~ s/\|$//g;
2092         my $sth2 = $dbh->prepare(
2093             "UPDATE subscriptionhistory
2094                                        SET missinglist = ?
2095                                        WHERE subscriptionid = ?"
2096         );
2097         $sth2->execute( $missinglist, $subscriptionid );
2098     }
2099 }
2100
2101 =head2 updateClaim
2102
2103 =over 4
2104
2105 &updateClaim($serialid)
2106
2107 this function updates the time when a claim is issued for late/missing items
2108
2109 called from claims.pl file
2110
2111 =back
2112
2113 =cut
2114
2115 sub updateClaim {
2116     my ($serialid) = @_;
2117     my $dbh        = C4::Context->dbh;
2118     my $sth        = $dbh->prepare(
2119         "UPDATE serial SET claimdate = now()
2120                                    WHERE serialid = ?
2121                                    "
2122     );
2123     $sth->execute($serialid);
2124 }
2125
2126 =head2 getsupplierbyserialid
2127
2128 =over 4
2129
2130 ($result) = &getsupplierbyserialid($serialid)
2131
2132 this function is used to find the supplier id given a serial id
2133
2134 return :
2135 hashref containing serialid, subscriptionid, and aqbooksellerid
2136
2137 =back
2138
2139 =cut
2140
2141 sub getsupplierbyserialid {
2142     my ($serialid) = @_;
2143     my $dbh        = C4::Context->dbh;
2144     my $sth        = $dbh->prepare(
2145         "SELECT serialid, serial.subscriptionid, aqbooksellerid
2146          FROM serial 
2147          LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2148          WHERE serialid = ?
2149                                    "
2150     );
2151     $sth->execute($serialid);
2152     my $line   = $sth->fetchrow_hashref;
2153     my $result = $line->{'aqbooksellerid'};
2154     return $result;
2155 }
2156
2157 =head2 check_routing
2158
2159 =over 4
2160
2161 ($result) = &check_routing($subscriptionid)
2162
2163 this function checks to see if a serial has a routing list and returns the count of routingid
2164 used to show either an 'add' or 'edit' link
2165
2166 =back
2167
2168 =cut
2169
2170 sub check_routing {
2171     my ($subscriptionid) = @_;
2172     my $dbh              = C4::Context->dbh;
2173     my $sth              = $dbh->prepare(
2174 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist 
2175                               ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2176                               WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2177                               "
2178     );
2179     $sth->execute($subscriptionid);
2180     my $line   = $sth->fetchrow_hashref;
2181     my $result = $line->{'routingids'};
2182     return $result;
2183 }
2184
2185 =head2 addroutingmember
2186
2187 =over 4
2188
2189 &addroutingmember($borrowernumber,$subscriptionid)
2190
2191 this function takes a borrowernumber and subscriptionid and add the member to the
2192 routing list for that serial subscription and gives them a rank on the list
2193 of either 1 or highest current rank + 1
2194
2195 =back
2196
2197 =cut
2198
2199 sub addroutingmember {
2200     my ( $borrowernumber, $subscriptionid ) = @_;
2201     my $rank;
2202     my $dbh = C4::Context->dbh;
2203     my $sth =
2204       $dbh->prepare(
2205 "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?"
2206       );
2207     $sth->execute($subscriptionid);
2208     while ( my $line = $sth->fetchrow_hashref ) {
2209         if ( $line->{'rank'} > 0 ) {
2210             $rank = $line->{'rank'} + 1;
2211         }
2212         else {
2213             $rank = 1;
2214         }
2215     }
2216     $sth =
2217       $dbh->prepare(
2218 "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)"
2219       );
2220     $sth->execute( $subscriptionid, $borrowernumber, $rank );
2221 }
2222
2223 =head2 reorder_members
2224
2225 =over 4
2226
2227 &reorder_members($subscriptionid,$routingid,$rank)
2228
2229 this function is used to reorder the routing list
2230
2231 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2232 - it gets all members on list puts their routingid's into an array
2233 - removes the one in the array that is $routingid
2234 - then reinjects $routingid at point indicated by $rank
2235 - then update the database with the routingids in the new order
2236
2237 =back
2238
2239 =cut
2240
2241 sub reorder_members {
2242     my ( $subscriptionid, $routingid, $rank ) = @_;
2243     my $dbh = C4::Context->dbh;
2244     my $sth =
2245       $dbh->prepare(
2246 "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC"
2247       );
2248     $sth->execute($subscriptionid);
2249     my @result;
2250     while ( my $line = $sth->fetchrow_hashref ) {
2251         push( @result, $line->{'routingid'} );
2252     }
2253
2254     # To find the matching index
2255     my $i;
2256     my $key = -1;    # to allow for 0 being a valid response
2257     for ( $i = 0 ; $i < @result ; $i++ ) {
2258         if ( $routingid == $result[$i] ) {
2259             $key = $i;    # save the index
2260             last;
2261         }
2262     }
2263
2264     # if index exists in array then move it to new position
2265     if ( $key > -1 && $rank > 0 ) {
2266         my $new_rank = $rank -
2267           1;    # $new_rank is what you want the new index to be in the array
2268         my $moving_item = splice( @result, $key, 1 );
2269         splice( @result, $new_rank, 0, $moving_item );
2270     }
2271     for ( my $j = 0 ; $j < @result ; $j++ ) {
2272         my $sth =
2273           $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '"
2274               . ( $j + 1 )
2275               . "' WHERE routingid = '"
2276               . $result[$j]
2277               . "'" );
2278         $sth->execute;
2279     }
2280 }
2281
2282 =head2 delroutingmember
2283
2284 =over 4
2285
2286 &delroutingmember($routingid,$subscriptionid)
2287
2288 this function either deletes one member from routing list if $routingid exists otherwise
2289 deletes all members from the routing list
2290
2291 =back
2292
2293 =cut
2294
2295 sub delroutingmember {
2296
2297 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2298     my ( $routingid, $subscriptionid ) = @_;
2299     my $dbh = C4::Context->dbh;
2300     if ($routingid) {
2301         my $sth =
2302           $dbh->prepare(
2303             "DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2304         $sth->execute($routingid);
2305         reorder_members( $subscriptionid, $routingid );
2306     }
2307     else {
2308         my $sth =
2309           $dbh->prepare(
2310             "DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2311         $sth->execute($subscriptionid);
2312     }
2313 }
2314
2315 =head2 getroutinglist
2316
2317 =over 4
2318
2319 ($count,@routinglist) = &getroutinglist($subscriptionid)
2320
2321 this gets the info from the subscriptionroutinglist for $subscriptionid
2322
2323 return :
2324 a count of the number of members on routinglist
2325 the routinglist into a table. Each line of this table containts a ref to a hash which containts
2326 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2327
2328 =back
2329
2330 =cut
2331
2332 sub getroutinglist {
2333     my ($subscriptionid) = @_;
2334     my $dbh              = C4::Context->dbh;
2335     my $sth              = $dbh->prepare(
2336         "SELECT routingid, borrowernumber,
2337                               ranking, biblionumber 
2338          FROM subscription 
2339          LEFT JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2340          WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2341                               "
2342     );
2343     $sth->execute($subscriptionid);
2344     my @routinglist;
2345     my $count = 0;
2346     while ( my $line = $sth->fetchrow_hashref ) {
2347         $count++;
2348         push( @routinglist, $line );
2349     }
2350     return ( $count, @routinglist );
2351 }
2352
2353 =head2 countissuesfrom
2354
2355 =over 4
2356
2357 $result = &countissuesfrom($subscriptionid,$startdate)
2358
2359
2360 =back
2361
2362 =cut
2363
2364 sub countissuesfrom {
2365     my ($subscriptionid,$startdate) = @_;
2366     my $dbh              = C4::Context->dbh;
2367     my $query = qq|
2368             SELECT count(*)
2369             FROM   serial
2370             WHERE  subscriptionid=?
2371             AND serial.publisheddate>?
2372         |;
2373     my $sth=$dbh->prepare($query);
2374     $sth->execute($subscriptionid, $startdate);
2375     my ($countreceived)=$sth->fetchrow;
2376     return $countreceived;  
2377 }
2378
2379 =head2 CountIssues
2380
2381 =over 4
2382
2383 $result = &CountIssues($subscriptionid)
2384
2385
2386 =back
2387
2388 =cut
2389
2390 sub CountIssues {
2391     my ($subscriptionid) = @_;
2392     my $dbh              = C4::Context->dbh;
2393     my $query = qq|
2394             SELECT count(*)
2395             FROM   serial
2396             WHERE  subscriptionid=?
2397         |;
2398     my $sth=$dbh->prepare($query);
2399     $sth->execute($subscriptionid);
2400     my ($countreceived)=$sth->fetchrow;
2401     return $countreceived;  
2402 }
2403
2404 =head2 abouttoexpire
2405
2406 =over 4
2407
2408 $result = &abouttoexpire($subscriptionid)
2409
2410 this function alerts you to the penultimate issue for a serial subscription
2411
2412 returns 1 - if this is the penultimate issue
2413 returns 0 - if not
2414
2415 =back
2416
2417 =cut
2418
2419 sub abouttoexpire {
2420     my ($subscriptionid) = @_;
2421     my $dbh              = C4::Context->dbh;
2422     my $subscription     = GetSubscription($subscriptionid);
2423     my $per = $subscription->{'periodicity'};
2424     if ($per % 16>0){
2425       my $expirationdate   = GetExpirationDate($subscriptionid);
2426       my $sth =
2427         $dbh->prepare(
2428           "select max(planneddate) from serial where subscriptionid=?");
2429       $sth->execute($subscriptionid);
2430       my ($res) = $sth->fetchrow ;
2431 #        warn "date expiration : ".$expirationdate." date courante ".$res;
2432       my @res=split (/-/,$res);
2433       @res=Date::Calc::Today if ($res[0]*$res[1]==0);
2434       my @endofsubscriptiondate=split(/-/,$expirationdate);
2435       my $x;
2436       if ( $per == 1 ) {$x=7;}
2437       if ( $per == 2 ) {$x=7; }
2438       if ( $per == 3 ) {$x=14;}
2439       if ( $per == 4 ) { $x = 21; }
2440       if ( $per == 5 ) { $x = 31; }
2441       if ( $per == 6 ) { $x = 62; }
2442       if ( $per == 7 || $per == 8 ) { $x = 93; }
2443       if ( $per == 9 )  { $x = 190; }
2444       if ( $per == 10 ) { $x = 365; }
2445       if ( $per == 11 ) { $x = 730; }
2446       my @datebeforeend=Add_Delta_Days(  $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
2447                     - (3 * $x)) if (@endofsubscriptiondate && $endofsubscriptiondate[0]*$endofsubscriptiondate[1]*$endofsubscriptiondate[2]);
2448               # warn "DATE BEFORE END: $datebeforeend";
2449       return 1 if ( @res && 
2450                     (@datebeforeend && 
2451                         Delta_Days($res[0],$res[1],$res[2],
2452                         $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) && 
2453                     (@endofsubscriptiondate && 
2454                         Delta_Days($res[0],$res[1],$res[2],
2455                         $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
2456     return 0;
2457    } elsif ($subscription->{numberlength}>0) {
2458     return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2459    } else {return 0}
2460 }
2461
2462
2463 =head2 GetNextDate
2464
2465 ($resultdate) = &GetNextDate($planneddate,$subscription)
2466
2467 this function is an extension of GetNextDate which allows for checking for irregularity
2468
2469 it takes the planneddate and will return the next issue's date and will skip dates if there
2470 exists an irregularity
2471 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be 
2472 skipped then the returned date will be 2007-05-10
2473
2474 return :
2475 $resultdate - then next date in the sequence
2476
2477 Return 0 if periodicity==0
2478
2479 =cut
2480 sub in_array { # used in next sub down
2481   my ($val,@elements) = @_;
2482   foreach my $elem(@elements) {
2483     if($val == $elem) {
2484             return 1;
2485     }
2486   }
2487   return 0;
2488 }
2489
2490 sub GetNextDate(@) {
2491     my ( $planneddate, $subscription ) = @_;
2492     my @irreg = split( /\,/, $subscription->{irregularity} );
2493
2494     #date supposed to be in ISO.
2495     
2496     my ( $year, $month, $day ) = split(/-/, $planneddate);
2497     $month=1 unless ($month);
2498     $day=1 unless ($day);
2499     my @resultdate;
2500
2501     #       warn "DOW $dayofweek";
2502     if ( $subscription->{periodicity} % 16 == 0 ) {  # 'without regularity' || 'irregular'
2503       return 0;
2504     }  
2505     #   daily : n / week
2506     #   Since we're interpreting irregularity here as which days of the week to skip an issue,
2507     #   renaming this pattern from 1/day to " n / week ".
2508     if ( $subscription->{periodicity} == 1 ) {  
2509         my $dayofweek = eval{Day_of_Week( $year,$month, $day )};
2510         if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2511         else {    
2512           for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2513               $dayofweek = 0 if ( $dayofweek == 7 ); 
2514               if ( in_array( ($dayofweek + 1), @irreg ) ) {
2515                   ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 1 );
2516                   $dayofweek++;
2517               }
2518           }
2519           @resultdate = Add_Delta_Days($year,$month, $day , 1 );
2520         }    
2521     }
2522     #   1  week
2523     if ( $subscription->{periodicity} == 2 ) {
2524         my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2525         if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2526         else {    
2527           for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2528           #FIXME: if two consecutive irreg, do we only skip one?
2529               if ( $irreg[$i] == (($wkno!=51)?($wkno +1) % 52 :52)) {
2530                   ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 7 );
2531                   $wkno=(($wkno!=51)?($wkno +1) % 52 :52);
2532               }
2533           }
2534           @resultdate = Add_Delta_Days( $year,$month, $day, 7);
2535         }        
2536     }
2537     #   1 / 2 weeks
2538     if ( $subscription->{periodicity} == 3 ) {        
2539         my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2540         if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2541         else {    
2542           for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2543               if ( $irreg[$i] == (($wkno!=50)?($wkno +2) % 52 :52)) {
2544               ### BUGFIX was previously +1 ^
2545                   ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 14 );
2546                   $wkno=(($wkno!=50)?($wkno +2) % 52 :52);
2547               }
2548           }
2549           @resultdate = Add_Delta_Days($year,$month, $day , 14 );
2550         }        
2551     }
2552     #   1 / 3 weeks
2553     if ( $subscription->{periodicity} == 4 ) {
2554         my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2555         if ($@){warn "annĂ©e mois jour : $year $month $day $subscription->{subscriptionid} : $@";}
2556         else {    
2557           for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2558               if ( $irreg[$i] == (($wkno!=49)?($wkno +3) % 52 :52)) {
2559                   ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 21 );
2560                   $wkno=(($wkno!=49)?($wkno +3) % 52 :52);
2561               }
2562           }
2563           @resultdate = Add_Delta_Days($year,$month, $day , 21 );
2564         }        
2565     }
2566     my $tmpmonth=$month;
2567     if ($year && $month && $day){
2568     if ( $subscription->{periodicity} == 5 ) {
2569           for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2570               if ( $irreg[$i] == (($tmpmonth!=11)?($tmpmonth +1) % 12 :12)) {
2571                   ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2572                   $tmpmonth=(($tmpmonth!=11)?($tmpmonth +1) % 12 :12);
2573               }
2574           }        
2575           @resultdate = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2576     }
2577     if ( $subscription->{periodicity} == 6 ) {
2578           for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2579               if ( $irreg[$i] == (($tmpmonth!=10)?($tmpmonth +2) % 12 :12)) {
2580                   ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,2,0 );
2581                   $tmpmonth=(($tmpmonth!=10)?($tmpmonth + 2) % 12 :12);
2582               }
2583           }
2584           @resultdate = Add_Delta_YMD($year,$month, $day, 0, 2,0 );
2585     }
2586     if ( $subscription->{periodicity} == 7 ) {
2587         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2588             if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2589                 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2590                 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2591             }
2592         }
2593         @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2594     }
2595     if ( $subscription->{periodicity} == 8 ) {
2596         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2597             if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2598                 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2599                 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2600             }
2601         }
2602         @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2603     }
2604     if ( $subscription->{periodicity} == 9 ) {
2605         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2606             if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2607             ### BUFIX Seems to need more Than One ?
2608                 ($year,$month,$day) = Add_Delta_YM($year,$month, $day, 0, 6 );
2609                 $tmpmonth=(($tmpmonth!=6)?($tmpmonth + 6) % 12 :12);
2610             }
2611         }
2612         @resultdate = Add_Delta_YM($year,$month, $day, 0, 6);
2613     }
2614     if ( $subscription->{periodicity} == 10 ) {
2615         @resultdate = Add_Delta_YM($year,$month, $day, 1, 0 );
2616     }
2617     if ( $subscription->{periodicity} == 11 ) {
2618         @resultdate = Add_Delta_YM($year,$month, $day, 2, 0 );
2619     }
2620     }  
2621     my $resultdate=sprintf("%04d-%02d-%02d",$resultdate[0],$resultdate[1],$resultdate[2]);
2622       
2623 #     warn "dateNEXTSEQ : ".$resultdate;
2624     return "$resultdate";
2625 }
2626
2627 =head2 itemdata
2628
2629   $item = &itemdata($barcode);
2630
2631 Looks up the item with the given barcode, and returns a
2632 reference-to-hash containing information about that item. The keys of
2633 the hash are the fields from the C<items> and C<biblioitems> tables in
2634 the Koha database.
2635
2636 =cut
2637
2638 #'
2639 sub itemdata {
2640     my ($barcode) = @_;
2641     my $dbh       = C4::Context->dbh;
2642     my $sth       = $dbh->prepare(
2643         "Select * from items LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber 
2644         WHERE barcode=?"
2645     );
2646     $sth->execute($barcode);
2647     my $data = $sth->fetchrow_hashref;
2648     $sth->finish;
2649     return ($data);
2650 }
2651
2652 1;
2653 __END__
2654
2655 =head1 AUTHOR
2656
2657 Koha Developement team <info@koha.org>
2658
2659 =cut