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