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