koha-dev.rot13.org Git - srvgit/blob - C4/Serials.pm

   1 package C4::Serials;    #assumes C4/Serials.pm
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 USA
  19
  20
  21 use strict;
  22 use C4::Dates qw(format_date 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, enddate, missinglist, recievedlist, opacnote, librariannote)
1358         VALUES (?,?,?,?,?,?,?,?)
1359         );
1360     $sth = $dbh->prepare($query);
1361     $sth->execute( $biblionumber, $subscriptionid,
1362         format_date_in_iso($startdate),
1363         0, "", "", "", "$notes" );
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     return $subscriptionid;
1393 }
1394
1395 =head2 ReNewSubscription
1396
1397 =over 4
1398
1399 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1400
1401 this function renew a subscription with values given on input args.
1402
1403 =back
1404
1405 =cut
1406
1407 sub ReNewSubscription {
1408     my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength,
1409         $monthlength, $note )
1410       = @_;
1411     my $dbh          = C4::Context->dbh;
1412     my $subscription = GetSubscription($subscriptionid);
1413      my $query        = qq|
1414          SELECT *
1415          FROM   biblio
1416          LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1417          WHERE    biblio.biblionumber=?
1418      |;
1419      my $sth = $dbh->prepare($query);
1420      $sth->execute( $subscription->{biblionumber} );
1421      my $biblio = $sth->fetchrow_hashref;
1422      NewSuggestion(
1423          $user,             $subscription->{bibliotitle},
1424          $biblio->{author}, $biblio->{publishercode},
1425          $biblio->{note},   '',
1426          '',                '',
1427          '',                '',
1428          $subscription->{biblionumber}
1429      );
1430
1431     # renew subscription
1432     $query = qq|
1433         UPDATE subscription
1434         SET    startdate=?,numberlength=?,weeklength=?,monthlength=?
1435         WHERE  subscriptionid=?
1436     |;
1437     $sth = $dbh->prepare($query);
1438     $sth->execute( format_date_in_iso($startdate),
1439         $numberlength, $weeklength, $monthlength, $subscriptionid );
1440
1441     &logaction(C4::Context->userenv->{'number'},"SERIAL","RENEW",$subscriptionid,"")
1442         if C4::Context->preference("SubscriptionLog");
1443 }
1444
1445 =head2 NewIssue
1446
1447 =over 4
1448
1449 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate,  $notes)
1450
1451 Create a new issue stored on the database.
1452 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1453
1454 =back
1455
1456 =cut
1457
1458 sub NewIssue {
1459     my ( $serialseq, $subscriptionid, $biblionumber, $status,
1460         $planneddate, $publisheddate, $notes )
1461       = @_;
1462     ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1463
1464     my $dbh   = C4::Context->dbh;
1465     my $query = qq|
1466         INSERT INTO serial
1467             (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1468         VALUES (?,?,?,?,?,?,?)
1469     |;
1470     my $sth = $dbh->prepare($query);
1471     $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status,
1472         $publisheddate, $planneddate,$notes );
1473     my $serialid=$dbh->{'mysql_insertid'};
1474     $query = qq|
1475         SELECT missinglist,recievedlist
1476         FROM   subscriptionhistory
1477         WHERE  subscriptionid=?
1478     |;
1479     $sth = $dbh->prepare($query);
1480     $sth->execute($subscriptionid);
1481     my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1482
1483     if ( $status eq 2 ) {
1484       ### TODO Add a feature that improves recognition and description.
1485       ### As such count (serialseq) i.e. : N18,2(N19),N20
1486       ### Would use substr and index But be careful to previous presence of ()
1487         $recievedlist .= ",$serialseq" unless (index($recievedlist,$serialseq)>0);
1488     }
1489     if ( $status eq 4 ) {
1490         $missinglist .= ",$serialseq" unless (index($missinglist,$serialseq)>0);
1491     }
1492     $query = qq|
1493         UPDATE subscriptionhistory
1494         SET    recievedlist=?, missinglist=?
1495         WHERE  subscriptionid=?
1496     |;
1497     $sth = $dbh->prepare($query);
1498     $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1499     return $serialid;
1500 }
1501
1502 =head2 ItemizeSerials
1503
1504 =over 4
1505
1506 ItemizeSerials($serialid, $info);
1507 $info is a hashref containing  barcode branch, itemcallnumber, status, location
1508 $serialid the serialid
1509 return :
1510 1 if the itemize is a succes.
1511 0 and @error else. @error containts the list of errors found.
1512
1513 =back
1514
1515 =cut
1516
1517 sub ItemizeSerials {
1518     my ( $serialid, $info ) = @_;
1519     my $now = POSIX::strftime( "%Y-%m-%d",localtime );
1520
1521     my $dbh   = C4::Context->dbh;
1522     my $query = qq|
1523         SELECT *
1524         FROM   serial
1525         WHERE  serialid=?
1526     |;
1527     my $sth = $dbh->prepare($query);
1528     $sth->execute($serialid);
1529     my $data = $sth->fetchrow_hashref;
1530     if ( C4::Context->preference("RoutingSerials") ) {
1531
1532         # check for existing biblioitem relating to serial issue
1533         my ( $count, @results ) =
1534           GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1535         my $bibitemno = 0;
1536         for ( my $i = 0 ; $i < $count ; $i++ ) {
1537             if (  $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' ('
1538                 . $data->{'planneddate'}
1539                 . ')' )
1540             {
1541                 $bibitemno = $results[$i]->{'biblioitemnumber'};
1542                 last;
1543             }
1544         }
1545         if ( $bibitemno == 0 ) {
1546
1547     # warn "need to add new biblioitem so copy last one and make minor changes";
1548             my $sth =
1549               $dbh->prepare(
1550 "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC"
1551               );
1552             $sth->execute( $data->{'biblionumber'} );
1553             my $biblioitem = $sth->fetchrow_hashref;
1554             $biblioitem->{'volumedate'} =
1555               format_date_in_iso( $data->{planneddate} );
1556             $biblioitem->{'volumeddesc'} =
1557               $data->{serialseq} . ' ('
1558               . format_date( $data->{'planneddate'} ) . ')';
1559             $biblioitem->{'dewey'} = $info->{itemcallnumber};
1560
1561             #FIXME  HDL : I don't understand why you need to call newbiblioitem, as the biblioitem should already be somewhere.
1562             # so I comment it, we can speak of it when you want
1563             # newbiblioitems has been removed from Biblio.pm, as it has a deprecated API now
1564 #             if ( $info->{barcode} )
1565 #             {    # only make biblioitem if we are going to make item also
1566 #                 $bibitemno = newbiblioitem($biblioitem);
1567 #             }
1568         }
1569     }
1570
1571     my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1572     if ( $info->{barcode} ) {
1573         my @errors;
1574         my $exists = itemdata( $info->{'barcode'} );
1575         push @errors, "barcode_not_unique" if ($exists);
1576         unless ($exists) {
1577             my $marcrecord = MARC::Record->new();
1578             my ( $tag, $subfield ) =
1579               GetMarcFromKohaField( "items.barcode", $fwk );
1580             my $newField =
1581               MARC::Field->new( "$tag", '', '',
1582                 "$subfield" => $info->{barcode} );
1583             $marcrecord->insert_fields_ordered($newField);
1584             if ( $info->{branch} ) {
1585                 my ( $tag, $subfield ) =
1586                   GetMarcFromKohaField( "items.homebranch",
1587                     $fwk );
1588
1589                 #warn "items.homebranch : $tag , $subfield";
1590                 if ( $marcrecord->field($tag) ) {
1591                     $marcrecord->field($tag)
1592                       ->add_subfields( "$subfield" => $info->{branch} );
1593                 }
1594                 else {
1595                     my $newField =
1596                       MARC::Field->new( "$tag", '', '',
1597                         "$subfield" => $info->{branch} );
1598                     $marcrecord->insert_fields_ordered($newField);
1599                 }
1600                 ( $tag, $subfield ) =
1601                   GetMarcFromKohaField( "items.holdingbranch",
1602                     $fwk );
1603
1604                 #warn "items.holdingbranch : $tag , $subfield";
1605                 if ( $marcrecord->field($tag) ) {
1606                     $marcrecord->field($tag)
1607                       ->add_subfields( "$subfield" => $info->{branch} );
1608                 }
1609                 else {
1610                     my $newField =
1611                       MARC::Field->new( "$tag", '', '',
1612                         "$subfield" => $info->{branch} );
1613                     $marcrecord->insert_fields_ordered($newField);
1614                 }
1615             }
1616             if ( $info->{itemcallnumber} ) {
1617                 my ( $tag, $subfield ) =
1618                   GetMarcFromKohaField( "items.itemcallnumber",
1619                     $fwk );
1620
1621                 #warn "items.itemcallnumber : $tag , $subfield";
1622                 if ( $marcrecord->field($tag) ) {
1623                     $marcrecord->field($tag)
1624                       ->add_subfields( "$subfield" => $info->{itemcallnumber} );
1625                 }
1626                 else {
1627                     my $newField =
1628                       MARC::Field->new( "$tag", '', '',
1629                         "$subfield" => $info->{itemcallnumber} );
1630                     $marcrecord->insert_fields_ordered($newField);
1631                 }
1632             }
1633             if ( $info->{notes} ) {
1634                 my ( $tag, $subfield ) =
1635                   GetMarcFromKohaField( "items.itemnotes", $fwk );
1636
1637                 # warn "items.itemnotes : $tag , $subfield";
1638                 if ( $marcrecord->field($tag) ) {
1639                     $marcrecord->field($tag)
1640                       ->add_subfields( "$subfield" => $info->{notes} );
1641                 }
1642                 else {
1643                     my $newField =
1644                       MARC::Field->new( "$tag", '', '',
1645                         "$subfield" => $info->{notes} );
1646                     $marcrecord->insert_fields_ordered($newField);
1647                 }
1648             }
1649             if ( $info->{location} ) {
1650                 my ( $tag, $subfield ) =
1651                   GetMarcFromKohaField( "items.location", $fwk );
1652
1653                 # warn "items.location : $tag , $subfield";
1654                 if ( $marcrecord->field($tag) ) {
1655                     $marcrecord->field($tag)
1656                       ->add_subfields( "$subfield" => $info->{location} );
1657                 }
1658                 else {
1659                     my $newField =
1660                       MARC::Field->new( "$tag", '', '',
1661                         "$subfield" => $info->{location} );
1662                     $marcrecord->insert_fields_ordered($newField);
1663                 }
1664             }
1665             if ( $info->{status} ) {
1666                 my ( $tag, $subfield ) =
1667                   GetMarcFromKohaField( "items.notforloan",
1668                     $fwk );
1669
1670                 # warn "items.notforloan : $tag , $subfield";
1671                 if ( $marcrecord->field($tag) ) {
1672                     $marcrecord->field($tag)
1673                       ->add_subfields( "$subfield" => $info->{status} );
1674                 }
1675                 else {
1676                     my $newField =
1677                       MARC::Field->new( "$tag", '', '',
1678                         "$subfield" => $info->{status} );
1679                     $marcrecord->insert_fields_ordered($newField);
1680                 }
1681             }
1682             if ( C4::Context->preference("RoutingSerials") ) {
1683                 my ( $tag, $subfield ) =
1684                   GetMarcFromKohaField( "items.dateaccessioned",
1685                     $fwk );
1686                 if ( $marcrecord->field($tag) ) {
1687                     $marcrecord->field($tag)
1688                       ->add_subfields( "$subfield" => $now );
1689                 }
1690                 else {
1691                     my $newField =
1692                       MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1693                     $marcrecord->insert_fields_ordered($newField);
1694                 }
1695             }
1696             AddItemFromMarc( $marcrecord, $data->{'biblionumber'} );
1697             return 1;
1698         }
1699         return ( 0, @errors );
1700     }
1701 }
1702
1703 =head2 HasSubscriptionExpired
1704
1705 =over 4
1706
1707 1 or 0 = HasSubscriptionExpired($subscriptionid)
1708
1709 the subscription has expired when the next issue to arrive is out of subscription limit.
1710
1711 return :
1712 1 if true, 0 if false.
1713
1714 =back
1715
1716 =cut
1717
1718 sub HasSubscriptionExpired {
1719     my ($subscriptionid) = @_;
1720     my $dbh              = C4::Context->dbh;
1721     my $subscription     = GetSubscription($subscriptionid);
1722     if (($subscription->{periodicity} % 16)>0){
1723       my $expirationdate   = GetExpirationDate($subscriptionid);
1724       my $query = qq|
1725             SELECT max(planneddate)
1726             FROM   serial
1727             WHERE  subscriptionid=?
1728       |;
1729       my $sth = $dbh->prepare($query);
1730       $sth->execute($subscriptionid);
1731       my ($res) = $sth->fetchrow  ;
1732       my @res=split (/-/,$res);
1733 # warn "date expiration :$expirationdate";
1734       my @endofsubscriptiondate=split(/-/,$expirationdate);
1735       return 1 if ( (@endofsubscriptiondate && Delta_Days($res[0],$res[1],$res[2],
1736                   $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) <= 0)
1737                   || (!$res));
1738       return 0;
1739     } else {
1740       if ($subscription->{'numberlength'}){
1741         my $countreceived=countissuesfrom($subscriptionid,$subscription->{'startdate'});
1742         return 1 if ($countreceived >$subscription->{'numberlentgh'});
1743               return 0;
1744       } else {
1745               return 0;
1746       }
1747     }
1748     return 0;
1749 }
1750
1751 =head2 SetDistributedto
1752
1753 =over 4
1754
1755 SetDistributedto($distributedto,$subscriptionid);
1756 This function update the value of distributedto for a subscription given on input arg.
1757
1758 =back
1759
1760 =cut
1761
1762 sub SetDistributedto {
1763     my ( $distributedto, $subscriptionid ) = @_;
1764     my $dbh   = C4::Context->dbh;
1765     my $query = qq|
1766         UPDATE subscription
1767         SET    distributedto=?
1768         WHERE  subscriptionid=?
1769     |;
1770     my $sth = $dbh->prepare($query);
1771     $sth->execute( $distributedto, $subscriptionid );
1772 }
1773
1774 =head2 DelSubscription
1775
1776 =over 4
1777
1778 DelSubscription($subscriptionid)
1779 this function delete the subscription which has $subscriptionid as id.
1780
1781 =back
1782
1783 =cut
1784
1785 sub DelSubscription {
1786     my ($subscriptionid) = @_;
1787     my $dbh = C4::Context->dbh;
1788     $subscriptionid = $dbh->quote($subscriptionid);
1789     $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1790     $dbh->do(
1791         "DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1792     $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1793
1794     &logaction(C4::Context->userenv->{'number'},"SERIAL","DELETE",$subscriptionid,"")
1795         if C4::Context->preference("SubscriptionLog");
1796 }
1797
1798 =head2 DelIssue
1799
1800 =over 4
1801
1802 DelIssue($serialseq,$subscriptionid)
1803 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1804
1805 =back
1806
1807 =cut
1808
1809 sub DelIssue {
1810     my ( $dataissue) = @_;
1811     my $dbh   = C4::Context->dbh;
1812     ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1813
1814     my $query = qq|
1815         DELETE FROM serial
1816         WHERE       serialid= ?
1817         AND         subscriptionid= ?
1818     |;
1819     my $mainsth = $dbh->prepare($query);
1820     $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'});
1821
1822     #Delete element from subscription history
1823     $query = "SELECT * FROM   subscription WHERE  subscriptionid = ?";
1824     my $sth   = $dbh->prepare($query);
1825     $sth->execute($dataissue->{'subscriptionid'});
1826     my $val = $sth->fetchrow_hashref;
1827     unless ( $val->{manualhistory} ) {
1828         my $query = qq|
1829           SELECT * FROM subscriptionhistory
1830           WHERE       subscriptionid= ?
1831       |;
1832         my $sth = $dbh->prepare($query);
1833         $sth->execute($dataissue->{'subscriptionid'});
1834         my $data = $sth->fetchrow_hashref;
1835         my $serialseq= $dataissue->{'serialseq'};
1836         $data->{'missinglist'}  =~ s/\b$serialseq\b//;
1837         $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1838         my $strsth = "UPDATE subscriptionhistory SET "
1839           . join( ",",
1840             map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data )
1841           . " WHERE subscriptionid=?";
1842         $sth = $dbh->prepare($strsth);
1843         $sth->execute($dataissue->{'subscriptionid'});
1844     }
1845
1846     return $mainsth->rows;
1847 }
1848
1849 =head2 GetLateOrMissingIssues
1850
1851 =over 4
1852
1853 ($count,@issuelist) = &GetLateMissingIssues($supplierid,$serialid)
1854
1855 this function select missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1856
1857 return :
1858 a count of the number of missing issues
1859 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1860 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1861
1862 =back
1863
1864 =cut
1865
1866 sub GetLateOrMissingIssues {
1867     my ( $supplierid, $serialid,$order ) = @_;
1868     my $dbh = C4::Context->dbh;
1869     my $sth;
1870     my $byserial = '';
1871     if ($serialid) {
1872         $byserial = "and serialid = " . $serialid;
1873     }
1874     if ($order){
1875       $order.=", title";
1876     } else {
1877       $order="title";
1878     }
1879     if ($supplierid) {
1880         $sth = $dbh->prepare(
1881 "SELECT
1882    serialid,
1883    aqbooksellerid,
1884    name,
1885    biblio.title,
1886    planneddate,
1887    serialseq,
1888    serial.status,
1889    serial.subscriptionid,
1890    claimdate
1891 FROM      serial
1892 LEFT JOIN subscription  ON serial.subscriptionid=subscription.subscriptionid
1893 LEFT JOIN biblio        ON subscription.biblionumber=biblio.biblionumber
1894 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1895 WHERE subscription.subscriptionid = serial.subscriptionid
1896 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1897 AND subscription.aqbooksellerid=$supplierid
1898 $byserial
1899 ORDER BY $order"
1900         );
1901     }
1902     else {
1903         $sth = $dbh->prepare(
1904 "SELECT
1905    serialid,
1906    aqbooksellerid,
1907    name,
1908    biblio.title,
1909    planneddate,
1910    serialseq,
1911    serial.status,
1912    serial.subscriptionid,
1913    claimdate
1914 FROM serial
1915 LEFT JOIN subscription
1916 ON serial.subscriptionid=subscription.subscriptionid
1917 LEFT JOIN biblio
1918 ON subscription.biblionumber=biblio.biblionumber
1919 LEFT JOIN aqbooksellers
1920 ON subscription.aqbooksellerid = aqbooksellers.id
1921 WHERE
1922    subscription.subscriptionid = serial.subscriptionid
1923 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1924 $byserial
1925 ORDER BY $order"
1926         );
1927     }
1928     $sth->execute;
1929     my @issuelist;
1930     my $last_title;
1931     my $odd   = 0;
1932     my $count = 0;
1933     while ( my $line = $sth->fetchrow_hashref ) {
1934         $odd++ unless $line->{title} eq $last_title;
1935         $last_title = $line->{title} if ( $line->{title} );
1936         $line->{planneddate} = format_date( $line->{planneddate} );
1937         $line->{claimdate}   = format_date( $line->{claimdate} );
1938         $line->{"status".$line->{status}}   = 1;
1939         $line->{'odd'} = 1 if $odd % 2;
1940         $count++;
1941         push @issuelist, $line;
1942     }
1943     return $count, @issuelist;
1944 }
1945
1946 =head2 removeMissingIssue
1947
1948 =over 4
1949
1950 removeMissingIssue($subscriptionid)
1951
1952 this function removes an issue from being part of the missing string in
1953 subscriptionlist.missinglist column
1954
1955 called when a missing issue is found from the serials-recieve.pl file
1956
1957 =back
1958
1959 =cut
1960
1961 sub removeMissingIssue {
1962     my ( $sequence, $subscriptionid ) = @_;
1963     my $dbh = C4::Context->dbh;
1964     my $sth =
1965       $dbh->prepare(
1966         "SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1967     $sth->execute($subscriptionid);
1968     my $data              = $sth->fetchrow_hashref;
1969     my $missinglist       = $data->{'missinglist'};
1970     my $missinglistbefore = $missinglist;
1971
1972     # warn $missinglist." before";
1973     $missinglist =~ s/($sequence)//;
1974
1975     # warn $missinglist." after";
1976     if ( $missinglist ne $missinglistbefore ) {
1977         $missinglist =~ s/\|\s\|/\|/g;
1978         $missinglist =~ s/^\| //g;
1979         $missinglist =~ s/\|$//g;
1980         my $sth2 = $dbh->prepare(
1981             "UPDATE subscriptionhistory
1982                                        SET missinglist = ?
1983                                        WHERE subscriptionid = ?"
1984         );
1985         $sth2->execute( $missinglist, $subscriptionid );
1986     }
1987 }
1988
1989 =head2 updateClaim
1990
1991 =over 4
1992
1993 &updateClaim($serialid)
1994
1995 this function updates the time when a claim is issued for late/missing items
1996
1997 called from claims.pl file
1998
1999 =back
2000
2001 =cut
2002
2003 sub updateClaim {
2004     my ($serialid) = @_;
2005     my $dbh        = C4::Context->dbh;
2006     my $sth        = $dbh->prepare(
2007         "UPDATE serial SET claimdate = now()
2008                                    WHERE serialid = ?
2009                                    "
2010     );
2011     $sth->execute($serialid);
2012 }
2013
2014 =head2 getsupplierbyserialid
2015
2016 =over 4
2017
2018 ($result) = &getsupplierbyserialid($serialid)
2019
2020 this function is used to find the supplier id given a serial id
2021
2022 return :
2023 hashref containing serialid, subscriptionid, and aqbooksellerid
2024
2025 =back
2026
2027 =cut
2028
2029 sub getsupplierbyserialid {
2030     my ($serialid) = @_;
2031     my $dbh        = C4::Context->dbh;
2032     my $sth        = $dbh->prepare(
2033         "SELECT serialid, serial.subscriptionid, aqbooksellerid
2034          FROM serial
2035          LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2036          WHERE serialid = ?
2037                                    "
2038     );
2039     $sth->execute($serialid);
2040     my $line   = $sth->fetchrow_hashref;
2041     my $result = $line->{'aqbooksellerid'};
2042     return $result;
2043 }
2044
2045 =head2 check_routing
2046
2047 =over 4
2048
2049 ($result) = &check_routing($subscriptionid)
2050
2051 this function checks to see if a serial has a routing list and returns the count of routingid
2052 used to show either an 'add' or 'edit' link
2053 =back
2054
2055 =cut
2056
2057 sub check_routing {
2058     my ($subscriptionid) = @_;
2059     my $dbh              = C4::Context->dbh;
2060     my $sth              = $dbh->prepare(
2061 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2062                               ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2063                               WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2064                               "
2065     );
2066     $sth->execute($subscriptionid);
2067     my $line   = $sth->fetchrow_hashref;
2068     my $result = $line->{'routingids'};
2069     return $result;
2070 }
2071
2072 =head2 addroutingmember
2073
2074 =over 4
2075
2076 &addroutingmember($borrowernumber,$subscriptionid)
2077
2078 this function takes a borrowernumber and subscriptionid and add the member to the
2079 routing list for that serial subscription and gives them a rank on the list
2080 of either 1 or highest current rank + 1
2081
2082 =back
2083
2084 =cut
2085
2086 sub addroutingmember {
2087     my ( $borrowernumber, $subscriptionid ) = @_;
2088     my $rank;
2089     my $dbh = C4::Context->dbh;
2090     my $sth =
2091       $dbh->prepare(
2092 "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?"
2093       );
2094     $sth->execute($subscriptionid);
2095     while ( my $line = $sth->fetchrow_hashref ) {
2096         if ( $line->{'rank'} > 0 ) {
2097             $rank = $line->{'rank'} + 1;
2098         }
2099         else {
2100             $rank = 1;
2101         }
2102     }
2103     $sth =
2104       $dbh->prepare(
2105 "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)"
2106       );
2107     $sth->execute( $subscriptionid, $borrowernumber, $rank );
2108 }
2109
2110 =head2 reorder_members
2111
2112 =over 4
2113
2114 &reorder_members($subscriptionid,$routingid,$rank)
2115
2116 this function is used to reorder the routing list
2117
2118 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2119 - it gets all members on list puts their routingid's into an array
2120 - removes the one in the array that is $routingid
2121 - then reinjects $routingid at point indicated by $rank
2122 - then update the database with the routingids in the new order
2123
2124 =back
2125
2126 =cut
2127
2128 sub reorder_members {
2129     my ( $subscriptionid, $routingid, $rank ) = @_;
2130     my $dbh = C4::Context->dbh;
2131     my $sth =
2132       $dbh->prepare(
2133 "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC"
2134       );
2135     $sth->execute($subscriptionid);
2136     my @result;
2137     while ( my $line = $sth->fetchrow_hashref ) {
2138         push( @result, $line->{'routingid'} );
2139     }
2140
2141     # To find the matching index
2142     my $i;
2143     my $key = -1;    # to allow for 0 being a valid response
2144     for ( $i = 0 ; $i < @result ; $i++ ) {
2145         if ( $routingid == $result[$i] ) {
2146             $key = $i;    # save the index
2147             last;
2148         }
2149     }
2150
2151     # if index exists in array then move it to new position
2152     if ( $key > -1 && $rank > 0 ) {
2153         my $new_rank = $rank -
2154           1;    # $new_rank is what you want the new index to be in the array
2155         my $moving_item = splice( @result, $key, 1 );
2156         splice( @result, $new_rank, 0, $moving_item );
2157     }
2158     for ( my $j = 0 ; $j < @result ; $j++ ) {
2159         my $sth =
2160           $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '"
2161               . ( $j + 1 )
2162               . "' WHERE routingid = '"
2163               . $result[$j]
2164               . "'" );
2165         $sth->execute;
2166     }
2167 }
2168
2169 =head2 delroutingmember
2170
2171 =over 4
2172
2173 &delroutingmember($routingid,$subscriptionid)
2174
2175 this function either deletes one member from routing list if $routingid exists otherwise
2176 deletes all members from the routing list
2177
2178 =back
2179
2180 =cut
2181
2182 sub delroutingmember {
2183
2184 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2185     my ( $routingid, $subscriptionid ) = @_;
2186     my $dbh = C4::Context->dbh;
2187     if ($routingid) {
2188         my $sth =
2189           $dbh->prepare(
2190             "DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2191         $sth->execute($routingid);
2192         reorder_members( $subscriptionid, $routingid );
2193     }
2194     else {
2195         my $sth =
2196           $dbh->prepare(
2197             "DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2198         $sth->execute($subscriptionid);
2199     }
2200 }
2201
2202 =head2 getroutinglist
2203
2204 =over 4
2205
2206 ($count,@routinglist) = &getroutinglist($subscriptionid)
2207
2208 this gets the info from the subscriptionroutinglist for $subscriptionid
2209
2210 return :
2211 a count of the number of members on routinglist
2212 the routinglist into a table. Each line of this table containts a ref to a hash which containts
2213 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2214
2215 =back
2216
2217 =cut
2218
2219 sub getroutinglist {
2220     my ($subscriptionid) = @_;
2221     my $dbh              = C4::Context->dbh;
2222     my $sth              = $dbh->prepare(
2223         "SELECT routingid, borrowernumber,
2224                               ranking, biblionumber
2225          FROM subscription
2226          LEFT JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2227          WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2228                               "
2229     );
2230     $sth->execute($subscriptionid);
2231     my @routinglist;
2232     my $count = 0;
2233     while ( my $line = $sth->fetchrow_hashref ) {
2234         $count++;
2235         push( @routinglist, $line );
2236     }
2237     return ( $count, @routinglist );
2238 }
2239
2240 =head2 countissuesfrom
2241
2242 =over 4
2243
2244 $result = &countissuesfrom($subscriptionid,$startdate)
2245
2246
2247 =back
2248
2249 =cut
2250
2251 sub countissuesfrom {
2252     my ($subscriptionid,$startdate) = @_;
2253     my $dbh              = C4::Context->dbh;
2254     my $query = qq|
2255             SELECT count(*)
2256             FROM   serial
2257             WHERE  subscriptionid=?
2258             AND serial.publisheddate>?
2259         |;
2260     my $sth=$dbh->prepare($query);
2261     $sth->execute($subscriptionid, $startdate);
2262     my ($countreceived)=$sth->fetchrow;
2263     return $countreceived;
2264 }
2265
2266 =head2 abouttoexpire
2267
2268 =over 4
2269
2270 $result = &abouttoexpire($subscriptionid)
2271
2272 this function alerts you to the penultimate issue for a serial subscription
2273
2274 returns 1 - if this is the penultimate issue
2275 returns 0 - if not
2276
2277 =back
2278
2279 =cut
2280
2281 sub abouttoexpire {
2282     my ($subscriptionid) = @_;
2283     my $dbh              = C4::Context->dbh;
2284     my $subscription     = GetSubscription($subscriptionid);
2285     my $per = $subscription->{'periodicity'};
2286     if ($per % 16>0){
2287       my $expirationdate   = GetExpirationDate($subscriptionid);
2288       my $sth =
2289         $dbh->prepare(
2290           "select max(planneddate) from serial where subscriptionid=?");
2291       $sth->execute($subscriptionid);
2292       my ($res) = $sth->fetchrow ;
2293 #        warn "date expiration : ".$expirationdate." date courante ".$res;
2294       my @res=split /-/,$res;
2295       @res=Date::Calc::Today if ($res[0]*$res[1]==0);
2296       my @endofsubscriptiondate=split/-/,$expirationdate;
2297       my $x;
2298       if ( $per == 1 ) {$x=7;}
2299       if ( $per == 2 ) {$x=7; }
2300       if ( $per == 3 ) {$x=14;}
2301       if ( $per == 4 ) { $x = 21; }
2302       if ( $per == 5 ) { $x = 31; }
2303       if ( $per == 6 ) { $x = 62; }
2304       if ( $per == 7 || $per == 8 ) { $x = 93; }
2305       if ( $per == 9 )  { $x = 190; }
2306       if ( $per == 10 ) { $x = 365; }
2307       if ( $per == 11 ) { $x = 730; }
2308       my @datebeforeend=Add_Delta_Days(  $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
2309                     - (3 * $x)) if (@endofsubscriptiondate && $endofsubscriptiondate[0]*$endofsubscriptiondate[1]*$endofsubscriptiondate[2]);
2310               # warn "DATE BEFORE END: $datebeforeend";
2311       return 1 if ( @res &&
2312                     (@datebeforeend &&
2313                         Delta_Days($res[0],$res[1],$res[2],
2314                         $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) &&
2315                     (@endofsubscriptiondate &&
2316                         Delta_Days($res[0],$res[1],$res[2],
2317                         $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
2318     return 0;
2319    } elsif ($subscription->{numberlength}>0) {
2320     return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2321    } else {return 0}
2322 }
2323
2324 =head2 old_newsubscription
2325
2326 =over 4
2327
2328 ($subscriptionid) = &old_newsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2329                         $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2330                         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2331                         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2332                         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2333                         $numberingmethod, $status, $callnumber, $notes, $hemisphere)
2334
2335 this function is similar to the NewSubscription subroutine but has a few different
2336 values passed in
2337 $firstacquidate - date of first serial issue to arrive
2338 $irregularity - the issues not expected separated by a '|'
2339 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2340 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2341    subscription-add.tmpl file
2342 $callnumber - display the callnumber of the serial
2343 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2344
2345 return :
2346 the $subscriptionid number of the new subscription
2347
2348 =back
2349
2350 =cut
2351
2352 sub old_newsubscription {
2353     my (
2354         $auser,         $aqbooksellerid,  $cost,          $aqbudgetid,
2355         $biblionumber,  $startdate,       $periodicity,   $firstacquidate,
2356         $dow,           $irregularity,    $numberpattern, $numberlength,
2357         $weeklength,    $monthlength,     $add1,          $every1,
2358         $whenmorethan1, $setto1,          $lastvalue1,    $add2,
2359         $every2,        $whenmorethan2,   $setto2,        $lastvalue2,
2360         $add3,          $every3,          $whenmorethan3, $setto3,
2361         $lastvalue3,    $numberingmethod, $status,        $callnumber,
2362         $notes,         $hemisphere
2363     ) = @_;
2364     my $dbh = C4::Context->dbh;
2365
2366     #save subscription
2367     my $sth = $dbh->prepare(
2368 "insert into subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
2369                                                         startdate,periodicity,firstacquidate,dow,irregularity,numberpattern,numberlength,weeklength,monthlength,
2370                                                                 add1,every1,whenmorethan1,setto1,lastvalue1,
2371                                                                 add2,every2,whenmorethan2,setto2,lastvalue2,
2372                                                                 add3,every3,whenmorethan3,setto3,lastvalue3,
2373                                                                 numberingmethod, status, callnumber, notes, hemisphere) values
2374                                                           (?,?,?,?,?,?,?,?,?,?,?,
2375                                                                                            ?,?,?,?,?,?,?,?,?,?,?,
2376                                                                                            ?,?,?,?,?,?,?,?,?,?,?,?)"
2377     );
2378     $sth->execute(
2379         $auser,         $aqbooksellerid,
2380         $cost,          $aqbudgetid,
2381         $biblionumber,  format_date_in_iso($startdate),
2382         $periodicity,   format_date_in_iso($firstacquidate),
2383         $dow,           $irregularity,
2384         $numberpattern, $numberlength,
2385         $weeklength,    $monthlength,
2386         $add1,          $every1,
2387         $whenmorethan1, $setto1,
2388         $lastvalue1,    $add2,
2389         $every2,        $whenmorethan2,
2390         $setto2,        $lastvalue2,
2391         $add3,          $every3,
2392         $whenmorethan3, $setto3,
2393         $lastvalue3,    $numberingmethod,
2394         $status,        $callnumber,
2395         $notes,         $hemisphere
2396     );
2397
2398     #then create the 1st waited number
2399     my $subscriptionid = $dbh->{'mysql_insertid'};
2400     my $enddate        = GetExpirationDate($subscriptionid);
2401
2402     $sth =
2403       $dbh->prepare(
2404 "insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)"
2405       );
2406     $sth->execute(
2407         $biblionumber, $subscriptionid,
2408         format_date_in_iso($startdate),
2409         format_date_in_iso($enddate),
2410         "", "", "", $notes
2411     );
2412
2413    # reread subscription to get a hash (for calculation of the 1st issue number)
2414     $sth =
2415       $dbh->prepare("select * from subscription where subscriptionid = ? ");
2416     $sth->execute($subscriptionid);
2417     my $val = $sth->fetchrow_hashref;
2418
2419     # calculate issue number
2420     my $serialseq = GetSeq($val);
2421     $sth =
2422       $dbh->prepare(
2423 "insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)"
2424       );
2425     $sth->execute( $serialseq, $subscriptionid, $val->{'biblionumber'},
2426         1, format_date_in_iso($startdate) );
2427     return $subscriptionid;
2428 }
2429
2430 =head2 old_modsubscription
2431
2432 =over 4
2433
2434 ($subscriptionid) = &old_modsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2435                         $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2436                         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2437                         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2438                         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2439                         $numberingmethod, $status, $callnumber, $notes, $hemisphere, $subscriptionid)
2440
2441 this function is similar to the ModSubscription subroutine but has a few different
2442 values passed in
2443 $firstacquidate - date of first serial issue to arrive
2444 $irregularity - the issues not expected separated by a '|'
2445 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2446 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2447    subscription-add.tmpl file
2448 $callnumber - display the callnumber of the serial
2449 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2450
2451 =back
2452
2453 =cut
2454
2455 sub old_modsubscription {
2456     my (
2457         $auser,        $aqbooksellerid, $cost,           $aqbudgetid,
2458         $startdate,    $periodicity,    $firstacquidate, $dow,
2459         $irregularity, $numberpattern,  $numberlength,   $weeklength,
2460         $monthlength,  $add1,           $every1,         $whenmorethan1,
2461         $setto1,       $lastvalue1,     $innerloop1,     $add2,
2462         $every2,       $whenmorethan2,  $setto2,         $lastvalue2,
2463         $innerloop2,   $add3,           $every3,         $whenmorethan3,
2464         $setto3,       $lastvalue3,     $innerloop3,     $numberingmethod,
2465         $status,       $biblionumber,   $callnumber,     $notes,
2466         $hemisphere,   $subscriptionid
2467     ) = @_;
2468     my $dbh = C4::Context->dbh;
2469     my $sth = $dbh->prepare(
2470 "update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
2471                                                    periodicity=?,firstacquidate=?,dow=?,irregularity=?,numberpattern=?,numberlength=?,weeklength=?,monthlength=?,
2472                                                   add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
2473                                                   add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
2474                                                   add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
2475                                                   numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, hemisphere=? where subscriptionid = ?"
2476     );
2477     $sth->execute(
2478         $auser,        $aqbooksellerid, $cost,           $aqbudgetid,
2479         $startdate,    $periodicity,    $firstacquidate, $dow,
2480         $irregularity, $numberpattern,  $numberlength,   $weeklength,
2481         $monthlength,  $add1,           $every1,         $whenmorethan1,
2482         $setto1,       $lastvalue1,     $innerloop1,     $add2,
2483         $every2,       $whenmorethan2,  $setto2,         $lastvalue2,
2484         $innerloop2,   $add3,           $every3,         $whenmorethan3,
2485         $setto3,       $lastvalue3,     $innerloop3,     $numberingmethod,
2486         $status,       $biblionumber,   $callnumber,     $notes,
2487         $hemisphere,   $subscriptionid
2488     );
2489     $sth->finish;
2490
2491     $sth =
2492       $dbh->prepare("select * from subscription where subscriptionid = ? ");
2493     $sth->execute($subscriptionid);
2494     my $val = $sth->fetchrow_hashref;
2495
2496     # calculate issue number
2497     my $serialseq = Get_Seq($val);
2498     $sth =
2499       $dbh->prepare("UPDATE serial SET serialseq = ? WHERE subscriptionid = ?");
2500     $sth->execute( $serialseq, $subscriptionid );
2501
2502     my $enddate = subscriptionexpirationdate($subscriptionid);
2503     $sth = $dbh->prepare("update subscriptionhistory set enddate=?");
2504     $sth->execute( format_date_in_iso($enddate) );
2505 }
2506
2507 =head2 old_getserials
2508
2509 =over 4
2510
2511 ($totalissues,@serials) = &old_getserials($subscriptionid)
2512
2513 this function get a hashref of serials and the total count of them
2514
2515 return :
2516 $totalissues - number of serial lines
2517 the serials into a table. Each line of this table containts a ref to a hash which it containts
2518 serialid, serialseq, status,planneddate,notes,routingnotes  from tables : serial where status is not 2, 4, or 5
2519
2520 =back
2521
2522 =cut
2523
2524 sub old_getserials {
2525     my ($subscriptionid) = @_;
2526     my $dbh = C4::Context->dbh;
2527
2528     # status = 2 is "arrived"
2529     my $sth =
2530       $dbh->prepare(
2531 "select serialid,serialseq, status, planneddate,notes,routingnotes from serial where subscriptionid = ? and status <>2 and status <>4 and status <>5"
2532       );
2533     $sth->execute($subscriptionid);
2534     my @serials;
2535     my $num = 1;
2536     while ( my $line = $sth->fetchrow_hashref ) {
2537         $line->{ "status" . $line->{status} } =
2538           1;    # fills a "statusX" value, used for template status select list
2539         $line->{"planneddate"} = format_date( $line->{"planneddate"} );
2540         $line->{"num"}         = $num;
2541         $num++;
2542         push @serials, $line;
2543     }
2544     $sth = $dbh->prepare("select count(*) from serial where subscriptionid=?");
2545     $sth->execute($subscriptionid);
2546     my ($totalissues) = $sth->fetchrow;
2547     return ( $totalissues, @serials );
2548 }
2549
2550 =head2 GetNextDate
2551
2552 ($resultdate) = &GetNextDate($planneddate,$subscription)
2553
2554 this function is an extension of GetNextDate which allows for checking for irregularity
2555
2556 it takes the planneddate and will return the next issue's date and will skip dates if there
2557 exists an irregularity
2558 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2559 skipped then the returned date will be 2007-05-10
2560
2561 return :
2562 $resultdate - then next date in the sequence
2563
2564 Return 0 if periodicity==0
2565
2566 =cut
2567 sub in_array { # used in next sub down
2568   my ($val,@elements) = @_;
2569   foreach my $elem(@elements) {
2570     if($val == $elem) {
2571             return 1;
2572     }
2573   }
2574   return 0;
2575 }
2576
2577 sub GetNextDate(@) {
2578     my ( $planneddate, $subscription ) = @_;
2579     my @irreg = split( /\,/, $subscription->{irregularity} );
2580
2581     #date supposed to be in ISO.
2582
2583     my ( $year, $month, $day ) = split(/-/, $planneddate);
2584     $month=1 unless ($month);
2585     $day=1 unless ($day);
2586     my @resultdate;
2587
2588     #       warn "DOW $dayofweek";
2589     if ( $subscription->{periodicity} % 16 == 0 ) {
2590       return 0;
2591     }
2592     if ( $subscription->{periodicity} == 1 ) {
2593         my $dayofweek = eval{Day_of_Week( $year,$month, $day )};
2594         if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2595         else {
2596           for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2597               $dayofweek = 0 if ( $dayofweek == 7 );
2598               if ( in_array( ($dayofweek + 1), @irreg ) ) {
2599                   ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 1 );
2600                   $dayofweek++;
2601               }
2602           }
2603           @resultdate = Add_Delta_Days($year,$month, $day , 1 );
2604         }
2605     }
2606     if ( $subscription->{periodicity} == 2 ) {
2607         my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2608         if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2609         else {
2610           for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2611               if ( $irreg[$i] == (($wkno!=51)?($wkno +1) % 52 :52)) {
2612                   ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 7 );
2613                   $wkno=(($wkno!=51)?($wkno +1) % 52 :52);
2614               }
2615           }
2616           @resultdate = Add_Delta_Days( $year,$month, $day, 7);
2617         }
2618     }
2619     if ( $subscription->{periodicity} == 3 ) {
2620         my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2621         if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2622         else {
2623           for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2624               if ( $irreg[$i] == (($wkno!=50)?($wkno +2) % 52 :52)) {
2625               ### BUGFIX was previously +1 ^
2626                   ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 14 );
2627                   $wkno=(($wkno!=50)?($wkno +2) % 52 :52);
2628               }
2629           }
2630           @resultdate = Add_Delta_Days($year,$month, $day , 14 );
2631         }
2632     }
2633     if ( $subscription->{periodicity} == 4 ) {
2634         my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2635         if ($@){warn "année mois jour : $year $month $day $subscription->{subscriptionid} : $@";}
2636         else {
2637           for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2638               if ( $irreg[$i] == (($wkno!=49)?($wkno +3) % 52 :52)) {
2639                   ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 21 );
2640                   $wkno=(($wkno!=49)?($wkno +3) % 52 :52);
2641               }
2642           }
2643           @resultdate = Add_Delta_Days($year,$month, $day , 21 );
2644         }
2645     }
2646     my $tmpmonth=$month;
2647     if ($year && $month && $day){
2648     if ( $subscription->{periodicity} == 5 ) {
2649           for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2650               if ( $irreg[$i] == (($tmpmonth!=11)?($tmpmonth +1) % 12 :12)) {
2651                   ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2652                   $tmpmonth=(($tmpmonth!=11)?($tmpmonth +1) % 12 :12);
2653               }
2654           }
2655           @resultdate = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2656     }
2657     if ( $subscription->{periodicity} == 6 ) {
2658           for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2659               if ( $irreg[$i] == (($tmpmonth!=10)?($tmpmonth +2) % 12 :12)) {
2660                   ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,2,0 );
2661                   $tmpmonth=(($tmpmonth!=10)?($tmpmonth + 2) % 12 :12);
2662               }
2663           }
2664           @resultdate = Add_Delta_YMD($year,$month, $day, 0, 2,0 );
2665     }
2666     if ( $subscription->{periodicity} == 7 ) {
2667         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2668             if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2669                 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2670                 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2671             }
2672         }
2673         @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2674     }
2675     if ( $subscription->{periodicity} == 8 ) {
2676         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2677             if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2678                 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2679                 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2680             }
2681         }
2682         @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2683     }
2684     if ( $subscription->{periodicity} == 9 ) {
2685         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2686             if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2687             ### BUFIX Seems to need more Than One ?
2688                 ($year,$month,$day) = Add_Delta_YM($year,$month, $day, 0, 6 );
2689                 $tmpmonth=(($tmpmonth!=6)?($tmpmonth + 6) % 12 :12);
2690             }
2691         }
2692         @resultdate = Add_Delta_YM($year,$month, $day, 0, 6);
2693     }
2694     if ( $subscription->{periodicity} == 10 ) {
2695         @resultdate = Add_Delta_YM($year,$month, $day, 1, 0 );
2696     }
2697     if ( $subscription->{periodicity} == 11 ) {
2698         @resultdate = Add_Delta_YM($year,$month, $day, 2, 0 );
2699     }
2700     }
2701     my $resultdate=sprintf("%04d-%02d-%02d",$resultdate[0],$resultdate[1],$resultdate[2]);
2702
2703 #     warn "dateNEXTSEQ : ".$resultdate;
2704     return "$resultdate";
2705 }
2706
2707 =head2 itemdata
2708
2709   $item = &itemdata($barcode);
2710
2711 Looks up the item with the given barcode, and returns a
2712 reference-to-hash containing information about that item. The keys of
2713 the hash are the fields from the C<items> and C<biblioitems> tables in
2714 the Koha database.
2715
2716 =cut
2717
2718 #'
2719 sub itemdata {
2720     my ($barcode) = @_;
2721     my $dbh       = C4::Context->dbh;
2722     my $sth       = $dbh->prepare(
2723         "Select * from items LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
2724         WHERE barcode=?"
2725     );
2726     $sth->execute($barcode);
2727     my $data = $sth->fetchrow_hashref;
2728     $sth->finish;
2729     return ($data);
2730 }
2731
2732 1;
2733 __END__
2734
2735 =back
2736
2737 =head1 AUTHOR
2738
2739 Koha Developement team <info@koha.org>
2740
2741 =cut