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

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