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