C4/Serials.pm

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