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