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