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