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