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