koha-dev.rot13.org Git - koha_gimpoz/blob - C4/Serials.pm

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