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