C4/Serials.pm

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