C4/Serials.pm

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