C4/Serials.pm

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