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