C4/Serials.pm

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