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