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