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