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