C4/Serials.pm

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