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