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