C4/Serials.pm

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