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