C4/Serials.pm

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