C4/Serials.pm

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