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, $ccode
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             ccode             => $ccode,
1368         }
1369     )->store;
1370     # FIXME Must be $subscription->serials
1371     # FIXME We shouldn't need serial.subscription (instead use serial->subscription->biblionumber)
1372     Koha::Serials->search({ subscriptionid => $subscriptionid })->update({ biblionumber => $biblionumber });
1373
1374     logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1375
1376     $subscription->discard_changes;
1377     return $subscription;
1378 }
1379
1380 =head2 NewSubscription
1381
1382 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1383     $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1384     $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1385     $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1386     $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1387     $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate,
1388     $skip_serialseq, $itemtype, $previousitemtype);
1389
1390 Create a new subscription with value given on input args.
1391
1392 return :
1393 the id of this new subscription
1394
1395 =cut
1396
1397 sub NewSubscription {
1398     my (
1399     $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1400     $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1401     $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1402     $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1403     $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1404     $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1405     $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype, $mana_id, $ccode
1406     ) = @_;
1407     my $dbh = C4::Context->dbh;
1408
1409     my $subscription = Koha::Subscription->new(
1410         {
1411             librarian         => $auser,
1412             branchcode        => $branchcode,
1413             aqbooksellerid    => $aqbooksellerid,
1414             cost              => $cost,
1415             aqbudgetid        => $aqbudgetid,
1416             biblionumber      => $biblionumber,
1417             startdate         => $startdate,
1418             periodicity       => $periodicity,
1419             numberlength      => $numberlength,
1420             weeklength        => $weeklength,
1421             monthlength       => $monthlength,
1422             lastvalue1        => $lastvalue1,
1423             innerloop1        => $innerloop1,
1424             lastvalue2        => $lastvalue2,
1425             innerloop2        => $innerloop2,
1426             lastvalue3        => $lastvalue3,
1427             innerloop3        => $innerloop3,
1428             status            => $status,
1429             notes             => $notes,
1430             letter            => $letter,
1431             firstacquidate    => $firstacquidate,
1432             irregularity      => $irregularity,
1433             numberpattern     => $numberpattern,
1434             locale            => $locale,
1435             callnumber        => $callnumber,
1436             manualhistory     => $manualhistory,
1437             internalnotes     => $internalnotes,
1438             serialsadditems   => $serialsadditems,
1439             staffdisplaycount => $staffdisplaycount,
1440             opacdisplaycount  => $opacdisplaycount,
1441             graceperiod       => $graceperiod,
1442             location          => $location,
1443             enddate           => $enddate,
1444             skip_serialseq    => $skip_serialseq,
1445             itemtype          => $itemtype,
1446             previousitemtype  => $previousitemtype,
1447             mana_id           => $mana_id,
1448             ccode             => $ccode
1449         }
1450     )->store;
1451     $subscription->discard_changes;
1452     my $subscriptionid = $subscription->subscriptionid;
1453     my ( $query, $sth );
1454     unless ($enddate) {
1455         $enddate = GetExpirationDate( $subscriptionid, $startdate );
1456         $query = qq|
1457             UPDATE subscription
1458             SET    enddate=?
1459             WHERE  subscriptionid=?
1460         |;
1461         $sth = $dbh->prepare($query);
1462         $sth->execute( $enddate, $subscriptionid );
1463     }
1464
1465     # then create the 1st expected number
1466     $query = qq(
1467         INSERT INTO subscriptionhistory
1468             (biblionumber, subscriptionid, histstartdate, missinglist, recievedlist)
1469         VALUES (?,?,?, '', '')
1470         );
1471     $sth = $dbh->prepare($query);
1472     $sth->execute( $biblionumber, $subscriptionid, $startdate);
1473
1474     # reread subscription to get a hash (for calculation of the 1st issue number)
1475     $subscription = GetSubscription($subscriptionid); # We should not do that
1476     my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1477
1478     # calculate issue number
1479     my $serialseq = GetSeq($subscription, $pattern) || q{};
1480
1481     Koha::Serial->new(
1482         {
1483             serialseq      => $serialseq,
1484             serialseq_x    => $subscription->{'lastvalue1'},
1485             serialseq_y    => $subscription->{'lastvalue2'},
1486             serialseq_z    => $subscription->{'lastvalue3'},
1487             subscriptionid => $subscriptionid,
1488             biblionumber   => $biblionumber,
1489             status         => EXPECTED,
1490             planneddate    => $firstacquidate,
1491             publisheddate  => $firstacquidate,
1492         }
1493     )->store();
1494
1495     logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1496
1497     #set serial flag on biblio if not already set.
1498     my $biblio = Koha::Biblios->find( $biblionumber );
1499     if ( $biblio and !$biblio->serial ) {
1500         my $record = GetMarcBiblio({ biblionumber => $biblionumber });
1501         my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial' );
1502         if ($tag) {
1503             eval { $record->field($tag)->update( $subf => 1 ); };
1504         }
1505         ModBiblio( $record, $biblionumber, $biblio->frameworkcode );
1506     }
1507     return $subscriptionid;
1508 }
1509
1510 =head2 GetSubscriptionLength
1511
1512 my ($numberlength, $weeklength, $monthlength) = GetSubscriptionLength( $subtype, $sublength );
1513
1514 This function calculates the subscription length.
1515
1516 =cut
1517
1518 sub GetSubscriptionLength {
1519     my ($subtype, $length) = @_;
1520
1521     return unless looks_like_number($length);
1522
1523     return
1524     (
1525           $subtype eq 'issues' ? $length : 0,
1526           $subtype eq 'weeks'  ? $length : 0,
1527           $subtype eq 'months' ? $length : 0,
1528     );
1529 }
1530
1531
1532 =head2 ReNewSubscription
1533
1534 ReNewSubscription($params);
1535
1536 $params is a hashref with the following keys: subscriptionid, user, startdate, numberlength, weeklength, monthlength, note, branchcode
1537
1538 this function renew a subscription with values given on input args.
1539
1540 =cut
1541
1542 sub ReNewSubscription {
1543     my ( $params ) = @_;
1544     my $subscriptionid = $params->{subscriptionid};
1545     my $user           = $params->{user};
1546     my $startdate      = $params->{startdate};
1547     my $numberlength   = $params->{numberlength};
1548     my $weeklength     = $params->{weeklength};
1549     my $monthlength    = $params->{monthlength};
1550     my $note           = $params->{note};
1551     my $branchcode     = $params->{branchcode};
1552
1553     my $dbh          = C4::Context->dbh;
1554     my $subscription = GetSubscription($subscriptionid);
1555     my $query        = qq|
1556          SELECT *
1557          FROM   biblio
1558          LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1559          WHERE    biblio.biblionumber=?
1560      |;
1561     my $sth = $dbh->prepare($query);
1562     $sth->execute( $subscription->{biblionumber} );
1563     my $biblio = $sth->fetchrow_hashref;
1564
1565     if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1566         require C4::Suggestions;
1567         C4::Suggestions::NewSuggestion(
1568             {   'suggestedby'   => $user,
1569                 'title'         => $subscription->{bibliotitle},
1570                 'author'        => $biblio->{author},
1571                 'publishercode' => $biblio->{publishercode},
1572                 'note'          => $note,
1573                 'biblionumber'  => $subscription->{biblionumber},
1574                 'branchcode'    => $branchcode,
1575             }
1576         );
1577     }
1578
1579     $numberlength ||= 0; # Should not we raise an exception instead?
1580     $weeklength   ||= 0;
1581
1582     # renew subscription
1583     $query = qq|
1584         UPDATE subscription
1585         SET    startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1586         WHERE  subscriptionid=?
1587     |;
1588     $sth = $dbh->prepare($query);
1589     $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1590     my $enddate = GetExpirationDate($subscriptionid);
1591     $query = qq|
1592         UPDATE subscription
1593         SET    enddate=?
1594         WHERE  subscriptionid=?
1595     |;
1596     $sth = $dbh->prepare($query);
1597     $sth->execute( $enddate, $subscriptionid );
1598
1599     logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1600     return;
1601 }
1602
1603 =head2 NewIssue
1604
1605 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes, $routingnotes)
1606
1607 Create a new issue stored on the database.
1608 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1609 returns the serial id
1610
1611 =cut
1612
1613 sub NewIssue {
1614     my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1615         $publisheddate, $publisheddatetext, $notes, $routingnotes ) = @_;
1616     ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1617
1618     return unless ($subscriptionid);
1619
1620     my $schema = Koha::Database->new()->schema();
1621
1622     my $subscription = Koha::Subscriptions->find( $subscriptionid );
1623
1624     my $serial = Koha::Serial->new(
1625         {
1626             serialseq         => $serialseq,
1627             serialseq_x       => $subscription->lastvalue1(),
1628             serialseq_y       => $subscription->lastvalue2(),
1629             serialseq_z       => $subscription->lastvalue3(),
1630             subscriptionid    => $subscriptionid,
1631             biblionumber      => $biblionumber,
1632             status            => $status,
1633             planneddate       => $planneddate,
1634             publisheddate     => $publisheddate,
1635             publisheddatetext => $publisheddatetext,
1636             notes             => $notes,
1637             routingnotes      => $routingnotes
1638         }
1639     )->store();
1640
1641     my $serialid = $serial->id();
1642
1643     my $subscription_history = Koha::Subscription::Histories->find($subscriptionid);
1644     my $missinglist = $subscription_history->missinglist();
1645     my $recievedlist = $subscription_history->recievedlist();
1646
1647     if ( $status == ARRIVED ) {
1648         ### TODO Add a feature that improves recognition and description.
1649         ### As such count (serialseq) i.e. : N18,2(N19),N20
1650         ### Would use substr and index But be careful to previous presence of ()
1651         $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1652     }
1653     if ( grep { $_ eq $status } (MISSING_STATUSES) ) {
1654         $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1655     }
1656
1657     $recievedlist =~ s/^; //;
1658     $missinglist  =~ s/^; //;
1659
1660     $subscription_history->recievedlist($recievedlist);
1661     $subscription_history->missinglist($missinglist);
1662     $subscription_history->store();
1663
1664     return $serialid;
1665 }
1666
1667 =head2 HasSubscriptionStrictlyExpired
1668
1669 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1670
1671 the subscription has stricly expired when today > the end subscription date
1672
1673 return :
1674 1 if true, 0 if false, -1 if the expiration date is not set.
1675
1676 =cut
1677
1678 sub HasSubscriptionStrictlyExpired {
1679
1680     # Getting end of subscription date
1681     my ($subscriptionid) = @_;
1682
1683     return unless ($subscriptionid);
1684
1685     my $dbh              = C4::Context->dbh;
1686     my $subscription     = GetSubscription($subscriptionid);
1687     my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1688
1689     # If the expiration date is set
1690     if ( $expirationdate != 0 ) {
1691         my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1692
1693         # Getting today's date
1694         my ( $nowyear, $nowmonth, $nowday ) = Today();
1695
1696         # if today's date > expiration date, then the subscription has stricly expired
1697         if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1698             return 1;
1699         } else {
1700             return 0;
1701         }
1702     } else {
1703
1704         # There are some cases where the expiration date is not set
1705         # As we can't determine if the subscription has expired on a date-basis,
1706         # we return -1;
1707         return -1;
1708     }
1709 }
1710
1711 =head2 HasSubscriptionExpired
1712
1713 $has_expired = HasSubscriptionExpired($subscriptionid)
1714
1715 the subscription has expired when the next issue to arrive is out of subscription limit.
1716
1717 return :
1718 0 if the subscription has not expired
1719 1 if the subscription has expired
1720 2 if has subscription does not have a valid expiration date set
1721
1722 =cut
1723
1724 sub HasSubscriptionExpired {
1725     my ($subscriptionid) = @_;
1726
1727     return unless ($subscriptionid);
1728
1729     my $dbh              = C4::Context->dbh;
1730     my $subscription     = GetSubscription($subscriptionid);
1731     my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1732     if ( $frequency and $frequency->{unit} ) {
1733         my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1734         if (!defined $expirationdate) {
1735             $expirationdate = q{};
1736         }
1737         my $query          = qq|
1738             SELECT max(planneddate)
1739             FROM   serial
1740             WHERE  subscriptionid=?
1741       |;
1742         my $sth = $dbh->prepare($query);
1743         $sth->execute($subscriptionid);
1744         my ($res) = $sth->fetchrow;
1745         if (!$res || $res=~m/^0000/) {
1746             return 0;
1747         }
1748         my @res                   = split( /-/, $res );
1749         my @endofsubscriptiondate = split( /-/, $expirationdate );
1750         return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1751         return 1
1752           if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1753             || ( !$res ) );
1754         return 0;
1755     } else {
1756         # Irregular
1757         if ( $subscription->{'numberlength'} ) {
1758             my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1759             return 1 if ( $countreceived > $subscription->{'numberlength'} );
1760             return 0;
1761         } else {
1762             return 0;
1763         }
1764     }
1765     return 0;    # Notice that you'll never get here.
1766 }
1767
1768 =head2 DelSubscription
1769
1770 DelSubscription($subscriptionid)
1771 this function deletes subscription which has $subscriptionid as id.
1772
1773 =cut
1774
1775 sub DelSubscription {
1776     my ($subscriptionid) = @_;
1777     my $dbh = C4::Context->dbh;
1778     $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1779
1780     Koha::AdditionalFieldValues->search({
1781         'field.tablename' => 'subscription',
1782         'me.record_id' => $subscriptionid,
1783     }, { join => 'field' })->delete;
1784
1785     logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1786 }
1787
1788 =head2 DelIssue
1789
1790 DelIssue($serialseq,$subscriptionid)
1791 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1792
1793 returns the number of rows affected
1794
1795 =cut
1796
1797 sub DelIssue {
1798     my ($dataissue) = @_;
1799     my $dbh = C4::Context->dbh;
1800     ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1801
1802     my $query = qq|
1803         DELETE FROM serial
1804         WHERE       serialid= ?
1805         AND         subscriptionid= ?
1806     |;
1807     my $mainsth = $dbh->prepare($query);
1808     $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1809
1810     #Delete element from subscription history
1811     $query = "SELECT * FROM   subscription WHERE  subscriptionid = ?";
1812     my $sth = $dbh->prepare($query);
1813     $sth->execute( $dataissue->{'subscriptionid'} );
1814     my $val = $sth->fetchrow_hashref;
1815     unless ( $val->{manualhistory} ) {
1816         my $query = qq|
1817           SELECT * FROM subscriptionhistory
1818           WHERE       subscriptionid= ?
1819       |;
1820         my $sth = $dbh->prepare($query);
1821         $sth->execute( $dataissue->{'subscriptionid'} );
1822         my $data      = $sth->fetchrow_hashref;
1823         my $serialseq = $dataissue->{'serialseq'};
1824         $data->{'missinglist'}  =~ s/\b$serialseq\b//;
1825         $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1826         my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1827         $sth = $dbh->prepare($strsth);
1828         $sth->execute( $dataissue->{'subscriptionid'} );
1829     }
1830
1831     return $mainsth->rows;
1832 }
1833
1834 =head2 GetLateOrMissingIssues
1835
1836 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1837
1838 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1839
1840 return :
1841 the issuelist as an array of hash refs. Each element of this array contains
1842 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1843
1844 =cut
1845
1846 sub GetLateOrMissingIssues {
1847     my ( $supplierid, $serialid, $order ) = @_;
1848
1849     return unless ( $supplierid or $serialid );
1850
1851     my $dbh = C4::Context->dbh;
1852
1853     my $sth;
1854     my $byserial = '';
1855     if ($serialid) {
1856         $byserial = "and serialid = " . $serialid;
1857     }
1858     if ($order) {
1859         $order .= ", title";
1860     } else {
1861         $order = "title";
1862     }
1863     my $missing_statuses_string = join ',', (MISSING_STATUSES);
1864     if ($supplierid) {
1865         $sth = $dbh->prepare(
1866             "SELECT
1867                 serialid,      aqbooksellerid,        name,
1868                 biblio.title,  biblioitems.issn,      planneddate,    serialseq,
1869                 serial.status, serial.subscriptionid, claimdate, claims_count,
1870                 subscription.branchcode
1871             FROM      serial
1872                 LEFT JOIN subscription  ON serial.subscriptionid=subscription.subscriptionid
1873                 LEFT JOIN biblio        ON subscription.biblionumber=biblio.biblionumber
1874                 LEFT JOIN biblioitems   ON subscription.biblionumber=biblioitems.biblionumber
1875                 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1876                 WHERE subscription.subscriptionid = serial.subscriptionid
1877                 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1878                 AND subscription.aqbooksellerid=$supplierid
1879                 $byserial
1880                 ORDER BY $order"
1881         );
1882     } else {
1883         $sth = $dbh->prepare(
1884             "SELECT
1885             serialid,      aqbooksellerid,         name,
1886             biblio.title,  planneddate,           serialseq,
1887                 serial.status, serial.subscriptionid, claimdate, claims_count,
1888                 subscription.branchcode
1889             FROM serial
1890                 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1891                 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1892                 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1893                 WHERE subscription.subscriptionid = serial.subscriptionid
1894                         AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1895                 $byserial
1896                 ORDER BY $order"
1897         );
1898     }
1899     $sth->execute( EXPECTED, LATE, CLAIMED );
1900     my @issuelist;
1901     while ( my $line = $sth->fetchrow_hashref ) {
1902
1903         if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1904             $line->{planneddateISO} = $line->{planneddate};
1905             $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{"planneddate"} ), dateonly => 1 } );
1906         }
1907         if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1908             $line->{claimdateISO} = $line->{claimdate};
1909             $line->{claimdate}   = output_pref( { dt => dt_from_string( $line->{"claimdate"} ), dateonly => 1 } );
1910         }
1911         $line->{"status".$line->{status}}   = 1;
1912
1913         my $subscription_object = Koha::Subscriptions->find($line->{subscriptionid});
1914         $line->{additional_fields} = { map { $_->field->name => $_->value }
1915             $subscription_object->additional_field_values->as_list };
1916
1917         push @issuelist, $line;
1918     }
1919     return @issuelist;
1920 }
1921
1922 =head2 updateClaim
1923
1924 &updateClaim($serialid)
1925
1926 this function updates the time when a claim is issued for late/missing items
1927
1928 called from claims.pl file
1929
1930 =cut
1931
1932 sub updateClaim {
1933     my ($serialids) = @_;
1934     return unless $serialids;
1935     unless ( ref $serialids ) {
1936         $serialids = [ $serialids ];
1937     }
1938     my $dbh = C4::Context->dbh;
1939     return $dbh->do(q|
1940         UPDATE serial
1941         SET claimdate = NOW(),
1942             claims_count = claims_count + 1,
1943             status = ?
1944         WHERE serialid in (| . join( q|,|, (q|?|) x @$serialids ) . q|)|,
1945         {}, CLAIMED, @$serialids );
1946 }
1947
1948 =head2 check_routing
1949
1950 $result = &check_routing($subscriptionid)
1951
1952 this function checks to see if a serial has a routing list and returns the count of routingid
1953 used to show either an 'add' or 'edit' link
1954
1955 =cut
1956
1957 sub check_routing {
1958     my ($subscriptionid) = @_;
1959
1960     return unless ($subscriptionid);
1961
1962     my $dbh              = C4::Context->dbh;
1963     my $sth              = $dbh->prepare(
1964         "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1965                               ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1966                               WHERE subscription.subscriptionid = ? GROUP BY routingid ORDER BY ranking ASC
1967                               "
1968     );
1969     $sth->execute($subscriptionid);
1970     my $line   = $sth->fetchrow_hashref;
1971     my $result = $line->{'routingids'};
1972     return $result;
1973 }
1974
1975 =head2 addroutingmember
1976
1977 addroutingmember($borrowernumber,$subscriptionid)
1978
1979 this function takes a borrowernumber and subscriptionid and adds the member to the
1980 routing list for that serial subscription and gives them a rank on the list
1981 of either 1 or highest current rank + 1
1982
1983 =cut
1984
1985 sub addroutingmember {
1986     my ( $borrowernumber, $subscriptionid ) = @_;
1987
1988     return unless ($borrowernumber and $subscriptionid);
1989
1990     my $rank;
1991     my $dbh = C4::Context->dbh;
1992     my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1993     $sth->execute($subscriptionid);
1994     while ( my $line = $sth->fetchrow_hashref ) {
1995         if ( $line->{'rank'} > 0 ) {
1996             $rank = $line->{'rank'} + 1;
1997         } else {
1998             $rank = 1;
1999         }
2000     }
2001     $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
2002     $sth->execute( $subscriptionid, $borrowernumber, $rank );
2003 }
2004
2005 =head2 reorder_members
2006
2007 reorder_members($subscriptionid,$routingid,$rank)
2008
2009 this function is used to reorder the routing list
2010
2011 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2012 - it gets all members on list puts their routingid's into an array
2013 - removes the one in the array that is $routingid
2014 - then reinjects $routingid at point indicated by $rank
2015 - then update the database with the routingids in the new order
2016
2017 =cut
2018
2019 sub reorder_members {
2020     my ( $subscriptionid, $routingid, $rank ) = @_;
2021     my $dbh = C4::Context->dbh;
2022     my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2023     $sth->execute($subscriptionid);
2024     my @result;
2025     while ( my $line = $sth->fetchrow_hashref ) {
2026         push( @result, $line->{'routingid'} );
2027     }
2028
2029     # To find the matching index
2030     my $i;
2031     my $key = -1;    # to allow for 0 being a valid response
2032     for ( $i = 0 ; $i < @result ; $i++ ) {
2033         if ( $routingid == $result[$i] ) {
2034             $key = $i;    # save the index
2035             last;
2036         }
2037     }
2038
2039     # if index exists in array then move it to new position
2040     if ( $key > -1 && $rank > 0 ) {
2041         my $new_rank = $rank - 1;                       # $new_rank is what you want the new index to be in the array
2042         my $moving_item = splice( @result, $key, 1 );
2043         splice( @result, $new_rank, 0, $moving_item );
2044     }
2045     for ( my $j = 0 ; $j < @result ; $j++ ) {
2046         my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2047         $sth->execute;
2048     }
2049     return;
2050 }
2051
2052 =head2 delroutingmember
2053
2054 delroutingmember($routingid,$subscriptionid)
2055
2056 this function either deletes one member from routing list if $routingid exists otherwise
2057 deletes all members from the routing list
2058
2059 =cut
2060
2061 sub delroutingmember {
2062
2063     # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2064     my ( $routingid, $subscriptionid ) = @_;
2065     my $dbh = C4::Context->dbh;
2066     if ($routingid) {
2067         my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2068         $sth->execute($routingid);
2069         reorder_members( $subscriptionid, $routingid );
2070     } else {
2071         my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2072         $sth->execute($subscriptionid);
2073     }
2074     return;
2075 }
2076
2077 =head2 getroutinglist
2078
2079 @routinglist = getroutinglist($subscriptionid)
2080
2081 this gets the info from the subscriptionroutinglist for $subscriptionid
2082
2083 return :
2084 the routinglist as an array. Each element of the array contains a hash_ref containing
2085 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2086
2087 =cut
2088
2089 sub getroutinglist {
2090     my ($subscriptionid) = @_;
2091     my $dbh              = C4::Context->dbh;
2092     my $sth              = $dbh->prepare(
2093         'SELECT routingid, borrowernumber, ranking, biblionumber
2094             FROM subscription
2095             JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2096             WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2097     );
2098     $sth->execute($subscriptionid);
2099     my $routinglist = $sth->fetchall_arrayref({});
2100     return @{$routinglist};
2101 }
2102
2103 =head2 countissuesfrom
2104
2105 $result = countissuesfrom($subscriptionid,$startdate)
2106
2107 Returns a count of serial rows matching the given subsctiptionid
2108 with published date greater than startdate
2109
2110 =cut
2111
2112 sub countissuesfrom {
2113     my ( $subscriptionid, $startdate ) = @_;
2114     my $dbh   = C4::Context->dbh;
2115     my $query = qq|
2116             SELECT count(*)
2117             FROM   serial
2118             WHERE  subscriptionid=?
2119             AND serial.publisheddate>?
2120         |;
2121     my $sth = $dbh->prepare($query);
2122     $sth->execute( $subscriptionid, $startdate );
2123     my ($countreceived) = $sth->fetchrow;
2124     return $countreceived;
2125 }
2126
2127 =head2 CountIssues
2128
2129 $result = CountIssues($subscriptionid)
2130
2131 Returns a count of serial rows matching the given subsctiptionid
2132
2133 =cut
2134
2135 sub CountIssues {
2136     my ($subscriptionid) = @_;
2137     my $dbh              = C4::Context->dbh;
2138     my $query            = qq|
2139             SELECT count(*)
2140             FROM   serial
2141             WHERE  subscriptionid=?
2142         |;
2143     my $sth = $dbh->prepare($query);
2144     $sth->execute($subscriptionid);
2145     my ($countreceived) = $sth->fetchrow;
2146     return $countreceived;
2147 }
2148
2149 =head2 HasItems
2150
2151 $result = HasItems($subscriptionid)
2152
2153 returns a count of items from serial matching the subscriptionid
2154
2155 =cut
2156
2157 sub HasItems {
2158     my ($subscriptionid) = @_;
2159     my $dbh              = C4::Context->dbh;
2160     my $query = q|
2161             SELECT COUNT(serialitems.itemnumber)
2162             FROM   serial
2163                         LEFT JOIN serialitems USING(serialid)
2164             WHERE  subscriptionid=? AND serialitems.serialid IS NOT NULL
2165         |;
2166     my $sth=$dbh->prepare($query);
2167     $sth->execute($subscriptionid);
2168     my ($countitems)=$sth->fetchrow_array();
2169     return $countitems;
2170 }
2171
2172 =head2 abouttoexpire
2173
2174 $result = abouttoexpire($subscriptionid)
2175
2176 this function alerts you to the penultimate issue for a serial subscription
2177
2178 returns 1 - if this is the penultimate issue
2179 returns 0 - if not
2180
2181 =cut
2182
2183 sub abouttoexpire {
2184     my ($subscriptionid) = @_;
2185     my $dbh              = C4::Context->dbh;
2186     my $subscription     = GetSubscription($subscriptionid);
2187     my $per = $subscription->{'periodicity'};
2188     my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2189     if ($frequency and $frequency->{unit}){
2190
2191         my $expirationdate = GetExpirationDate($subscriptionid);
2192
2193         my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2194         my $nextdate = GetNextDate($subscription, $res, $frequency);
2195
2196         # only compare dates if both dates exist.
2197         if ($nextdate and $expirationdate) {
2198             if(Date::Calc::Delta_Days(
2199                 split( /-/, $nextdate ),
2200                 split( /-/, $expirationdate )
2201             ) <= 0) {
2202                 return 1;
2203             }
2204         }
2205
2206     } elsif ( $subscription->{numberlength} && $subscription->{numberlength}>0) {
2207         return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2208     }
2209
2210     return 0;
2211 }
2212
2213 =head2 GetFictiveIssueNumber
2214
2215 $issueno = GetFictiveIssueNumber($subscription, $publishedate, $frequency);
2216
2217 Get the position of the issue published at $publisheddate, considering the
2218 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2219 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2220 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2221 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2222 depending on how many rows are in serial table.
2223 The issue number calculation is based on subscription frequency, first acquisition
2224 date, and $publisheddate.
2225
2226 Returns undef when called for irregular frequencies.
2227
2228 The routine is used to skip irregularities when calculating the next issue
2229 date (in GetNextDate) or the next issue number (in GetNextSeq).
2230
2231 =cut
2232
2233 sub GetFictiveIssueNumber {
2234     my ($subscription, $publisheddate, $frequency) = @_;
2235
2236     my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2237     return if !$unit;
2238     my $issueno;
2239
2240     my ( $year, $month, $day ) = split /-/, $publisheddate;
2241     my ( $fa_year, $fa_month, $fa_day ) = split /-/, $subscription->{'firstacquidate'};
2242     my $delta = _delta_units( [$fa_year, $fa_month, $fa_day], [$year, $month, $day], $unit );
2243
2244     if( $frequency->{'unitsperissue'} == 1 ) {
2245         $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2246     } else { # issuesperunit == 1
2247         $issueno = 1 + int( $delta / $frequency->{'unitsperissue'} );
2248     }
2249     return $issueno;
2250 }
2251
2252 sub _delta_units {
2253     my ( $date1, $date2, $unit ) = @_;
2254     # date1 and date2 are array refs in the form [ yy, mm, dd ]
2255
2256     if( $unit eq 'day' ) {
2257         return Delta_Days( @$date1, @$date2 );
2258     } elsif( $unit eq 'week' ) {
2259         return int( Delta_Days( @$date1, @$date2 ) / 7 );
2260     }
2261
2262     # In case of months or years, this is a wrapper around N_Delta_YMD.
2263     # Note that N_Delta_YMD returns 29 days between e.g. 22-2-72 and 22-3-72
2264     # while we expect 1 month.
2265     my @delta = N_Delta_YMD( @$date1, @$date2 );
2266     if( $delta[2] > 27 ) {
2267         # Check if we could add a month
2268         my @jump = Add_Delta_YM( @$date1, $delta[0], 1 + $delta[1] );
2269         if( Delta_Days( @jump, @$date2 ) >= 0 ) {
2270             $delta[1]++;
2271         }
2272     }
2273     if( $delta[1] >= 12 ) {
2274         $delta[0]++;
2275         $delta[1] -= 12;
2276     }
2277     # if unit is year, we only return full years
2278     return $unit eq 'month' ? $delta[0] * 12 + $delta[1] : $delta[0];
2279 }
2280
2281 sub _get_next_date_day {
2282     my ($subscription, $freqdata, $year, $month, $day) = @_;
2283
2284     my @newissue; # ( yy, mm, dd )
2285     # We do not need $delta_days here, since it would be zero where used
2286
2287     if( $freqdata->{issuesperunit} == 1 ) {
2288         # Add full days
2289         @newissue = Add_Delta_Days(
2290             $year, $month, $day, $freqdata->{"unitsperissue"} );
2291     } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2292         # Add zero days
2293         @newissue = ( $year, $month, $day );
2294         $subscription->{countissuesperunit}++;
2295     } else {
2296         # We finished a cycle of issues within a unit.
2297         # No subtraction of zero needed, just add one day
2298         @newissue = Add_Delta_Days( $year, $month, $day, 1 );
2299         $subscription->{countissuesperunit} = 1;
2300     }
2301     return @newissue;
2302 }
2303
2304 sub _get_next_date_week {
2305     my ($subscription, $freqdata, $year, $month, $day) = @_;
2306
2307     my @newissue; # ( yy, mm, dd )
2308     my $delta_days = int( 7 / $freqdata->{issuesperunit} );
2309
2310     if( $freqdata->{issuesperunit} == 1 ) {
2311         # Add full weeks (of 7 days)
2312         @newissue = Add_Delta_Days(
2313             $year, $month, $day, 7 * $freqdata->{"unitsperissue"} );
2314     } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2315         # Add rounded number of days based on frequency.
2316         @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2317         $subscription->{countissuesperunit}++;
2318     } else {
2319         # We finished a cycle of issues within a unit.
2320         # Subtract delta * (issues - 1), add 1 week
2321         @newissue = Add_Delta_Days( $year, $month, $day,
2322             -$delta_days * ($freqdata->{issuesperunit} - 1) );
2323         @newissue = Add_Delta_Days( @newissue, 7 );
2324         $subscription->{countissuesperunit} = 1;
2325     }
2326     return @newissue;
2327 }
2328
2329 sub _get_next_date_month {
2330     my ($subscription, $freqdata, $year, $month, $day) = @_;
2331
2332     my @newissue; # ( yy, mm, dd )
2333     my $delta_days = int( 30 / $freqdata->{issuesperunit} );
2334
2335     if( $freqdata->{issuesperunit} == 1 ) {
2336         # Add full months
2337         @newissue = Add_Delta_YM(
2338             $year, $month, $day, 0, $freqdata->{"unitsperissue"} );
2339     } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2340         # Add rounded number of days based on frequency.
2341         @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2342         $subscription->{countissuesperunit}++;
2343     } else {
2344         # We finished a cycle of issues within a unit.
2345         # Subtract delta * (issues - 1), add 1 month
2346         @newissue = Add_Delta_Days( $year, $month, $day,
2347             -$delta_days * ($freqdata->{issuesperunit} - 1) );
2348         @newissue = Add_Delta_YM( @newissue, 0, 1 );
2349         $subscription->{countissuesperunit} = 1;
2350     }
2351     return @newissue;
2352 }
2353
2354 sub _get_next_date_year {
2355     my ($subscription, $freqdata, $year, $month, $day) = @_;
2356
2357     my @newissue; # ( yy, mm, dd )
2358     my $delta_days = int( 365 / $freqdata->{issuesperunit} );
2359
2360     if( $freqdata->{issuesperunit} == 1 ) {
2361         # Add full years
2362         @newissue = Add_Delta_YM( $year, $month, $day, $freqdata->{"unitsperissue"}, 0 );
2363     } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2364         # Add rounded number of days based on frequency.
2365         @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2366         $subscription->{countissuesperunit}++;
2367     } else {
2368         # We finished a cycle of issues within a unit.
2369         # Subtract delta * (issues - 1), add 1 year
2370         @newissue = Add_Delta_Days( $year, $month, $day, -$delta_days * ($freqdata->{issuesperunit} - 1) );
2371         @newissue = Add_Delta_YM( @newissue, 1, 0 );
2372         $subscription->{countissuesperunit} = 1;
2373     }
2374     return @newissue;
2375 }
2376
2377 =head2 GetNextDate
2378
2379 $resultdate = GetNextDate($publisheddate,$subscription,$freqdata,$updatecount)
2380
2381 this function it takes the publisheddate and will return the next issue's date
2382 and will skip dates if there exists an irregularity.
2383 $publisheddate has to be an ISO date
2384 $subscription is a hashref containing at least 'firstacquidate', 'irregularity', and 'countissuesperunit'
2385 $frequency is a hashref containing frequency informations
2386 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2387 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2388 skipped then the returned date will be 2007-05-10
2389
2390 return :
2391 $resultdate - then next date in the sequence (ISO date)
2392
2393 Return undef if subscription is irregular
2394
2395 =cut
2396
2397 sub GetNextDate {
2398     my ( $subscription, $publisheddate, $freqdata, $updatecount ) = @_;
2399
2400     return unless $subscription and $publisheddate;
2401
2402
2403     if ($freqdata->{'unit'}) {
2404         my ( $year, $month, $day ) = split /-/, $publisheddate;
2405
2406         # Process an irregularity Hash
2407         # Suppose that irregularities are stored in a string with this structure
2408         # irreg1;irreg2;irreg3
2409         # where irregX is the number of issue which will not be received
2410         # (the first issue takes the number 1, the 2nd the number 2 and so on)
2411         my %irregularities;
2412         if ( $subscription->{irregularity} ) {
2413             my @irreg = split /;/, $subscription->{'irregularity'} ;
2414             foreach my $irregularity (@irreg) {
2415                 $irregularities{$irregularity} = 1;
2416             }
2417         }
2418
2419         # Get the 'fictive' next issue number
2420         # It is used to check if next issue is an irregular issue.
2421         my $issueno = GetFictiveIssueNumber($subscription, $publisheddate, $freqdata) + 1;
2422
2423         # Then get the next date
2424         my $unit = lc $freqdata->{'unit'};
2425         if ($unit eq 'day') {
2426             while ($irregularities{$issueno}) {
2427                 ($year, $month, $day) = _get_next_date_day($subscription,
2428                     $freqdata, $year, $month, $day);
2429                 $issueno++;
2430             }
2431             ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2432                 $year, $month, $day);
2433         }
2434         elsif ($unit eq 'week') {
2435             while ($irregularities{$issueno}) {
2436                 ($year, $month, $day) = _get_next_date_week($subscription,
2437                     $freqdata, $year, $month, $day);
2438                 $issueno++;
2439             }
2440             ($year, $month, $day) = _get_next_date_week($subscription,
2441                 $freqdata, $year, $month, $day);
2442         }
2443         elsif ($unit eq 'month') {
2444             while ($irregularities{$issueno}) {
2445                 ($year, $month, $day) = _get_next_date_month($subscription,
2446                     $freqdata, $year, $month, $day);
2447                 $issueno++;
2448             }
2449             ($year, $month, $day) = _get_next_date_month($subscription,
2450                 $freqdata, $year, $month, $day);
2451         }
2452         elsif ($unit eq 'year') {
2453             while ($irregularities{$issueno}) {
2454                 ($year, $month, $day) = _get_next_date_year($subscription,
2455                     $freqdata, $year, $month, $day);
2456                 $issueno++;
2457             }
2458             ($year, $month, $day) = _get_next_date_year($subscription,
2459                 $freqdata, $year, $month, $day);
2460         }
2461
2462         if ($updatecount){
2463             my $dbh = C4::Context->dbh;
2464             my $query = qq{
2465                 UPDATE subscription
2466                 SET countissuesperunit = ?
2467                 WHERE subscriptionid = ?
2468             };
2469             my $sth = $dbh->prepare($query);
2470             $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2471         }
2472
2473         return sprintf("%04d-%02d-%02d", $year, $month, $day);
2474     }
2475 }
2476
2477 =head2 _numeration
2478
2479   $string = &_numeration($value,$num_type,$locale);
2480
2481 _numeration returns the string corresponding to $value in the num_type
2482 num_type can take :
2483     -dayname
2484     -dayabrv
2485     -monthname
2486     -monthabrv
2487     -season
2488     -seasonabrv
2489
2490 =cut
2491
2492 sub _numeration {
2493     my ($value, $num_type, $locale) = @_;
2494     $value ||= 0;
2495     $num_type //= '';
2496     $locale ||= 'en';
2497     my $string;
2498     if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2499         # 1970-11-01 was a Sunday
2500         $value = $value % 7;
2501         my $dt = DateTime->new(
2502             year    => 1970,
2503             month   => 11,
2504             day     => $value + 1,
2505             locale  => $locale,
2506         );
2507         $string = $num_type =~ /^dayname$/
2508             ? $dt->strftime("%A")
2509             : $dt->strftime("%a");
2510     } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2511         $value = $value % 12;
2512         my $dt = DateTime->new(
2513             year    => 1970,
2514             month   => $value + 1,
2515             locale  => $locale,
2516         );
2517         $string = $num_type =~ /^monthname$/
2518             ? $dt->format_cldr( "LLLL" )
2519             : $dt->strftime("%b");
2520     } elsif ( $num_type =~ /^season$/ ) {
2521         my @seasons= qw( Spring Summer Fall Winter );
2522         $value = $value % 4;
2523         $string = $seasons[$value];
2524     } elsif ( $num_type =~ /^seasonabrv$/ ) {
2525         my @seasonsabrv= qw( Spr Sum Fal Win );
2526         $value = $value % 4;
2527         $string = $seasonsabrv[$value];
2528     } else {
2529         $string = $value;
2530     }
2531
2532     return $string;
2533 }
2534
2535 =head2 CloseSubscription
2536
2537 Close a subscription given a subscriptionid
2538
2539 =cut
2540
2541 sub CloseSubscription {
2542     my ( $subscriptionid ) = @_;
2543     return unless $subscriptionid;
2544     my $dbh = C4::Context->dbh;
2545     my $sth = $dbh->prepare( q{
2546         UPDATE subscription
2547         SET closed = 1
2548         WHERE subscriptionid = ?
2549     } );
2550     $sth->execute( $subscriptionid );
2551
2552     # Set status = missing when status = stopped
2553     $sth = $dbh->prepare( q{
2554         UPDATE serial
2555         SET status = ?
2556         WHERE subscriptionid = ?
2557         AND status = ?
2558     } );
2559     $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2560 }
2561
2562 =head2 ReopenSubscription
2563
2564 Reopen a subscription given a subscriptionid
2565
2566 =cut
2567
2568 sub ReopenSubscription {
2569     my ( $subscriptionid ) = @_;
2570     return unless $subscriptionid;
2571     my $dbh = C4::Context->dbh;
2572     my $sth = $dbh->prepare( q{
2573         UPDATE subscription
2574         SET closed = 0
2575         WHERE subscriptionid = ?
2576     } );
2577     $sth->execute( $subscriptionid );
2578
2579     # Set status = expected when status = stopped
2580     $sth = $dbh->prepare( q{
2581         UPDATE serial
2582         SET status = ?
2583         WHERE subscriptionid = ?
2584         AND status = ?
2585     } );
2586     $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2587 }
2588
2589 =head2 subscriptionCurrentlyOnOrder
2590
2591     $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2592
2593 Return 1 if subscription is currently on order else 0.
2594
2595 =cut
2596
2597 sub subscriptionCurrentlyOnOrder {
2598     my ( $subscriptionid ) = @_;
2599     my $dbh = C4::Context->dbh;
2600     my $query = qq|
2601         SELECT COUNT(*) FROM aqorders
2602         WHERE subscriptionid = ?
2603             AND datereceived IS NULL
2604             AND datecancellationprinted IS NULL
2605     |;
2606     my $sth = $dbh->prepare( $query );
2607     $sth->execute($subscriptionid);
2608     return $sth->fetchrow_array;
2609 }
2610
2611 =head2 can_claim_subscription
2612
2613     $can = can_claim_subscription( $subscriptionid[, $userid] );
2614
2615 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2616
2617 =cut
2618
2619 sub can_claim_subscription {
2620     my ( $subscription, $userid ) = @_;
2621     return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2622 }
2623
2624 =head2 can_edit_subscription
2625
2626     $can = can_edit_subscription( $subscriptionid[, $userid] );
2627
2628 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2629
2630 =cut
2631
2632 sub can_edit_subscription {
2633     my ( $subscription, $userid ) = @_;
2634     return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2635 }
2636
2637 =head2 can_show_subscription
2638
2639     $can = can_show_subscription( $subscriptionid[, $userid] );
2640
2641 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2642
2643 =cut
2644
2645 sub can_show_subscription {
2646     my ( $subscription, $userid ) = @_;
2647     return _can_do_on_subscription( $subscription, $userid, '*' );
2648 }
2649
2650 sub _can_do_on_subscription {
2651     my ( $subscription, $userid, $permission ) = @_;
2652     return 0 unless C4::Context->userenv;
2653     my $flags = C4::Context->userenv->{flags};
2654     $userid ||= C4::Context->userenv->{'id'};
2655
2656     if ( C4::Context->preference('IndependentBranches') ) {
2657         return 1
2658           if C4::Context->IsSuperLibrarian()
2659               or
2660               C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2661               or (
2662                   C4::Auth::haspermission( $userid,
2663                       { serials => $permission } )
2664                   and (  not defined $subscription->{branchcode}
2665                       or $subscription->{branchcode} eq ''
2666                       or $subscription->{branchcode} eq
2667                       C4::Context->userenv->{'branch'} )
2668               );
2669     }
2670     else {
2671         return 1
2672           if C4::Context->IsSuperLibrarian()
2673               or
2674               C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2675               or C4::Auth::haspermission(
2676                   $userid, { serials => $permission }
2677               ),
2678         ;
2679     }
2680     return 0;
2681 }
2682
2683 =head2 findSerialsByStatus
2684
2685     @serials = findSerialsByStatus($status, $subscriptionid);
2686
2687     Returns an array of serials matching a given status and subscription id.
2688
2689 =cut
2690
2691 sub findSerialsByStatus {
2692     my ( $status, $subscriptionid ) = @_;
2693     my $dbh   = C4::Context->dbh;
2694     my $query = q| SELECT * from serial
2695                     WHERE status = ?
2696                     AND subscriptionid = ?
2697                 |;
2698     my $serials = $dbh->selectall_arrayref( $query, { Slice => {} }, $status, $subscriptionid );
2699     return @$serials;
2700 }
2701
2702 1;
2703 __END__
2704
2705 =head1 AUTHOR
2706
2707 Koha Development Team <http://koha-community.org/>
2708
2709 =cut