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