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