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