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