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 C4::Dates qw(format_date format_date_in_iso);
  26 use DateTime;
  27 use Date::Calc qw(:all);
  28 use POSIX qw(strftime);
  29 use C4::Biblio;
  30 use C4::Log;    # logaction
  31 use C4::Debug;
  32 use C4::Serials::Frequency;
  33 use C4::Serials::Numberpattern;
  34 use Koha::AdditionalField;
  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           &ItemizeSerials    &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}     = format_date( $subs->{startdate} );
 471         $subs->{histstartdate} = format_date( $subs->{histstartdate} );
 472         $subs->{histenddate}   = format_date( $subs->{histenddate} );
 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} = format_date( $subs->{enddate} );
 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} = format_date( $line->{$datefield});
 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} = format_date( $line->{$datefield});
 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} = format_date( $line->{$datefield} );
 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"} = format_date( $line->{"planneddate"} );
 828         $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
 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 C4::Dates object.
 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 ItemizeSerials
1592
1593 ItemizeSerials($serialid, $info);
1594 $info is a hashref containing  barcode branch, itemcallnumber, status, location
1595 $serialid the serialid
1596 return :
1597 1 if the itemize is a succes.
1598 0 and @error otherwise. @error containts the list of errors found.
1599
1600 =cut
1601
1602 sub ItemizeSerials {
1603     my ( $serialid, $info ) = @_;
1604
1605     return unless ($serialid);
1606
1607     my $now = POSIX::strftime( "%Y-%m-%d", localtime );
1608
1609     my $dbh   = C4::Context->dbh;
1610     my $query = qq|
1611         SELECT *
1612         FROM   serial
1613         WHERE  serialid=?
1614     |;
1615     my $sth = $dbh->prepare($query);
1616     $sth->execute($serialid);
1617     my $data = $sth->fetchrow_hashref;
1618     if ( C4::Context->preference("RoutingSerials") ) {
1619
1620         # check for existing biblioitem relating to serial issue
1621         my ( $count, @results ) = GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1622         my $bibitemno = 0;
1623         for ( my $i = 0 ; $i < $count ; $i++ ) {
1624             if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' (' . $data->{'planneddate'} . ')' ) {
1625                 $bibitemno = $results[$i]->{'biblioitemnumber'};
1626                 last;
1627             }
1628         }
1629         if ( $bibitemno == 0 ) {
1630             my $sth = $dbh->prepare( "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC" );
1631             $sth->execute( $data->{'biblionumber'} );
1632             my $biblioitem = $sth->fetchrow_hashref;
1633             $biblioitem->{'volumedate'}  = $data->{planneddate};
1634             $biblioitem->{'volumeddesc'} = $data->{serialseq} . ' (' . format_date( $data->{'planneddate'} ) . ')';
1635             $biblioitem->{'dewey'}       = $info->{itemcallnumber};
1636         }
1637     }
1638
1639     my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1640     if ( $info->{barcode} ) {
1641         my @errors;
1642         if ( is_barcode_in_use( $info->{barcode} ) ) {
1643             push @errors, 'barcode_not_unique';
1644         } else {
1645             my $marcrecord = MARC::Record->new();
1646             my ( $tag, $subfield ) = GetMarcFromKohaField( "items.barcode", $fwk );
1647             my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{barcode} );
1648             $marcrecord->insert_fields_ordered($newField);
1649             if ( $info->{branch} ) {
1650                 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.homebranch", $fwk );
1651
1652                 #warn "items.homebranch : $tag , $subfield";
1653                 if ( $marcrecord->field($tag) ) {
1654                     $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1655                 } else {
1656                     my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1657                     $marcrecord->insert_fields_ordered($newField);
1658                 }
1659                 ( $tag, $subfield ) = GetMarcFromKohaField( "items.holdingbranch", $fwk );
1660
1661                 #warn "items.holdingbranch : $tag , $subfield";
1662                 if ( $marcrecord->field($tag) ) {
1663                     $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1664                 } else {
1665                     my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1666                     $marcrecord->insert_fields_ordered($newField);
1667                 }
1668             }
1669             if ( $info->{itemcallnumber} ) {
1670                 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemcallnumber", $fwk );
1671
1672                 if ( $marcrecord->field($tag) ) {
1673                     $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{itemcallnumber} );
1674                 } else {
1675                     my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{itemcallnumber} );
1676                     $marcrecord->insert_fields_ordered($newField);
1677                 }
1678             }
1679             if ( $info->{notes} ) {
1680                 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemnotes", $fwk );
1681
1682                 if ( $marcrecord->field($tag) ) {
1683                     $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{notes} );
1684                 } else {
1685                     my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{notes} );
1686                     $marcrecord->insert_fields_ordered($newField);
1687                 }
1688             }
1689             if ( $info->{location} ) {
1690                 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.location", $fwk );
1691
1692                 if ( $marcrecord->field($tag) ) {
1693                     $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{location} );
1694                 } else {
1695                     my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{location} );
1696                     $marcrecord->insert_fields_ordered($newField);
1697                 }
1698             }
1699             if ( $info->{status} ) {
1700                 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.notforloan", $fwk );
1701
1702                 if ( $marcrecord->field($tag) ) {
1703                     $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{status} );
1704                 } else {
1705                     my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{status} );
1706                     $marcrecord->insert_fields_ordered($newField);
1707                 }
1708             }
1709             if ( C4::Context->preference("RoutingSerials") ) {
1710                 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.dateaccessioned", $fwk );
1711                 if ( $marcrecord->field($tag) ) {
1712                     $marcrecord->field($tag)->add_subfields( "$subfield" => $now );
1713                 } else {
1714                     my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1715                     $marcrecord->insert_fields_ordered($newField);
1716                 }
1717             }
1718             require C4::Items;
1719             C4::Items::AddItemFromMarc( $marcrecord, $data->{'biblionumber'} );
1720             return 1;
1721         }
1722         return ( 0, @errors );
1723     }
1724 }
1725
1726 =head2 HasSubscriptionStrictlyExpired
1727
1728 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1729
1730 the subscription has stricly expired when today > the end subscription date
1731
1732 return :
1733 1 if true, 0 if false, -1 if the expiration date is not set.
1734
1735 =cut
1736
1737 sub HasSubscriptionStrictlyExpired {
1738
1739     # Getting end of subscription date
1740     my ($subscriptionid) = @_;
1741
1742     return unless ($subscriptionid);
1743
1744     my $dbh              = C4::Context->dbh;
1745     my $subscription     = GetSubscription($subscriptionid);
1746     my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1747
1748     # If the expiration date is set
1749     if ( $expirationdate != 0 ) {
1750         my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1751
1752         # Getting today's date
1753         my ( $nowyear, $nowmonth, $nowday ) = Today();
1754
1755         # if today's date > expiration date, then the subscription has stricly expired
1756         if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1757             return 1;
1758         } else {
1759             return 0;
1760         }
1761     } else {
1762
1763         # There are some cases where the expiration date is not set
1764         # As we can't determine if the subscription has expired on a date-basis,
1765         # we return -1;
1766         return -1;
1767     }
1768 }
1769
1770 =head2 HasSubscriptionExpired
1771
1772 $has_expired = HasSubscriptionExpired($subscriptionid)
1773
1774 the subscription has expired when the next issue to arrive is out of subscription limit.
1775
1776 return :
1777 0 if the subscription has not expired
1778 1 if the subscription has expired
1779 2 if has subscription does not have a valid expiration date set
1780
1781 =cut
1782
1783 sub HasSubscriptionExpired {
1784     my ($subscriptionid) = @_;
1785
1786     return unless ($subscriptionid);
1787
1788     my $dbh              = C4::Context->dbh;
1789     my $subscription     = GetSubscription($subscriptionid);
1790     my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1791     if ( $frequency and $frequency->{unit} ) {
1792         my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1793         if (!defined $expirationdate) {
1794             $expirationdate = q{};
1795         }
1796         my $query          = qq|
1797             SELECT max(planneddate)
1798             FROM   serial
1799             WHERE  subscriptionid=?
1800       |;
1801         my $sth = $dbh->prepare($query);
1802         $sth->execute($subscriptionid);
1803         my ($res) = $sth->fetchrow;
1804         if (!$res || $res=~m/^0000/) {
1805             return 0;
1806         }
1807         my @res                   = split( /-/, $res );
1808         my @endofsubscriptiondate = split( /-/, $expirationdate );
1809         return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1810         return 1
1811           if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1812             || ( !$res ) );
1813         return 0;
1814     } else {
1815         # Irregular
1816         if ( $subscription->{'numberlength'} ) {
1817             my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1818             return 1 if ( $countreceived > $subscription->{'numberlength'} );
1819             return 0;
1820         } else {
1821             return 0;
1822         }
1823     }
1824     return 0;    # Notice that you'll never get here.
1825 }
1826
1827 =head2 SetDistributedto
1828
1829 SetDistributedto($distributedto,$subscriptionid);
1830 This function update the value of distributedto for a subscription given on input arg.
1831
1832 =cut
1833
1834 sub SetDistributedto {
1835     my ( $distributedto, $subscriptionid ) = @_;
1836     my $dbh   = C4::Context->dbh;
1837     my $query = qq|
1838         UPDATE subscription
1839         SET    distributedto=?
1840         WHERE  subscriptionid=?
1841     |;
1842     my $sth = $dbh->prepare($query);
1843     $sth->execute( $distributedto, $subscriptionid );
1844     return;
1845 }
1846
1847 =head2 DelSubscription
1848
1849 DelSubscription($subscriptionid)
1850 this function deletes subscription which has $subscriptionid as id.
1851
1852 =cut
1853
1854 sub DelSubscription {
1855     my ($subscriptionid) = @_;
1856     my $dbh = C4::Context->dbh;
1857     $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1858     $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=?", undef, $subscriptionid);
1859     $dbh->do("DELETE FROM serial WHERE subscriptionid=?", undef, $subscriptionid);
1860
1861     my $afs = Koha::AdditionalField->all({tablename => 'subscription'});
1862     foreach my $af (@$afs) {
1863         $af->delete_values({record_id => $subscriptionid});
1864     }
1865
1866     logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1867 }
1868
1869 =head2 DelIssue
1870
1871 DelIssue($serialseq,$subscriptionid)
1872 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1873
1874 returns the number of rows affected
1875
1876 =cut
1877
1878 sub DelIssue {
1879     my ($dataissue) = @_;
1880     my $dbh = C4::Context->dbh;
1881     ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1882
1883     my $query = qq|
1884         DELETE FROM serial
1885         WHERE       serialid= ?
1886         AND         subscriptionid= ?
1887     |;
1888     my $mainsth = $dbh->prepare($query);
1889     $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1890
1891     #Delete element from subscription history
1892     $query = "SELECT * FROM   subscription WHERE  subscriptionid = ?";
1893     my $sth = $dbh->prepare($query);
1894     $sth->execute( $dataissue->{'subscriptionid'} );
1895     my $val = $sth->fetchrow_hashref;
1896     unless ( $val->{manualhistory} ) {
1897         my $query = qq|
1898           SELECT * FROM subscriptionhistory
1899           WHERE       subscriptionid= ?
1900       |;
1901         my $sth = $dbh->prepare($query);
1902         $sth->execute( $dataissue->{'subscriptionid'} );
1903         my $data      = $sth->fetchrow_hashref;
1904         my $serialseq = $dataissue->{'serialseq'};
1905         $data->{'missinglist'}  =~ s/\b$serialseq\b//;
1906         $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1907         my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1908         $sth = $dbh->prepare($strsth);
1909         $sth->execute( $dataissue->{'subscriptionid'} );
1910     }
1911
1912     return $mainsth->rows;
1913 }
1914
1915 =head2 GetLateOrMissingIssues
1916
1917 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1918
1919 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1920
1921 return :
1922 the issuelist as an array of hash refs. Each element of this array contains
1923 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1924
1925 =cut
1926
1927 sub GetLateOrMissingIssues {
1928     my ( $supplierid, $serialid, $order ) = @_;
1929
1930     return unless ( $supplierid or $serialid );
1931
1932     my $dbh = C4::Context->dbh;
1933
1934     my $sth;
1935     my $byserial = '';
1936     if ($serialid) {
1937         $byserial = "and serialid = " . $serialid;
1938     }
1939     if ($order) {
1940         $order .= ", title";
1941     } else {
1942         $order = "title";
1943     }
1944     my $missing_statuses_string = join ',', (MISSING_STATUSES);
1945     if ($supplierid) {
1946         $sth = $dbh->prepare(
1947             "SELECT
1948                 serialid,      aqbooksellerid,        name,
1949                 biblio.title,  biblioitems.issn,      planneddate,    serialseq,
1950                 serial.status, serial.subscriptionid, claimdate, claims_count,
1951                 subscription.branchcode
1952             FROM      serial
1953                 LEFT JOIN subscription  ON serial.subscriptionid=subscription.subscriptionid
1954                 LEFT JOIN biblio        ON subscription.biblionumber=biblio.biblionumber
1955                 LEFT JOIN biblioitems   ON subscription.biblionumber=biblioitems.biblionumber
1956                 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1957                 WHERE subscription.subscriptionid = serial.subscriptionid
1958                 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1959                 AND subscription.aqbooksellerid=$supplierid
1960                 $byserial
1961                 ORDER BY $order"
1962         );
1963     } else {
1964         $sth = $dbh->prepare(
1965             "SELECT
1966             serialid,      aqbooksellerid,         name,
1967             biblio.title,  planneddate,           serialseq,
1968                 serial.status, serial.subscriptionid, claimdate, claims_count,
1969                 subscription.branchcode
1970             FROM serial
1971                 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1972                 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1973                 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1974                 WHERE subscription.subscriptionid = serial.subscriptionid
1975                         AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1976                 $byserial
1977                 ORDER BY $order"
1978         );
1979     }
1980     $sth->execute( EXPECTED, LATE, CLAIMED );
1981     my @issuelist;
1982     while ( my $line = $sth->fetchrow_hashref ) {
1983
1984         if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1985             $line->{planneddateISO} = $line->{planneddate};
1986             $line->{planneddate} = format_date( $line->{planneddate} );
1987         }
1988         if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1989             $line->{claimdateISO} = $line->{claimdate};
1990             $line->{claimdate}   = format_date( $line->{claimdate} );
1991         }
1992         $line->{"status".$line->{status}}   = 1;
1993
1994         my $additional_field_values = Koha::AdditionalField->fetch_all_values({
1995             record_id => $line->{subscriptionid},
1996             tablename => 'subscription'
1997         });
1998         %$line = ( %$line, additional_fields => $additional_field_values->{$line->{subscriptionid}} );
1999
2000         push @issuelist, $line;
2001     }
2002     return @issuelist;
2003 }
2004
2005 =head2 updateClaim
2006
2007 &updateClaim($serialid)
2008
2009 this function updates the time when a claim is issued for late/missing items
2010
2011 called from claims.pl file
2012
2013 =cut
2014
2015 sub updateClaim {
2016     my ($serialid) = @_;
2017     my $dbh        = C4::Context->dbh;
2018     $dbh->do(q|
2019         UPDATE serial
2020         SET claimdate = NOW(),
2021             claims_count = claims_count + 1
2022         WHERE serialid = ?
2023     |, {}, $serialid );
2024     return;
2025 }
2026
2027 =head2 getsupplierbyserialid
2028
2029 $result = getsupplierbyserialid($serialid)
2030
2031 this function is used to find the supplier id given a serial id
2032
2033 return :
2034 hashref containing serialid, subscriptionid, and aqbooksellerid
2035
2036 =cut
2037
2038 sub getsupplierbyserialid {
2039     my ($serialid) = @_;
2040     my $dbh        = C4::Context->dbh;
2041     my $sth        = $dbh->prepare(
2042         "SELECT serialid, serial.subscriptionid, aqbooksellerid
2043          FROM serial
2044             LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2045             WHERE serialid = ?
2046         "
2047     );
2048     $sth->execute($serialid);
2049     my $line   = $sth->fetchrow_hashref;
2050     my $result = $line->{'aqbooksellerid'};
2051     return $result;
2052 }
2053
2054 =head2 check_routing
2055
2056 $result = &check_routing($subscriptionid)
2057
2058 this function checks to see if a serial has a routing list and returns the count of routingid
2059 used to show either an 'add' or 'edit' link
2060
2061 =cut
2062
2063 sub check_routing {
2064     my ($subscriptionid) = @_;
2065
2066     return unless ($subscriptionid);
2067
2068     my $dbh              = C4::Context->dbh;
2069     my $sth              = $dbh->prepare(
2070         "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2071                               ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2072                               WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2073                               "
2074     );
2075     $sth->execute($subscriptionid);
2076     my $line   = $sth->fetchrow_hashref;
2077     my $result = $line->{'routingids'};
2078     return $result;
2079 }
2080
2081 =head2 addroutingmember
2082
2083 addroutingmember($borrowernumber,$subscriptionid)
2084
2085 this function takes a borrowernumber and subscriptionid and adds the member to the
2086 routing list for that serial subscription and gives them a rank on the list
2087 of either 1 or highest current rank + 1
2088
2089 =cut
2090
2091 sub addroutingmember {
2092     my ( $borrowernumber, $subscriptionid ) = @_;
2093
2094     return unless ($borrowernumber and $subscriptionid);
2095
2096     my $rank;
2097     my $dbh = C4::Context->dbh;
2098     my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
2099     $sth->execute($subscriptionid);
2100     while ( my $line = $sth->fetchrow_hashref ) {
2101         if ( $line->{'rank'} > 0 ) {
2102             $rank = $line->{'rank'} + 1;
2103         } else {
2104             $rank = 1;
2105         }
2106     }
2107     $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
2108     $sth->execute( $subscriptionid, $borrowernumber, $rank );
2109 }
2110
2111 =head2 reorder_members
2112
2113 reorder_members($subscriptionid,$routingid,$rank)
2114
2115 this function is used to reorder the routing list
2116
2117 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2118 - it gets all members on list puts their routingid's into an array
2119 - removes the one in the array that is $routingid
2120 - then reinjects $routingid at point indicated by $rank
2121 - then update the database with the routingids in the new order
2122
2123 =cut
2124
2125 sub reorder_members {
2126     my ( $subscriptionid, $routingid, $rank ) = @_;
2127     my $dbh = C4::Context->dbh;
2128     my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2129     $sth->execute($subscriptionid);
2130     my @result;
2131     while ( my $line = $sth->fetchrow_hashref ) {
2132         push( @result, $line->{'routingid'} );
2133     }
2134
2135     # To find the matching index
2136     my $i;
2137     my $key = -1;    # to allow for 0 being a valid response
2138     for ( $i = 0 ; $i < @result ; $i++ ) {
2139         if ( $routingid == $result[$i] ) {
2140             $key = $i;    # save the index
2141             last;
2142         }
2143     }
2144
2145     # if index exists in array then move it to new position
2146     if ( $key > -1 && $rank > 0 ) {
2147         my $new_rank = $rank - 1;                       # $new_rank is what you want the new index to be in the array
2148         my $moving_item = splice( @result, $key, 1 );
2149         splice( @result, $new_rank, 0, $moving_item );
2150     }
2151     for ( my $j = 0 ; $j < @result ; $j++ ) {
2152         my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2153         $sth->execute;
2154     }
2155     return;
2156 }
2157
2158 =head2 delroutingmember
2159
2160 delroutingmember($routingid,$subscriptionid)
2161
2162 this function either deletes one member from routing list if $routingid exists otherwise
2163 deletes all members from the routing list
2164
2165 =cut
2166
2167 sub delroutingmember {
2168
2169     # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2170     my ( $routingid, $subscriptionid ) = @_;
2171     my $dbh = C4::Context->dbh;
2172     if ($routingid) {
2173         my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2174         $sth->execute($routingid);
2175         reorder_members( $subscriptionid, $routingid );
2176     } else {
2177         my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2178         $sth->execute($subscriptionid);
2179     }
2180     return;
2181 }
2182
2183 =head2 getroutinglist
2184
2185 @routinglist = getroutinglist($subscriptionid)
2186
2187 this gets the info from the subscriptionroutinglist for $subscriptionid
2188
2189 return :
2190 the routinglist as an array. Each element of the array contains a hash_ref containing
2191 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2192
2193 =cut
2194
2195 sub getroutinglist {
2196     my ($subscriptionid) = @_;
2197     my $dbh              = C4::Context->dbh;
2198     my $sth              = $dbh->prepare(
2199         'SELECT routingid, borrowernumber, ranking, biblionumber
2200             FROM subscription
2201             JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2202             WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2203     );
2204     $sth->execute($subscriptionid);
2205     my $routinglist = $sth->fetchall_arrayref({});
2206     return @{$routinglist};
2207 }
2208
2209 =head2 countissuesfrom
2210
2211 $result = countissuesfrom($subscriptionid,$startdate)
2212
2213 Returns a count of serial rows matching the given subsctiptionid
2214 with published date greater than startdate
2215
2216 =cut
2217
2218 sub countissuesfrom {
2219     my ( $subscriptionid, $startdate ) = @_;
2220     my $dbh   = C4::Context->dbh;
2221     my $query = qq|
2222             SELECT count(*)
2223             FROM   serial
2224             WHERE  subscriptionid=?
2225             AND serial.publisheddate>?
2226         |;
2227     my $sth = $dbh->prepare($query);
2228     $sth->execute( $subscriptionid, $startdate );
2229     my ($countreceived) = $sth->fetchrow;
2230     return $countreceived;
2231 }
2232
2233 =head2 CountIssues
2234
2235 $result = CountIssues($subscriptionid)
2236
2237 Returns a count of serial rows matching the given subsctiptionid
2238
2239 =cut
2240
2241 sub CountIssues {
2242     my ($subscriptionid) = @_;
2243     my $dbh              = C4::Context->dbh;
2244     my $query            = qq|
2245             SELECT count(*)
2246             FROM   serial
2247             WHERE  subscriptionid=?
2248         |;
2249     my $sth = $dbh->prepare($query);
2250     $sth->execute($subscriptionid);
2251     my ($countreceived) = $sth->fetchrow;
2252     return $countreceived;
2253 }
2254
2255 =head2 HasItems
2256
2257 $result = HasItems($subscriptionid)
2258
2259 returns a count of items from serial matching the subscriptionid
2260
2261 =cut
2262
2263 sub HasItems {
2264     my ($subscriptionid) = @_;
2265     my $dbh              = C4::Context->dbh;
2266     my $query = q|
2267             SELECT COUNT(serialitems.itemnumber)
2268             FROM   serial
2269                         LEFT JOIN serialitems USING(serialid)
2270             WHERE  subscriptionid=? AND serialitems.serialid IS NOT NULL
2271         |;
2272     my $sth=$dbh->prepare($query);
2273     $sth->execute($subscriptionid);
2274     my ($countitems)=$sth->fetchrow_array();
2275     return $countitems;
2276 }
2277
2278 =head2 abouttoexpire
2279
2280 $result = abouttoexpire($subscriptionid)
2281
2282 this function alerts you to the penultimate issue for a serial subscription
2283
2284 returns 1 - if this is the penultimate issue
2285 returns 0 - if not
2286
2287 =cut
2288
2289 sub abouttoexpire {
2290     my ($subscriptionid) = @_;
2291     my $dbh              = C4::Context->dbh;
2292     my $subscription     = GetSubscription($subscriptionid);
2293     my $per = $subscription->{'periodicity'};
2294     my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2295     if ($frequency and $frequency->{unit}){
2296
2297         my $expirationdate = GetExpirationDate($subscriptionid);
2298
2299         my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2300         my $nextdate = GetNextDate($subscription, $res);
2301
2302         # only compare dates if both dates exist.
2303         if ($nextdate and $expirationdate) {
2304             if(Date::Calc::Delta_Days(
2305                 split( /-/, $nextdate ),
2306                 split( /-/, $expirationdate )
2307             ) <= 0) {
2308                 return 1;
2309             }
2310         }
2311
2312     } elsif ($subscription->{numberlength}>0) {
2313         return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2314     }
2315
2316     return 0;
2317 }
2318
2319 sub in_array {    # used in next sub down
2320     my ( $val, @elements ) = @_;
2321     foreach my $elem (@elements) {
2322         if ( $val == $elem ) {
2323             return 1;
2324         }
2325     }
2326     return 0;
2327 }
2328
2329 =head2 GetSubscriptionsFromBorrower
2330
2331 ($count,@routinglist) = GetSubscriptionsFromBorrower($borrowernumber)
2332
2333 this gets the info from subscriptionroutinglist for each $subscriptionid
2334
2335 return :
2336 a count of the serial subscription routing lists to which a patron belongs,
2337 with the titles of those serial subscriptions as an array. Each element of the array
2338 contains a hash_ref with subscriptionID and title of subscription.
2339
2340 =cut
2341
2342 sub GetSubscriptionsFromBorrower {
2343     my ($borrowernumber) = @_;
2344     my $dbh              = C4::Context->dbh;
2345     my $sth              = $dbh->prepare(
2346         "SELECT subscription.subscriptionid, biblio.title
2347             FROM subscription
2348             JOIN biblio ON biblio.biblionumber = subscription.biblionumber
2349             JOIN subscriptionroutinglist USING (subscriptionid)
2350             WHERE subscriptionroutinglist.borrowernumber = ? ORDER BY title ASC
2351                                "
2352     );
2353     $sth->execute($borrowernumber);
2354     my @routinglist;
2355     my $count = 0;
2356     while ( my $line = $sth->fetchrow_hashref ) {
2357         $count++;
2358         push( @routinglist, $line );
2359     }
2360     return ( $count, @routinglist );
2361 }
2362
2363
2364 =head2 GetFictiveIssueNumber
2365
2366 $issueno = GetFictiveIssueNumber($subscription, $publishedate);
2367
2368 Get the position of the issue published at $publisheddate, considering the
2369 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2370 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2371 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2372 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2373 depending on how many rows are in serial table.
2374 The issue number calculation is based on subscription frequency, first acquisition
2375 date, and $publisheddate.
2376
2377 =cut
2378
2379 sub GetFictiveIssueNumber {
2380     my ($subscription, $publisheddate) = @_;
2381
2382     my $frequency = GetSubscriptionFrequency($subscription->{'periodicity'});
2383     my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2384     my $issueno = 0;
2385
2386     if($unit) {
2387         my ($year, $month, $day) = split /-/, $publisheddate;
2388         my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{'firstacquidate'};
2389         my $wkno;
2390         my $delta;
2391
2392         if($unit eq 'day') {
2393             $delta = Delta_Days($fa_year, $fa_month, $fa_day, $year, $month, $day);
2394         } elsif($unit eq 'week') {
2395             ($wkno, $year) = Week_of_Year($year, $month, $day);
2396             my ($fa_wkno, $fa_yr) = Week_of_Year($fa_year, $fa_month, $fa_day);
2397             $delta = ($fa_yr == $year) ? ($wkno - $fa_wkno) : ( ($year-$fa_yr-1)*52 + (52-$fa_wkno+$wkno) );
2398         } elsif($unit eq 'month') {
2399             $delta = ($fa_year == $year)
2400                    ? ($month - $fa_month)
2401                    : ( ($year-$fa_year-1)*12 + (12-$fa_month+$month) );
2402         } elsif($unit eq 'year') {
2403             $delta = $year - $fa_year;
2404         }
2405         if($frequency->{'unitsperissue'} == 1) {
2406             $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2407         } else {
2408             # Assuming issuesperunit == 1
2409             $issueno = int( ($delta + $frequency->{'unitsperissue'}) / $frequency->{'unitsperissue'} );
2410         }
2411     }
2412     return $issueno;
2413 }
2414
2415 sub _get_next_date_day {
2416     my ($subscription, $freqdata, $year, $month, $day) = @_;
2417
2418     if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2419         ($year,$month,$day) = Add_Delta_Days($year,$month, $day , $freqdata->{unitsperissue} );
2420         $subscription->{countissuesperunit} = 1;
2421     } else {
2422         $subscription->{countissuesperunit}++;
2423     }
2424
2425     return ($year, $month, $day);
2426 }
2427
2428 sub _get_next_date_week {
2429     my ($subscription, $freqdata, $year, $month, $day) = @_;
2430
2431     my ($wkno, $yr) = Week_of_Year($year, $month, $day);
2432     my $fa_dow = Day_of_Week(split /-/, $subscription->{firstacquidate});
2433
2434     if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2435         $subscription->{countissuesperunit} = 1;
2436         $wkno += $freqdata->{unitsperissue};
2437         if($wkno > 52){
2438             $wkno = $wkno % 52;
2439             $yr++;
2440         }
2441         ($year,$month,$day) = Monday_of_Week($wkno, $yr);
2442         ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $fa_dow - 1);
2443     } else {
2444         # Try to guess the next day of week
2445         my $delta_days = int((7 - ($fa_dow - 1)) / $freqdata->{issuesperunit});
2446         ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $delta_days);
2447         $subscription->{countissuesperunit}++;
2448     }
2449
2450     return ($year, $month, $day);
2451 }
2452
2453 sub _get_next_date_month {
2454     my ($subscription, $freqdata, $year, $month, $day) = @_;
2455
2456     my $fa_day;
2457     (undef, undef, $fa_day) = split /-/, $subscription->{firstacquidate};
2458
2459     if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2460         $subscription->{countissuesperunit} = 1;
2461         ($year,$month,$day) = Add_Delta_YM($year,$month,$day, 0,
2462             $freqdata->{unitsperissue});
2463         my $days_in_month = Days_in_Month($year, $month);
2464         $day = $fa_day <= $days_in_month ? $fa_day : $days_in_month;
2465     } else {
2466         # Try to guess the next day in month
2467         my $days_in_month = Days_in_Month($year, $month);
2468         my $delta_days = int(($days_in_month - ($fa_day - 1)) / $freqdata->{issuesperunit});
2469         ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $delta_days);
2470         $subscription->{countissuesperunit}++;
2471     }
2472
2473     return ($year, $month, $day);
2474 }
2475
2476 sub _get_next_date_year {
2477     my ($subscription, $freqdata, $year, $month, $day) = @_;
2478
2479     my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{firstacquidate};
2480
2481     if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2482         $subscription->{countissuesperunit} = 1;
2483         ($year) = Add_Delta_YM($year,$month,$day, $freqdata->{"unitsperissue"},0);
2484         $month = $fa_month;
2485         my $days_in_month = Days_in_Month($year, $month);
2486         $day = $fa_day <= $days_in_month ? $fa_day : $days_in_month;
2487     } else {
2488         # Try to guess the next day in year
2489         my $days_in_year = Days_in_Year($year,12); #Sum the days of all the months of this year
2490         my $delta_days = int(($days_in_year - ($fa_day - 1)) / $freqdata->{issuesperunit});
2491         ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $delta_days);
2492         $subscription->{countissuesperunit}++;
2493     }
2494
2495     return ($year, $month, $day);
2496 }
2497
2498 =head2 GetNextDate
2499
2500 $resultdate = GetNextDate($publisheddate,$subscription)
2501
2502 this function it takes the publisheddate and will return the next issue's date
2503 and will skip dates if there exists an irregularity.
2504 $publisheddate has to be an ISO date
2505 $subscription is a hashref containing at least 'periodicity', 'firstacquidate', 'irregularity', and 'countissuesperunit'
2506 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2507 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2508 skipped then the returned date will be 2007-05-10
2509
2510 return :
2511 $resultdate - then next date in the sequence (ISO date)
2512
2513 Return undef if subscription is irregular
2514
2515 =cut
2516
2517 sub GetNextDate {
2518     my ( $subscription, $publisheddate, $updatecount ) = @_;
2519
2520     return unless $subscription and $publisheddate;
2521
2522     my $freqdata = GetSubscriptionFrequency($subscription->{'periodicity'});
2523
2524     if ($freqdata->{'unit'}) {
2525         my ( $year, $month, $day ) = split /-/, $publisheddate;
2526
2527         # Process an irregularity Hash
2528         # Suppose that irregularities are stored in a string with this structure
2529         # irreg1;irreg2;irreg3
2530         # where irregX is the number of issue which will not be received
2531         # (the first issue takes the number 1, the 2nd the number 2 and so on)
2532         my %irregularities;
2533         if ( $subscription->{irregularity} ) {
2534             my @irreg = split /;/, $subscription->{'irregularity'} ;
2535             foreach my $irregularity (@irreg) {
2536                 $irregularities{$irregularity} = 1;
2537             }
2538         }
2539
2540         # Get the 'fictive' next issue number
2541         # It is used to check if next issue is an irregular issue.
2542         my $issueno = GetFictiveIssueNumber($subscription, $publisheddate) + 1;
2543
2544         # Then get the next date
2545         my $unit = lc $freqdata->{'unit'};
2546         if ($unit eq 'day') {
2547             while ($irregularities{$issueno}) {
2548                 ($year, $month, $day) = _get_next_date_day($subscription,
2549                     $freqdata, $year, $month, $day);
2550                 $issueno++;
2551             }
2552             ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2553                 $year, $month, $day);
2554         }
2555         elsif ($unit eq 'week') {
2556             while ($irregularities{$issueno}) {
2557                 ($year, $month, $day) = _get_next_date_week($subscription,
2558                     $freqdata, $year, $month, $day);
2559                 $issueno++;
2560             }
2561             ($year, $month, $day) = _get_next_date_week($subscription,
2562                 $freqdata, $year, $month, $day);
2563         }
2564         elsif ($unit eq 'month') {
2565             while ($irregularities{$issueno}) {
2566                 ($year, $month, $day) = _get_next_date_month($subscription,
2567                     $freqdata, $year, $month, $day);
2568                 $issueno++;
2569             }
2570             ($year, $month, $day) = _get_next_date_month($subscription,
2571                 $freqdata, $year, $month, $day);
2572         }
2573         elsif ($unit eq 'year') {
2574             while ($irregularities{$issueno}) {
2575                 ($year, $month, $day) = _get_next_date_year($subscription,
2576                     $freqdata, $year, $month, $day);
2577                 $issueno++;
2578             }
2579             ($year, $month, $day) = _get_next_date_year($subscription,
2580                 $freqdata, $year, $month, $day);
2581         }
2582
2583         if ($updatecount){
2584             my $dbh = C4::Context->dbh;
2585             my $query = qq{
2586                 UPDATE subscription
2587                 SET countissuesperunit = ?
2588                 WHERE subscriptionid = ?
2589             };
2590             my $sth = $dbh->prepare($query);
2591             $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2592         }
2593
2594         return sprintf("%04d-%02d-%02d", $year, $month, $day);
2595     }
2596 }
2597
2598 =head2 _numeration
2599
2600   $string = &_numeration($value,$num_type,$locale);
2601
2602 _numeration returns the string corresponding to $value in the num_type
2603 num_type can take :
2604     -dayname
2605     -monthname
2606     -season
2607 =cut
2608
2609 #'
2610
2611 sub _numeration {
2612     my ($value, $num_type, $locale) = @_;
2613     $value ||= 0;
2614     $num_type //= '';
2615     $locale ||= 'en';
2616     my $string;
2617     if ( $num_type =~ /^dayname$/ ) {
2618         # 1970-11-01 was a Sunday
2619         $value = $value % 7;
2620         my $dt = DateTime->new(
2621             year    => 1970,
2622             month   => 11,
2623             day     => $value + 1,
2624             locale  => $locale,
2625         );
2626         $string = $dt->strftime("%A");
2627     } elsif ( $num_type =~ /^monthname$/ ) {
2628         $value = $value % 12;
2629         my $dt = DateTime->new(
2630             year    => 1970,
2631             month   => $value + 1,
2632             locale  => $locale,
2633         );
2634         $string = $dt->strftime("%B");
2635     } elsif ( $num_type =~ /^season$/ ) {
2636         my @seasons= qw( Spring Summer Fall Winter );
2637         $value = $value % 4;
2638         $string = $seasons[$value];
2639     } else {
2640         $string = $value;
2641     }
2642
2643     return $string;
2644 }
2645
2646 =head2 is_barcode_in_use
2647
2648 Returns number of occurrences of the barcode in the items table
2649 Can be used as a boolean test of whether the barcode has
2650 been deployed as yet
2651
2652 =cut
2653
2654 sub is_barcode_in_use {
2655     my $barcode = shift;
2656     my $dbh       = C4::Context->dbh;
2657     my $occurrences = $dbh->selectall_arrayref(
2658         'SELECT itemnumber from items where barcode = ?',
2659         {}, $barcode
2660
2661     );
2662
2663     return @{$occurrences};
2664 }
2665
2666 =head2 CloseSubscription
2667 Close a subscription given a subscriptionid
2668 =cut
2669 sub CloseSubscription {
2670     my ( $subscriptionid ) = @_;
2671     return unless $subscriptionid;
2672     my $dbh = C4::Context->dbh;
2673     my $sth = $dbh->prepare( q{
2674         UPDATE subscription
2675         SET closed = 1
2676         WHERE subscriptionid = ?
2677     } );
2678     $sth->execute( $subscriptionid );
2679
2680     # Set status = missing when status = stopped
2681     $sth = $dbh->prepare( q{
2682         UPDATE serial
2683         SET status = ?
2684         WHERE subscriptionid = ?
2685         AND status = ?
2686     } );
2687     $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2688 }
2689
2690 =head2 ReopenSubscription
2691 Reopen a subscription given a subscriptionid
2692 =cut
2693 sub ReopenSubscription {
2694     my ( $subscriptionid ) = @_;
2695     return unless $subscriptionid;
2696     my $dbh = C4::Context->dbh;
2697     my $sth = $dbh->prepare( q{
2698         UPDATE subscription
2699         SET closed = 0
2700         WHERE subscriptionid = ?
2701     } );
2702     $sth->execute( $subscriptionid );
2703
2704     # Set status = expected when status = stopped
2705     $sth = $dbh->prepare( q{
2706         UPDATE serial
2707         SET status = ?
2708         WHERE subscriptionid = ?
2709         AND status = ?
2710     } );
2711     $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2712 }
2713
2714 =head2 subscriptionCurrentlyOnOrder
2715
2716     $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2717
2718 Return 1 if subscription is currently on order else 0.
2719
2720 =cut
2721
2722 sub subscriptionCurrentlyOnOrder {
2723     my ( $subscriptionid ) = @_;
2724     my $dbh = C4::Context->dbh;
2725     my $query = qq|
2726         SELECT COUNT(*) FROM aqorders
2727         WHERE subscriptionid = ?
2728             AND datereceived IS NULL
2729             AND datecancellationprinted IS NULL
2730     |;
2731     my $sth = $dbh->prepare( $query );
2732     $sth->execute($subscriptionid);
2733     return $sth->fetchrow_array;
2734 }
2735
2736 =head2 can_claim_subscription
2737
2738     $can = can_claim_subscription( $subscriptionid[, $userid] );
2739
2740 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2741
2742 =cut
2743
2744 sub can_claim_subscription {
2745     my ( $subscription, $userid ) = @_;
2746     return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2747 }
2748
2749 =head2 can_edit_subscription
2750
2751     $can = can_edit_subscription( $subscriptionid[, $userid] );
2752
2753 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2754
2755 =cut
2756
2757 sub can_edit_subscription {
2758     my ( $subscription, $userid ) = @_;
2759     return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2760 }
2761
2762 =head2 can_show_subscription
2763
2764     $can = can_show_subscription( $subscriptionid[, $userid] );
2765
2766 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2767
2768 =cut
2769
2770 sub can_show_subscription {
2771     my ( $subscription, $userid ) = @_;
2772     return _can_do_on_subscription( $subscription, $userid, '*' );
2773 }
2774
2775 sub _can_do_on_subscription {
2776     my ( $subscription, $userid, $permission ) = @_;
2777     return 0 unless C4::Context->userenv;
2778     my $flags = C4::Context->userenv->{flags};
2779     $userid ||= C4::Context->userenv->{'id'};
2780
2781     if ( C4::Context->preference('IndependentBranches') ) {
2782         return 1
2783           if C4::Context->IsSuperLibrarian()
2784               or
2785               C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2786               or (
2787                   C4::Auth::haspermission( $userid,
2788                       { serials => $permission } )
2789                   and (  not defined $subscription->{branchcode}
2790                       or $subscription->{branchcode} eq ''
2791                       or $subscription->{branchcode} eq
2792                       C4::Context->userenv->{'branch'} )
2793               );
2794     }
2795     else {
2796         return 1
2797           if C4::Context->IsSuperLibrarian()
2798               or
2799               C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2800               or C4::Auth::haspermission(
2801                   $userid, { serials => $permission }
2802               ),
2803         ;
2804     }
2805     return 0;
2806 }
2807
2808 1;
2809 __END__
2810
2811 =head1 AUTHOR
2812
2813 Koha Development Team <http://koha-community.org/>
2814
2815 =cut