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