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