C4/Serials.pm

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