C4/Serials.pm

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