C4/Serials.pm

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