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