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