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