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