C4/Serials.pm

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