C4/Serials.pm

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