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