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