C4/Serials.pm

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