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   $newlastvalue1 = $val->{lastvalue1};
 945   # check if we have to increase the new value.
 946   $newinnerloop1 = $val->{innerloop1} + 1;
 947   $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
 948   $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
 949   $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
 950   $calculated =~ s/\{X\}/$newlastvalue1/g;
 951
 952   $newlastvalue2 = $val->{lastvalue2};
 953   # check if we have to increase the new value.
 954   $newinnerloop2 = $val->{innerloop2} + 1;
 955   $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
 956   $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
 957   $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
 958   if ( $pattern == 6 ) {
 959     if ( $val->{hemisphere} == 2 ) {
 960        my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
 961        $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
 962     }
 963     else {
 964        my $newlastvalue2seq = $seasons[$newlastvalue2];
 965        $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
 966     }
 967   }
 968   else {
 969     $calculated =~ s/\{Y\}/$newlastvalue2/g;
 970   }
 971
 972
 973   $newlastvalue3 = $val->{lastvalue3};
 974   # check if we have to increase the new value.
 975   $newinnerloop3 = $val->{innerloop3} + 1;
 976   $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
 977   $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
 978   $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
 979   $calculated =~ s/\{Z\}/$newlastvalue3/g;
 980
 981   return ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3 ,
 982            $newinnerloop1, $newinnerloop2, $newinnerloop3);
 983 }
 984
 985 =head2 GetSeq
 986
 987 =over 4
 988
 989 $calculated = GetSeq($val)
 990 $val is a hashref containing all the attributes of the table 'subscription'
 991 this function transforms {X},{Y},{Z} to 150,0,0 for example.
 992 return:
 993 the sequence in integer format
 994
 995 =back
 996
 997 =cut
 998
 999 sub GetSeq {
1000     my ($val)      = @_;
1001     my $pattern = $val->{numberpattern};
1002     my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
1003     my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
1004     my $calculated = $val->{numberingmethod};
1005     my $x          = $val->{'lastvalue1'};
1006     $calculated =~ s/\{X\}/$x/g;
1007     my $newlastvalue2 = $val->{'lastvalue2'};
1008     if ( $pattern == 6 ) {
1009         if ( $val->{hemisphere} == 2 ) {
1010             my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
1011             $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
1012         }
1013         else {
1014             my $newlastvalue2seq = $seasons[$newlastvalue2];
1015             $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
1016         }
1017     }
1018     else {
1019         $calculated =~ s/\{Y\}/$newlastvalue2/g;
1020     }
1021     my $z = $val->{'lastvalue3'};
1022     $calculated =~ s/\{Z\}/$z/g;
1023     return $calculated;
1024 }
1025
1026 =head2 GetExpirationDate
1027
1028 $sensddate = GetExpirationDate($subscriptionid)
1029
1030 this function return the expiration date for a subscription given on input args.
1031
1032 return
1033 the enddate
1034
1035 =cut
1036
1037 sub GetExpirationDate {
1038     my ($subscriptionid) = @_;
1039     my $dbh              = C4::Context->dbh;
1040     my $subscription     = GetSubscription($subscriptionid);
1041     my $enddate          = $subscription->{startdate};
1042
1043 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1044     if (($subscription->{periodicity} % 16) >0){
1045       if ( $subscription->{numberlength} ) {
1046           #calculate the date of the last issue.
1047           my $length = $subscription->{numberlength};
1048           for ( my $i = 1 ; $i <= $length ; $i++ ) {
1049               $enddate = GetNextDate( $enddate, $subscription );
1050           }
1051       }
1052       elsif ( $subscription->{monthlength} ){
1053           my @date=split (/-/,$subscription->{startdate});
1054           my @enddate = Add_Delta_YM($date[0],$date[1],$date[2],0,$subscription->{monthlength});
1055           $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1056       } elsif ( $subscription->{weeklength} ){
1057           my @date=split (/-/,$subscription->{startdate});
1058           my @enddate = Add_Delta_Days($date[0],$date[1],$date[2],$subscription->{weeklength}*7);
1059           $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1060       }
1061       return $enddate;
1062     } else {
1063       return 0;
1064     }
1065 }
1066
1067 =head2 CountSubscriptionFromBiblionumber
1068
1069 =over 4
1070
1071 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1072 this count the number of subscription for a biblionumber given.
1073 return :
1074 the number of subscriptions with biblionumber given on input arg.
1075
1076 =back
1077
1078 =cut
1079
1080 sub CountSubscriptionFromBiblionumber {
1081     my ($biblionumber) = @_;
1082     my $dbh = C4::Context->dbh;
1083     my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1084     my $sth   = $dbh->prepare($query);
1085     $sth->execute($biblionumber);
1086     my $subscriptionsnumber = $sth->fetchrow;
1087     return $subscriptionsnumber;
1088 }
1089
1090 =head2 ModSubscriptionHistory
1091
1092 =over 4
1093
1094 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1095
1096 this function modify the history of a subscription. Put your new values on input arg.
1097
1098 =back
1099
1100 =cut
1101
1102 sub ModSubscriptionHistory {
1103     my (
1104         $subscriptionid, $histstartdate, $enddate, $recievedlist,
1105         $missinglist,    $opacnote,      $librariannote
1106     ) = @_;
1107     my $dbh   = C4::Context->dbh;
1108     my $query = "UPDATE subscriptionhistory
1109                     SET histstartdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1110                     WHERE subscriptionid=?
1111                 ";
1112     my $sth = $dbh->prepare($query);
1113     $recievedlist =~ s/^,//g;
1114     $missinglist  =~ s/^,//g;
1115     $opacnote     =~ s/^,//g;
1116     $sth->execute(
1117         $histstartdate, $enddate,       $recievedlist, $missinglist,
1118         $opacnote,      $librariannote, $subscriptionid
1119     );
1120     return $sth->rows;
1121 }
1122
1123 =head2 ModSerialStatus
1124
1125 =over 4
1126
1127 ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes)
1128
1129 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1130 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1131
1132 =back
1133
1134 =cut
1135
1136 sub ModSerialStatus {
1137     my ( $serialid, $serialseq,  $planneddate,$publisheddate, $status, $notes )
1138       = @_;
1139
1140     #It is a usual serial
1141     # 1st, get previous status :
1142     my $dbh   = C4::Context->dbh;
1143     my $query = "SELECT subscriptionid,status FROM serial WHERE  serialid=?";
1144     my $sth   = $dbh->prepare($query);
1145     $sth->execute($serialid);
1146     my ( $subscriptionid, $oldstatus ) = $sth->fetchrow;
1147
1148     # change status & update subscriptionhistory
1149     my $val;
1150     if ( $status eq 6 ) {
1151         DelIssue( {'serialid'=>$serialid, 'subscriptionid'=>$subscriptionid,'serialseq'=>$serialseq} );
1152     }
1153     else {
1154         my $query =
1155 "UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE  serialid = ?";
1156         $sth = $dbh->prepare($query);
1157         $sth->execute( $serialseq, $publisheddate, $planneddate, $status,
1158             $notes, $serialid );
1159         $query = "SELECT * FROM   subscription WHERE  subscriptionid = ?";
1160         $sth = $dbh->prepare($query);
1161         $sth->execute($subscriptionid);
1162         my $val = $sth->fetchrow_hashref;
1163         unless ( $val->{manualhistory} ) {
1164             $query =
1165 "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE  subscriptionid=?";
1166             $sth = $dbh->prepare($query);
1167             $sth->execute($subscriptionid);
1168             my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1169             if ( $status eq 2 ) {
1170
1171 #             warn "receivedlist : $recievedlist serialseq :$serialseq, ".index("$recievedlist","$serialseq");
1172                 $recievedlist .= ",$serialseq"
1173                   unless ( index( "$recievedlist", "$serialseq" ) >= 0 );
1174             }
1175
1176 #         warn "missinglist : $missinglist serialseq :$serialseq, ".index("$missinglist","$serialseq");
1177             $missinglist .= ",$serialseq"
1178               if ( $status eq 4
1179                 and not index( "$missinglist", "$serialseq" ) >= 0 );
1180             $missinglist .= ",not issued $serialseq"
1181               if ( $status eq 5
1182                 and index( "$missinglist", "$serialseq" ) >= 0 );
1183             $query =
1184 "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE  subscriptionid=?";
1185             $sth = $dbh->prepare($query);
1186             $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1187         }
1188     }
1189
1190     # create new waited entry if needed (ie : was a "waited" and has changed)
1191     if ( $oldstatus eq 1 && $status ne 1 ) {
1192         my $query = "SELECT * FROM   subscription WHERE  subscriptionid = ?";
1193         $sth = $dbh->prepare($query);
1194         $sth->execute($subscriptionid);
1195         my $val = $sth->fetchrow_hashref;
1196
1197         # next issue number
1198 #     warn "Next Seq";
1199         my (
1200             $newserialseq,  $newlastvalue1, $newlastvalue2, $newlastvalue3,
1201             $newinnerloop1, $newinnerloop2, $newinnerloop3
1202         ) = GetNextSeq($val);
1203 #     warn "Next Seq End";
1204
1205         # next date (calculated from actual date & frequency parameters)
1206 #         warn "publisheddate :$publisheddate ";
1207         my $nextpublisheddate = GetNextDate( $publisheddate, $val );
1208         NewIssue( $newserialseq, $subscriptionid, $val->{'biblionumber'},
1209             1, $nextpublisheddate, $nextpublisheddate );
1210         $query =
1211 "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1212                     WHERE  subscriptionid = ?";
1213         $sth = $dbh->prepare($query);
1214         $sth->execute(
1215             $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1,
1216             $newinnerloop2, $newinnerloop3, $subscriptionid
1217         );
1218
1219 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1220         if ( $val->{letter} && $status eq 2 && $oldstatus ne 2 ) {
1221             SendAlerts( 'issue', $val->{subscriptionid}, $val->{letter} );
1222         }
1223     }
1224 }
1225
1226 =head2 ModSubscription
1227
1228 =over 4
1229
1230 this function modify a subscription. Put all new values on input args.
1231
1232 =back
1233
1234 =cut
1235
1236 sub ModSubscription {
1237     my (
1238         $auser,           $branchcode,   $aqbooksellerid, $cost,
1239         $aqbudgetid,      $startdate,    $periodicity,    $firstacquidate,
1240         $dow,             $irregularity, $numberpattern,  $numberlength,
1241         $weeklength,      $monthlength,  $add1,           $every1,
1242         $whenmorethan1,   $setto1,       $lastvalue1,     $innerloop1,
1243         $add2,            $every2,       $whenmorethan2,  $setto2,
1244         $lastvalue2,      $innerloop2,   $add3,           $every3,
1245         $whenmorethan3,   $setto3,       $lastvalue3,     $innerloop3,
1246         $numberingmethod, $status,       $biblionumber,   $callnumber,
1247         $notes,           $letter,       $hemisphere,     $manualhistory,
1248         $internalnotes,
1249         $subscriptionid
1250     ) = @_;
1251 #     warn $irregularity;
1252     my $dbh   = C4::Context->dbh;
1253     my $query = "UPDATE subscription
1254                     SET librarian=?, branchcode=?,aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
1255                         periodicity=?,firstacquidate=?,dow=?,irregularity=?, numberpattern=?, numberlength=?,weeklength=?,monthlength=?,
1256                         add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
1257                         add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
1258                         add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
1259                         numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, letter=?, hemisphere=?,manualhistory=?,internalnotes=?
1260                     WHERE subscriptionid = ?";
1261 #     warn "query :".$query;
1262     my $sth = $dbh->prepare($query);
1263     $sth->execute(
1264         $auser,           $branchcode,   $aqbooksellerid, $cost,
1265         $aqbudgetid,      $startdate,    $periodicity,    $firstacquidate,
1266         $dow,             "$irregularity", $numberpattern,  $numberlength,
1267         $weeklength,      $monthlength,  $add1,           $every1,
1268         $whenmorethan1,   $setto1,       $lastvalue1,     $innerloop1,
1269         $add2,            $every2,       $whenmorethan2,  $setto2,
1270         $lastvalue2,      $innerloop2,   $add3,           $every3,
1271         $whenmorethan3,   $setto3,       $lastvalue3,     $innerloop3,
1272         $numberingmethod, $status,       $biblionumber,   $callnumber,
1273         $notes,           $letter,       $hemisphere,     ($manualhistory?$manualhistory:0),
1274         $internalnotes,
1275         $subscriptionid
1276     );
1277     my $rows=$sth->rows;
1278     $sth->finish;
1279
1280     &logaction(C4::Context->userenv->{'number'},"SERIAL","MODIFY",$subscriptionid,"")
1281         if C4::Context->preference("SubscriptionLog");
1282     return $rows;
1283 }
1284
1285 =head2 NewSubscription
1286
1287 =over 4
1288
1289 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1290     $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1291     $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1292     $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1293     $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1294     $numberingmethod, $status, $notes)
1295
1296 Create a new subscription with value given on input args.
1297
1298 return :
1299 the id of this new subscription
1300
1301 =back
1302
1303 =cut
1304
1305 sub NewSubscription {
1306     my (
1307         $auser,         $branchcode,   $aqbooksellerid,  $cost,
1308         $aqbudgetid,    $biblionumber, $startdate,       $periodicity,
1309         $dow,           $numberlength, $weeklength,      $monthlength,
1310         $add1,          $every1,       $whenmorethan1,   $setto1,
1311         $lastvalue1,    $innerloop1,   $add2,            $every2,
1312         $whenmorethan2, $setto2,       $lastvalue2,      $innerloop2,
1313         $add3,          $every3,       $whenmorethan3,   $setto3,
1314         $lastvalue3,    $innerloop3,   $numberingmethod, $status,
1315         $notes,         $letter,       $firstacquidate,  $irregularity,
1316         $numberpattern, $callnumber,   $hemisphere,      $manualhistory,
1317         $internalnotes
1318     ) = @_;
1319     my $dbh = C4::Context->dbh;
1320
1321     #save subscription (insert into database)
1322     my $query = qq|
1323         INSERT INTO subscription
1324             (librarian,branchcode,aqbooksellerid,cost,aqbudgetid,biblionumber,
1325             startdate,periodicity,dow,numberlength,weeklength,monthlength,
1326             add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
1327             add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
1328             add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
1329             numberingmethod, status, notes, letter,firstacquidate,irregularity,
1330             numberpattern, callnumber, hemisphere,manualhistory,internalnotes)
1331         VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1332         |;
1333     my $sth = $dbh->prepare($query);
1334     $sth->execute(
1335         $auser,                         $branchcode,
1336         $aqbooksellerid,                $cost,
1337         $aqbudgetid,                    $biblionumber,
1338         format_date_in_iso($startdate), $periodicity,
1339         $dow,                           $numberlength,
1340         $weeklength,                    $monthlength,
1341         $add1,                          $every1,
1342         $whenmorethan1,                 $setto1,
1343         $lastvalue1,                    $innerloop1,
1344         $add2,                          $every2,
1345         $whenmorethan2,                 $setto2,
1346         $lastvalue2,                    $innerloop2,
1347         $add3,                          $every3,
1348         $whenmorethan3,                 $setto3,
1349         $lastvalue3,                    $innerloop3,
1350         $numberingmethod,               "$status",
1351         $notes,                         $letter,
1352         format_date_in_iso($firstacquidate),                $irregularity,
1353         $numberpattern,                 $callnumber,
1354         $hemisphere,                    $manualhistory,
1355         $internalnotes
1356     );
1357
1358     #then create the 1st waited number
1359     my $subscriptionid = $dbh->{'mysql_insertid'};
1360     $query             = qq(
1361         INSERT INTO subscriptionhistory
1362             (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote)
1363         VALUES (?,?,?,?,?,?,?,?)
1364         );
1365     $sth = $dbh->prepare($query);
1366     $sth->execute( $biblionumber, $subscriptionid,
1367         format_date_in_iso($startdate),
1368         0, "", "", "", "$notes" );
1369
1370    # reread subscription to get a hash (for calculation of the 1st issue number)
1371     $query = qq(
1372         SELECT *
1373         FROM   subscription
1374         WHERE  subscriptionid = ?
1375     );
1376     $sth = $dbh->prepare($query);
1377     $sth->execute($subscriptionid);
1378     my $val = $sth->fetchrow_hashref;
1379
1380     # calculate issue number
1381     my $serialseq = GetSeq($val);
1382     $query     = qq|
1383         INSERT INTO serial
1384             (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1385         VALUES (?,?,?,?,?,?)
1386     |;
1387     $sth = $dbh->prepare($query);
1388     $sth->execute(
1389         "$serialseq", $subscriptionid, $biblionumber, 1,
1390         format_date_in_iso($startdate),
1391         format_date_in_iso($startdate)
1392     );
1393
1394     &logaction(C4::Context->userenv->{'number'},"SERIAL","ADD",$subscriptionid,"")
1395         if C4::Context->preference("SubscriptionLog");
1396
1397     return $subscriptionid;
1398 }
1399
1400 =head2 ReNewSubscription
1401
1402 =over 4
1403
1404 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1405
1406 this function renew a subscription with values given on input args.
1407
1408 =back
1409
1410 =cut
1411
1412 sub ReNewSubscription {
1413     my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength,
1414         $monthlength, $note )
1415       = @_;
1416     my $dbh          = C4::Context->dbh;
1417     my $subscription = GetSubscription($subscriptionid);
1418      my $query        = qq|
1419          SELECT *
1420          FROM   biblio
1421          LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1422          WHERE    biblio.biblionumber=?
1423      |;
1424      my $sth = $dbh->prepare($query);
1425      $sth->execute( $subscription->{biblionumber} );
1426      my $biblio = $sth->fetchrow_hashref;
1427      NewSuggestion(
1428          $user,             $subscription->{bibliotitle},
1429          $biblio->{author}, $biblio->{publishercode},
1430          $biblio->{note},   '',
1431          '',                '',
1432          '',                '',
1433          $subscription->{biblionumber}
1434      );
1435
1436     # renew subscription
1437     my $query = qq|
1438         UPDATE subscription
1439         SET    startdate=?,numberlength=?,weeklength=?,monthlength=?
1440         WHERE  subscriptionid=?
1441     |;
1442     my $sth = $dbh->prepare($query);
1443     $sth->execute( format_date_in_iso($startdate),
1444         $numberlength, $weeklength, $monthlength, $subscriptionid );
1445
1446     &logaction(C4::Context->userenv->{'number'},"SERIAL","RENEW",$subscriptionid,"")
1447         if C4::Context->preference("SubscriptionLog");
1448 }
1449
1450 =head2 NewIssue
1451
1452 =over 4
1453
1454 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate,  $notes)
1455
1456 Create a new issue stored on the database.
1457 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1458
1459 =back
1460
1461 =cut
1462
1463 sub NewIssue {
1464     my ( $serialseq, $subscriptionid, $biblionumber, $status,
1465         $planneddate, $publisheddate, $notes )
1466       = @_;
1467     ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1468
1469     my $dbh   = C4::Context->dbh;
1470     my $query = qq|
1471         INSERT INTO serial
1472             (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1473         VALUES (?,?,?,?,?,?,?)
1474     |;
1475     my $sth = $dbh->prepare($query);
1476     $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status,
1477         $publisheddate, $planneddate,$notes );
1478     my $serialid=$dbh->{'mysql_insertid'};
1479     $query = qq|
1480         SELECT missinglist,recievedlist
1481         FROM   subscriptionhistory
1482         WHERE  subscriptionid=?
1483     |;
1484     $sth = $dbh->prepare($query);
1485     $sth->execute($subscriptionid);
1486     my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1487
1488     if ( $status eq 2 ) {
1489       ### TODO Add a feature that improves recognition and description.
1490       ### As such count (serialseq) i.e. : N18,2(N19),N20
1491       ### Would use substr and index But be careful to previous presence of ()
1492         $recievedlist .= ",$serialseq" unless (index($recievedlist,$serialseq)>0);
1493     }
1494     if ( $status eq 4 ) {
1495         $missinglist .= ",$serialseq" unless (index($missinglist,$serialseq)>0);
1496     }
1497     $query = qq|
1498         UPDATE subscriptionhistory
1499         SET    recievedlist=?, missinglist=?
1500         WHERE  subscriptionid=?
1501     |;
1502     $sth = $dbh->prepare($query);
1503     $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1504     return $serialid;
1505 }
1506
1507 =head2 ItemizeSerials
1508
1509 =over 4
1510
1511 ItemizeSerials($serialid, $info);
1512 $info is a hashref containing  barcode branch, itemcallnumber, status, location
1513 $serialid the serialid
1514 return :
1515 1 if the itemize is a succes.
1516 0 and @error else. @error containts the list of errors found.
1517
1518 =back
1519
1520 =cut
1521
1522 sub ItemizeSerials {
1523     my ( $serialid, $info ) = @_;
1524     my $now = POSIX::strftime( "%Y-%m-%d",localtime );
1525
1526     my $dbh   = C4::Context->dbh;
1527     my $query = qq|
1528         SELECT *
1529         FROM   serial
1530         WHERE  serialid=?
1531     |;
1532     my $sth = $dbh->prepare($query);
1533     $sth->execute($serialid);
1534     my $data = $sth->fetchrow_hashref;
1535     if ( C4::Context->preference("RoutingSerials") ) {
1536
1537         # check for existing biblioitem relating to serial issue
1538         my ( $count, @results ) =
1539           GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1540         my $bibitemno = 0;
1541         for ( my $i = 0 ; $i < $count ; $i++ ) {
1542             if (  $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' ('
1543                 . $data->{'planneddate'}
1544                 . ')' )
1545             {
1546                 $bibitemno = $results[$i]->{'biblioitemnumber'};
1547                 last;
1548             }
1549         }
1550         if ( $bibitemno == 0 ) {
1551
1552     # warn "need to add new biblioitem so copy last one and make minor changes";
1553             my $sth =
1554               $dbh->prepare(
1555 "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC"
1556               );
1557             $sth->execute( $data->{'biblionumber'} );
1558             my $biblioitem = $sth->fetchrow_hashref;
1559             $biblioitem->{'volumedate'} =
1560               format_date_in_iso( $data->{planneddate} );
1561             $biblioitem->{'volumeddesc'} =
1562               $data->{serialseq} . ' ('
1563               . format_date( $data->{'planneddate'} ) . ')';
1564             $biblioitem->{'dewey'} = $info->{itemcallnumber};
1565
1566             #FIXME  HDL : I don't understand why you need to call newbiblioitem, as the biblioitem should already be somewhere.
1567             # so I comment it, we can speak of it when you want
1568             # newbiblioitems has been removed from Biblio.pm, as it has a deprecated API now
1569 #             if ( $info->{barcode} )
1570 #             {    # only make biblioitem if we are going to make item also
1571 #                 $bibitemno = newbiblioitem($biblioitem);
1572 #             }
1573         }
1574     }
1575
1576     my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1577     if ( $info->{barcode} ) {
1578         my @errors;
1579         my $exists = itemdata( $info->{'barcode'} );
1580         push @errors, "barcode_not_unique" if ($exists);
1581         unless ($exists) {
1582             my $marcrecord = MARC::Record->new();
1583             my ( $tag, $subfield ) =
1584               GetMarcFromKohaField( "items.barcode", $fwk );
1585             my $newField =
1586               MARC::Field->new( "$tag", '', '',
1587                 "$subfield" => $info->{barcode} );
1588             $marcrecord->insert_fields_ordered($newField);
1589             if ( $info->{branch} ) {
1590                 my ( $tag, $subfield ) =
1591                   GetMarcFromKohaField( "items.homebranch",
1592                     $fwk );
1593
1594                 #warn "items.homebranch : $tag , $subfield";
1595                 if ( $marcrecord->field($tag) ) {
1596                     $marcrecord->field($tag)
1597                       ->add_subfields( "$subfield" => $info->{branch} );
1598                 }
1599                 else {
1600                     my $newField =
1601                       MARC::Field->new( "$tag", '', '',
1602                         "$subfield" => $info->{branch} );
1603                     $marcrecord->insert_fields_ordered($newField);
1604                 }
1605                 ( $tag, $subfield ) =
1606                   GetMarcFromKohaField( "items.holdingbranch",
1607                     $fwk );
1608
1609                 #warn "items.holdingbranch : $tag , $subfield";
1610                 if ( $marcrecord->field($tag) ) {
1611                     $marcrecord->field($tag)
1612                       ->add_subfields( "$subfield" => $info->{branch} );
1613                 }
1614                 else {
1615                     my $newField =
1616                       MARC::Field->new( "$tag", '', '',
1617                         "$subfield" => $info->{branch} );
1618                     $marcrecord->insert_fields_ordered($newField);
1619                 }
1620             }
1621             if ( $info->{itemcallnumber} ) {
1622                 my ( $tag, $subfield ) =
1623                   GetMarcFromKohaField( "items.itemcallnumber",
1624                     $fwk );
1625
1626                 #warn "items.itemcallnumber : $tag , $subfield";
1627                 if ( $marcrecord->field($tag) ) {
1628                     $marcrecord->field($tag)
1629                       ->add_subfields( "$subfield" => $info->{itemcallnumber} );
1630                 }
1631                 else {
1632                     my $newField =
1633                       MARC::Field->new( "$tag", '', '',
1634                         "$subfield" => $info->{itemcallnumber} );
1635                     $marcrecord->insert_fields_ordered($newField);
1636                 }
1637             }
1638             if ( $info->{notes} ) {
1639                 my ( $tag, $subfield ) =
1640                   GetMarcFromKohaField( "items.itemnotes", $fwk );
1641
1642                 # warn "items.itemnotes : $tag , $subfield";
1643                 if ( $marcrecord->field($tag) ) {
1644                     $marcrecord->field($tag)
1645                       ->add_subfields( "$subfield" => $info->{notes} );
1646                 }
1647                 else {
1648                     my $newField =
1649                       MARC::Field->new( "$tag", '', '',
1650                         "$subfield" => $info->{notes} );
1651                     $marcrecord->insert_fields_ordered($newField);
1652                 }
1653             }
1654             if ( $info->{location} ) {
1655                 my ( $tag, $subfield ) =
1656                   GetMarcFromKohaField( "items.location", $fwk );
1657
1658                 # warn "items.location : $tag , $subfield";
1659                 if ( $marcrecord->field($tag) ) {
1660                     $marcrecord->field($tag)
1661                       ->add_subfields( "$subfield" => $info->{location} );
1662                 }
1663                 else {
1664                     my $newField =
1665                       MARC::Field->new( "$tag", '', '',
1666                         "$subfield" => $info->{location} );
1667                     $marcrecord->insert_fields_ordered($newField);
1668                 }
1669             }
1670             if ( $info->{status} ) {
1671                 my ( $tag, $subfield ) =
1672                   GetMarcFromKohaField( "items.notforloan",
1673                     $fwk );
1674
1675                 # warn "items.notforloan : $tag , $subfield";
1676                 if ( $marcrecord->field($tag) ) {
1677                     $marcrecord->field($tag)
1678                       ->add_subfields( "$subfield" => $info->{status} );
1679                 }
1680                 else {
1681                     my $newField =
1682                       MARC::Field->new( "$tag", '', '',
1683                         "$subfield" => $info->{status} );
1684                     $marcrecord->insert_fields_ordered($newField);
1685                 }
1686             }
1687             if ( C4::Context->preference("RoutingSerials") ) {
1688                 my ( $tag, $subfield ) =
1689                   GetMarcFromKohaField( "items.dateaccessioned",
1690                     $fwk );
1691                 if ( $marcrecord->field($tag) ) {
1692                     $marcrecord->field($tag)
1693                       ->add_subfields( "$subfield" => $now );
1694                 }
1695                 else {
1696                     my $newField =
1697                       MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1698                     $marcrecord->insert_fields_ordered($newField);
1699                 }
1700             }
1701             AddItem( $marcrecord, $data->{'biblionumber'} );
1702             return 1;
1703         }
1704         return ( 0, @errors );
1705     }
1706 }
1707
1708 =head2 HasSubscriptionExpired
1709
1710 =over 4
1711
1712 1 or 0 = HasSubscriptionExpired($subscriptionid)
1713
1714 the subscription has expired when the next issue to arrive is out of subscription limit.
1715
1716 return :
1717 1 if true, 0 if false.
1718
1719 =back
1720
1721 =cut
1722
1723 sub HasSubscriptionExpired {
1724     my ($subscriptionid) = @_;
1725     my $dbh              = C4::Context->dbh;
1726     my $subscription     = GetSubscription($subscriptionid);
1727     if (($subscription->{periodicity} % 16)>0){
1728       my $expirationdate   = GetExpirationDate($subscriptionid);
1729       my $query = qq|
1730             SELECT max(planneddate)
1731             FROM   serial
1732             WHERE  subscriptionid=?
1733       |;
1734       my $sth = $dbh->prepare($query);
1735       $sth->execute($subscriptionid);
1736       my ($res) = $sth->fetchrow  ;
1737       my @res=split (/-/,$res);
1738 # warn "date expiration :$expirationdate";
1739       my @endofsubscriptiondate=split(/-/,$expirationdate);
1740       return 1 if ( (@endofsubscriptiondate && Delta_Days($res[0],$res[1],$res[2],
1741                   $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) <= 0)
1742                   || (!$res));
1743       return 0;
1744     } else {
1745       if ($subscription->{'numberlength'}){
1746         my $countreceived=countissuesfrom($subscriptionid,$subscription->{'startdate'});
1747         return 1 if ($countreceived >$subscription->{'numberlentgh'});
1748               return 0;
1749       } else {
1750               return 0;
1751       }
1752     }
1753     return 0;
1754 }
1755
1756 =head2 SetDistributedto
1757
1758 =over 4
1759
1760 SetDistributedto($distributedto,$subscriptionid);
1761 This function update the value of distributedto for a subscription given on input arg.
1762
1763 =back
1764
1765 =cut
1766
1767 sub SetDistributedto {
1768     my ( $distributedto, $subscriptionid ) = @_;
1769     my $dbh   = C4::Context->dbh;
1770     my $query = qq|
1771         UPDATE subscription
1772         SET    distributedto=?
1773         WHERE  subscriptionid=?
1774     |;
1775     my $sth = $dbh->prepare($query);
1776     $sth->execute( $distributedto, $subscriptionid );
1777 }
1778
1779 =head2 DelSubscription
1780
1781 =over 4
1782
1783 DelSubscription($subscriptionid)
1784 this function delete the subscription which has $subscriptionid as id.
1785
1786 =back
1787
1788 =cut
1789
1790 sub DelSubscription {
1791     my ($subscriptionid) = @_;
1792     my $dbh = C4::Context->dbh;
1793     $subscriptionid = $dbh->quote($subscriptionid);
1794     $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1795     $dbh->do(
1796         "DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1797     $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1798
1799     &logaction(C4::Context->userenv->{'number'},"SERIAL","DELETE",$subscriptionid,"")
1800         if C4::Context->preference("SubscriptionLog");
1801 }
1802
1803 =head2 DelIssue
1804
1805 =over 4
1806
1807 DelIssue($serialseq,$subscriptionid)
1808 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1809
1810 =back
1811
1812 =cut
1813
1814 sub DelIssue {
1815     my ( $dataissue) = @_;
1816     my $dbh   = C4::Context->dbh;
1817     ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1818
1819     my $query = qq|
1820         DELETE FROM serial
1821         WHERE       serialid= ?
1822         AND         subscriptionid= ?
1823     |;
1824     my $mainsth = $dbh->prepare($query);
1825     $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'});
1826
1827     #Delete element from subscription history
1828     $query = "SELECT * FROM   subscription WHERE  subscriptionid = ?";
1829     my $sth   = $dbh->prepare($query);
1830     $sth->execute($dataissue->{'subscriptionid'});
1831     my $val = $sth->fetchrow_hashref;
1832     unless ( $val->{manualhistory} ) {
1833         my $query = qq|
1834           SELECT * FROM subscriptionhistory
1835           WHERE       subscriptionid= ?
1836       |;
1837         my $sth = $dbh->prepare($query);
1838         $sth->execute($dataissue->{'subscriptionid'});
1839         my $data = $sth->fetchrow_hashref;
1840         my $serialseq= $dataissue->{'serialseq'};
1841         $data->{'missinglist'}  =~ s/\b$serialseq\b//;
1842         $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1843         my $strsth = "UPDATE subscriptionhistory SET "
1844           . join( ",",
1845             map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data )
1846           . " WHERE subscriptionid=?";
1847         $sth = $dbh->prepare($strsth);
1848         $sth->execute($dataissue->{'subscriptionid'});
1849     }
1850
1851     return $mainsth->rows;
1852 }
1853
1854 =head2 GetLateOrMissingIssues
1855
1856 =over 4
1857
1858 ($count,@issuelist) = &GetLateMissingIssues($supplierid,$serialid)
1859
1860 this function select missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1861
1862 return :
1863 a count of the number of missing issues
1864 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1865 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1866
1867 =back
1868
1869 =cut
1870
1871 sub GetLateOrMissingIssues {
1872     my ( $supplierid, $serialid,$order ) = @_;
1873     my $dbh = C4::Context->dbh;
1874     my $sth;
1875     my $byserial = '';
1876     if ($serialid) {
1877         $byserial = "and serialid = " . $serialid;
1878     }
1879     if ($order){
1880       $order.=", title";
1881     } else {
1882       $order="title";
1883     }
1884     if ($supplierid) {
1885         $sth = $dbh->prepare(
1886 "SELECT
1887    serialid,
1888    aqbooksellerid,
1889    name,
1890    biblio.title,
1891    planneddate,
1892    serialseq,
1893    serial.status,
1894    serial.subscriptionid,
1895    claimdate
1896 FROM      serial
1897 LEFT JOIN subscription  ON serial.subscriptionid=subscription.subscriptionid
1898 LEFT JOIN biblio        ON subscription.biblionumber=biblio.biblionumber
1899 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1900 WHERE subscription.subscriptionid = serial.subscriptionid
1901 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1902 AND subscription.aqbooksellerid=$supplierid
1903 $byserial
1904 ORDER BY $order"
1905         );
1906     }
1907     else {
1908         $sth = $dbh->prepare(
1909 "SELECT
1910    serialid,
1911    aqbooksellerid,
1912    name,
1913    biblio.title,
1914    planneddate,
1915    serialseq,
1916    serial.status,
1917    serial.subscriptionid,
1918    claimdate
1919 FROM serial
1920 LEFT JOIN subscription
1921 ON serial.subscriptionid=subscription.subscriptionid
1922 LEFT JOIN biblio
1923 ON subscription.biblionumber=biblio.biblionumber
1924 LEFT JOIN aqbooksellers
1925 ON subscription.aqbooksellerid = aqbooksellers.id
1926 WHERE
1927    subscription.subscriptionid = serial.subscriptionid
1928 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1929 $byserial
1930 ORDER BY $order"
1931         );
1932     }
1933     $sth->execute;
1934     my @issuelist;
1935     my $last_title;
1936     my $odd   = 0;
1937     my $count = 0;
1938     while ( my $line = $sth->fetchrow_hashref ) {
1939         $odd++ unless $line->{title} eq $last_title;
1940         $last_title = $line->{title} if ( $line->{title} );
1941         $line->{planneddate} = format_date( $line->{planneddate} );
1942         $line->{claimdate}   = format_date( $line->{claimdate} );
1943         $line->{"status".$line->{status}}   = 1;
1944         $line->{'odd'} = 1 if $odd % 2;
1945         $count++;
1946         push @issuelist, $line;
1947     }
1948     return $count, @issuelist;
1949 }
1950
1951 =head2 removeMissingIssue
1952
1953 =over 4
1954
1955 removeMissingIssue($subscriptionid)
1956
1957 this function removes an issue from being part of the missing string in
1958 subscriptionlist.missinglist column
1959
1960 called when a missing issue is found from the serials-recieve.pl file
1961
1962 =back
1963
1964 =cut
1965
1966 sub removeMissingIssue {
1967     my ( $sequence, $subscriptionid ) = @_;
1968     my $dbh = C4::Context->dbh;
1969     my $sth =
1970       $dbh->prepare(
1971         "SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1972     $sth->execute($subscriptionid);
1973     my $data              = $sth->fetchrow_hashref;
1974     my $missinglist       = $data->{'missinglist'};
1975     my $missinglistbefore = $missinglist;
1976
1977     # warn $missinglist." before";
1978     $missinglist =~ s/($sequence)//;
1979
1980     # warn $missinglist." after";
1981     if ( $missinglist ne $missinglistbefore ) {
1982         $missinglist =~ s/\|\s\|/\|/g;
1983         $missinglist =~ s/^\| //g;
1984         $missinglist =~ s/\|$//g;
1985         my $sth2 = $dbh->prepare(
1986             "UPDATE subscriptionhistory
1987                                        SET missinglist = ?
1988                                        WHERE subscriptionid = ?"
1989         );
1990         $sth2->execute( $missinglist, $subscriptionid );
1991     }
1992 }
1993
1994 =head2 updateClaim
1995
1996 =over 4
1997
1998 &updateClaim($serialid)
1999
2000 this function updates the time when a claim is issued for late/missing items
2001
2002 called from claims.pl file
2003
2004 =back
2005
2006 =cut
2007
2008 sub updateClaim {
2009     my ($serialid) = @_;
2010     my $dbh        = C4::Context->dbh;
2011     my $sth        = $dbh->prepare(
2012         "UPDATE serial SET claimdate = now()
2013                                    WHERE serialid = ?
2014                                    "
2015     );
2016     $sth->execute($serialid);
2017 }
2018
2019 =head2 getsupplierbyserialid
2020
2021 =over 4
2022
2023 ($result) = &getsupplierbyserialid($serialid)
2024
2025 this function is used to find the supplier id given a serial id
2026
2027 return :
2028 hashref containing serialid, subscriptionid, and aqbooksellerid
2029
2030 =back
2031
2032 =cut
2033
2034 sub getsupplierbyserialid {
2035     my ($serialid) = @_;
2036     my $dbh        = C4::Context->dbh;
2037     my $sth        = $dbh->prepare(
2038         "SELECT serialid, serial.subscriptionid, aqbooksellerid
2039          FROM serial
2040          LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2041          WHERE serialid = ?
2042                                    "
2043     );
2044     $sth->execute($serialid);
2045     my $line   = $sth->fetchrow_hashref;
2046     my $result = $line->{'aqbooksellerid'};
2047     return $result;
2048 }
2049
2050 =head2 check_routing
2051
2052 =over 4
2053
2054 ($result) = &check_routing($subscriptionid)
2055
2056 this function checks to see if a serial has a routing list and returns the count of routingid
2057 used to show either an 'add' or 'edit' link
2058 =back
2059
2060 =cut
2061
2062 sub check_routing {
2063     my ($subscriptionid) = @_;
2064     my $dbh              = C4::Context->dbh;
2065     my $sth              = $dbh->prepare(
2066 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2067                               ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2068                               WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2069                               "
2070     );
2071     $sth->execute($subscriptionid);
2072     my $line   = $sth->fetchrow_hashref;
2073     my $result = $line->{'routingids'};
2074     return $result;
2075 }
2076
2077 =head2 addroutingmember
2078
2079 =over 4
2080
2081 &addroutingmember($borrowernumber,$subscriptionid)
2082
2083 this function takes a borrowernumber and subscriptionid and add the member to the
2084 routing list for that serial subscription and gives them a rank on the list
2085 of either 1 or highest current rank + 1
2086
2087 =back
2088
2089 =cut
2090
2091 sub addroutingmember {
2092     my ( $borrowernumber, $subscriptionid ) = @_;
2093     my $rank;
2094     my $dbh = C4::Context->dbh;
2095     my $sth =
2096       $dbh->prepare(
2097 "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?"
2098       );
2099     $sth->execute($subscriptionid);
2100     while ( my $line = $sth->fetchrow_hashref ) {
2101         if ( $line->{'rank'} > 0 ) {
2102             $rank = $line->{'rank'} + 1;
2103         }
2104         else {
2105             $rank = 1;
2106         }
2107     }
2108     $sth =
2109       $dbh->prepare(
2110 "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)"
2111       );
2112     $sth->execute( $subscriptionid, $borrowernumber, $rank );
2113 }
2114
2115 =head2 reorder_members
2116
2117 =over 4
2118
2119 &reorder_members($subscriptionid,$routingid,$rank)
2120
2121 this function is used to reorder the routing list
2122
2123 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2124 - it gets all members on list puts their routingid's into an array
2125 - removes the one in the array that is $routingid
2126 - then reinjects $routingid at point indicated by $rank
2127 - then update the database with the routingids in the new order
2128
2129 =back
2130
2131 =cut
2132
2133 sub reorder_members {
2134     my ( $subscriptionid, $routingid, $rank ) = @_;
2135     my $dbh = C4::Context->dbh;
2136     my $sth =
2137       $dbh->prepare(
2138 "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC"
2139       );
2140     $sth->execute($subscriptionid);
2141     my @result;
2142     while ( my $line = $sth->fetchrow_hashref ) {
2143         push( @result, $line->{'routingid'} );
2144     }
2145
2146     # To find the matching index
2147     my $i;
2148     my $key = -1;    # to allow for 0 being a valid response
2149     for ( $i = 0 ; $i < @result ; $i++ ) {
2150         if ( $routingid == $result[$i] ) {
2151             $key = $i;    # save the index
2152             last;
2153         }
2154     }
2155
2156     # if index exists in array then move it to new position
2157     if ( $key > -1 && $rank > 0 ) {
2158         my $new_rank = $rank -
2159           1;    # $new_rank is what you want the new index to be in the array
2160         my $moving_item = splice( @result, $key, 1 );
2161         splice( @result, $new_rank, 0, $moving_item );
2162     }
2163     for ( my $j = 0 ; $j < @result ; $j++ ) {
2164         my $sth =
2165           $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '"
2166               . ( $j + 1 )
2167               . "' WHERE routingid = '"
2168               . $result[$j]
2169               . "'" );
2170         $sth->execute;
2171     }
2172 }
2173
2174 =head2 delroutingmember
2175
2176 =over 4
2177
2178 &delroutingmember($routingid,$subscriptionid)
2179
2180 this function either deletes one member from routing list if $routingid exists otherwise
2181 deletes all members from the routing list
2182
2183 =back
2184
2185 =cut
2186
2187 sub delroutingmember {
2188
2189 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2190     my ( $routingid, $subscriptionid ) = @_;
2191     my $dbh = C4::Context->dbh;
2192     if ($routingid) {
2193         my $sth =
2194           $dbh->prepare(
2195             "DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2196         $sth->execute($routingid);
2197         reorder_members( $subscriptionid, $routingid );
2198     }
2199     else {
2200         my $sth =
2201           $dbh->prepare(
2202             "DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2203         $sth->execute($subscriptionid);
2204     }
2205 }
2206
2207 =head2 getroutinglist
2208
2209 =over 4
2210
2211 ($count,@routinglist) = &getroutinglist($subscriptionid)
2212
2213 this gets the info from the subscriptionroutinglist for $subscriptionid
2214
2215 return :
2216 a count of the number of members on routinglist
2217 the routinglist into a table. Each line of this table containts a ref to a hash which containts
2218 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2219
2220 =back
2221
2222 =cut
2223
2224 sub getroutinglist {
2225     my ($subscriptionid) = @_;
2226     my $dbh              = C4::Context->dbh;
2227     my $sth              = $dbh->prepare(
2228         "SELECT routingid, borrowernumber,
2229                               ranking, biblionumber
2230          FROM subscription
2231          LEFT JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2232          WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2233                               "
2234     );
2235     $sth->execute($subscriptionid);
2236     my @routinglist;
2237     my $count = 0;
2238     while ( my $line = $sth->fetchrow_hashref ) {
2239         $count++;
2240         push( @routinglist, $line );
2241     }
2242     return ( $count, @routinglist );
2243 }
2244
2245 =head2 countissuesfrom
2246
2247 =over 4
2248
2249 $result = &countissuesfrom($subscriptionid,$startdate)
2250
2251
2252 =back
2253
2254 =cut
2255
2256 sub countissuesfrom {
2257     my ($subscriptionid,$startdate) = @_;
2258     my $dbh              = C4::Context->dbh;
2259     my $query = qq|
2260             SELECT count(*)
2261             FROM   serial
2262             WHERE  subscriptionid=?
2263             AND serial.publisheddate>?
2264         |;
2265     my $sth=$dbh->prepare($query);
2266     $sth->execute($subscriptionid, $startdate);
2267     my ($countreceived)=$sth->fetchrow;
2268     return $countreceived;
2269 }
2270
2271 =head2 abouttoexpire
2272
2273 =over 4
2274
2275 $result = &abouttoexpire($subscriptionid)
2276
2277 this function alerts you to the penultimate issue for a serial subscription
2278
2279 returns 1 - if this is the penultimate issue
2280 returns 0 - if not
2281
2282 =back
2283
2284 =cut
2285
2286 sub abouttoexpire {
2287     my ($subscriptionid) = @_;
2288     my $dbh              = C4::Context->dbh;
2289     my $subscription     = GetSubscription($subscriptionid);
2290     my $per = $subscription->{'periodicity'};
2291     if ($per % 16>0){
2292       my $expirationdate   = GetExpirationDate($subscriptionid);
2293       my $sth =
2294         $dbh->prepare(
2295           "select max(planneddate) from serial where subscriptionid=?");
2296       $sth->execute($subscriptionid);
2297       my ($res) = $sth->fetchrow ;
2298 #        warn "date expiration : ".$expirationdate." date courante ".$res;
2299       my @res=split /-/,$res;
2300       @res=Date::Calc::Today if ($res[0]*$res[1]==0);
2301       my @endofsubscriptiondate=split/-/,$expirationdate;
2302       my $x;
2303       if ( $per == 1 ) {$x=7;}
2304       if ( $per == 2 ) {$x=7; }
2305       if ( $per == 3 ) {$x=14;}
2306       if ( $per == 4 ) { $x = 21; }
2307       if ( $per == 5 ) { $x = 31; }
2308       if ( $per == 6 ) { $x = 62; }
2309       if ( $per == 7 || $per == 8 ) { $x = 93; }
2310       if ( $per == 9 )  { $x = 190; }
2311       if ( $per == 10 ) { $x = 365; }
2312       if ( $per == 11 ) { $x = 730; }
2313       my @datebeforeend=Add_Delta_Days(  $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
2314                     - (3 * $x)) if (@endofsubscriptiondate);
2315               # warn "DATE BEFORE END: $datebeforeend";
2316       return 1 if ( @res &&
2317                     (@datebeforeend &&
2318                         Delta_Days($res[0],$res[1],$res[2],
2319                         $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) &&
2320                     (@endofsubscriptiondate &&
2321                         Delta_Days($res[0],$res[1],$res[2],
2322                         $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
2323     return 0;
2324    } elsif ($subscription->{numberlength}>0) {
2325     return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2326    } else {return 0}
2327 }
2328
2329 =head2 old_newsubscription
2330
2331 =over 4
2332
2333 ($subscriptionid) = &old_newsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2334                         $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2335                         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2336                         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2337                         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2338                         $numberingmethod, $status, $callnumber, $notes, $hemisphere)
2339
2340 this function is similar to the NewSubscription subroutine but has a few different
2341 values passed in
2342 $firstacquidate - date of first serial issue to arrive
2343 $irregularity - the issues not expected separated by a '|'
2344 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2345 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2346    subscription-add.tmpl file
2347 $callnumber - display the callnumber of the serial
2348 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2349
2350 return :
2351 the $subscriptionid number of the new subscription
2352
2353 =back
2354
2355 =cut
2356
2357 sub old_newsubscription {
2358     my (
2359         $auser,         $aqbooksellerid,  $cost,          $aqbudgetid,
2360         $biblionumber,  $startdate,       $periodicity,   $firstacquidate,
2361         $dow,           $irregularity,    $numberpattern, $numberlength,
2362         $weeklength,    $monthlength,     $add1,          $every1,
2363         $whenmorethan1, $setto1,          $lastvalue1,    $add2,
2364         $every2,        $whenmorethan2,   $setto2,        $lastvalue2,
2365         $add3,          $every3,          $whenmorethan3, $setto3,
2366         $lastvalue3,    $numberingmethod, $status,        $callnumber,
2367         $notes,         $hemisphere
2368     ) = @_;
2369     my $dbh = C4::Context->dbh;
2370
2371     #save subscription
2372     my $sth = $dbh->prepare(
2373 "insert into subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
2374                                                         startdate,periodicity,firstacquidate,dow,irregularity,numberpattern,numberlength,weeklength,monthlength,
2375                                                                 add1,every1,whenmorethan1,setto1,lastvalue1,
2376                                                                 add2,every2,whenmorethan2,setto2,lastvalue2,
2377                                                                 add3,every3,whenmorethan3,setto3,lastvalue3,
2378                                                                 numberingmethod, status, callnumber, notes, hemisphere) values
2379                                                           (?,?,?,?,?,?,?,?,?,?,?,
2380                                                                                            ?,?,?,?,?,?,?,?,?,?,?,
2381                                                                                            ?,?,?,?,?,?,?,?,?,?,?,?)"
2382     );
2383     $sth->execute(
2384         $auser,         $aqbooksellerid,
2385         $cost,          $aqbudgetid,
2386         $biblionumber,  format_date_in_iso($startdate),
2387         $periodicity,   format_date_in_iso($firstacquidate),
2388         $dow,           $irregularity,
2389         $numberpattern, $numberlength,
2390         $weeklength,    $monthlength,
2391         $add1,          $every1,
2392         $whenmorethan1, $setto1,
2393         $lastvalue1,    $add2,
2394         $every2,        $whenmorethan2,
2395         $setto2,        $lastvalue2,
2396         $add3,          $every3,
2397         $whenmorethan3, $setto3,
2398         $lastvalue3,    $numberingmethod,
2399         $status,        $callnumber,
2400         $notes,         $hemisphere
2401     );
2402
2403     #then create the 1st waited number
2404     my $subscriptionid = $dbh->{'mysql_insertid'};
2405     my $enddate        = GetExpirationDate($subscriptionid);
2406
2407     $sth =
2408       $dbh->prepare(
2409 "insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)"
2410       );
2411     $sth->execute(
2412         $biblionumber, $subscriptionid,
2413         format_date_in_iso($startdate),
2414         format_date_in_iso($enddate),
2415         "", "", "", $notes
2416     );
2417
2418    # reread subscription to get a hash (for calculation of the 1st issue number)
2419     $sth =
2420       $dbh->prepare("select * from subscription where subscriptionid = ? ");
2421     $sth->execute($subscriptionid);
2422     my $val = $sth->fetchrow_hashref;
2423
2424     # calculate issue number
2425     my $serialseq = GetSeq($val);
2426     $sth =
2427       $dbh->prepare(
2428 "insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)"
2429       );
2430     $sth->execute( $serialseq, $subscriptionid, $val->{'biblionumber'},
2431         1, format_date_in_iso($startdate) );
2432     return $subscriptionid;
2433 }
2434
2435 =head2 old_modsubscription
2436
2437 =over 4
2438
2439 ($subscriptionid) = &old_modsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2440                         $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2441                         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2442                         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2443                         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2444                         $numberingmethod, $status, $callnumber, $notes, $hemisphere, $subscriptionid)
2445
2446 this function is similar to the ModSubscription subroutine but has a few different
2447 values passed in
2448 $firstacquidate - date of first serial issue to arrive
2449 $irregularity - the issues not expected separated by a '|'
2450 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2451 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2452    subscription-add.tmpl file
2453 $callnumber - display the callnumber of the serial
2454 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2455
2456 =back
2457
2458 =cut
2459
2460 sub old_modsubscription {
2461     my (
2462         $auser,        $aqbooksellerid, $cost,           $aqbudgetid,
2463         $startdate,    $periodicity,    $firstacquidate, $dow,
2464         $irregularity, $numberpattern,  $numberlength,   $weeklength,
2465         $monthlength,  $add1,           $every1,         $whenmorethan1,
2466         $setto1,       $lastvalue1,     $innerloop1,     $add2,
2467         $every2,       $whenmorethan2,  $setto2,         $lastvalue2,
2468         $innerloop2,   $add3,           $every3,         $whenmorethan3,
2469         $setto3,       $lastvalue3,     $innerloop3,     $numberingmethod,
2470         $status,       $biblionumber,   $callnumber,     $notes,
2471         $hemisphere,   $subscriptionid
2472     ) = @_;
2473     my $dbh = C4::Context->dbh;
2474     my $sth = $dbh->prepare(
2475 "update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
2476                                                    periodicity=?,firstacquidate=?,dow=?,irregularity=?,numberpattern=?,numberlength=?,weeklength=?,monthlength=?,
2477                                                   add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
2478                                                   add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
2479                                                   add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
2480                                                   numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, hemisphere=? where subscriptionid = ?"
2481     );
2482     $sth->execute(
2483         $auser,        $aqbooksellerid, $cost,           $aqbudgetid,
2484         $startdate,    $periodicity,    $firstacquidate, $dow,
2485         $irregularity, $numberpattern,  $numberlength,   $weeklength,
2486         $monthlength,  $add1,           $every1,         $whenmorethan1,
2487         $setto1,       $lastvalue1,     $innerloop1,     $add2,
2488         $every2,       $whenmorethan2,  $setto2,         $lastvalue2,
2489         $innerloop2,   $add3,           $every3,         $whenmorethan3,
2490         $setto3,       $lastvalue3,     $innerloop3,     $numberingmethod,
2491         $status,       $biblionumber,   $callnumber,     $notes,
2492         $hemisphere,   $subscriptionid
2493     );
2494     $sth->finish;
2495
2496     $sth =
2497       $dbh->prepare("select * from subscription where subscriptionid = ? ");
2498     $sth->execute($subscriptionid);
2499     my $val = $sth->fetchrow_hashref;
2500
2501     # calculate issue number
2502     my $serialseq = Get_Seq($val);
2503     $sth =
2504       $dbh->prepare("UPDATE serial SET serialseq = ? WHERE subscriptionid = ?");
2505     $sth->execute( $serialseq, $subscriptionid );
2506
2507     my $enddate = subscriptionexpirationdate($subscriptionid);
2508     $sth = $dbh->prepare("update subscriptionhistory set enddate=?");
2509     $sth->execute( format_date_in_iso($enddate) );
2510 }
2511
2512 =head2 old_getserials
2513
2514 =over 4
2515
2516 ($totalissues,@serials) = &old_getserials($subscriptionid)
2517
2518 this function get a hashref of serials and the total count of them
2519
2520 return :
2521 $totalissues - number of serial lines
2522 the serials into a table. Each line of this table containts a ref to a hash which it containts
2523 serialid, serialseq, status,planneddate,notes,routingnotes  from tables : serial where status is not 2, 4, or 5
2524
2525 =back
2526
2527 =cut
2528
2529 sub old_getserials {
2530     my ($subscriptionid) = @_;
2531     my $dbh = C4::Context->dbh;
2532
2533     # status = 2 is "arrived"
2534     my $sth =
2535       $dbh->prepare(
2536 "select serialid,serialseq, status, planneddate,notes,routingnotes from serial where subscriptionid = ? and status <>2 and status <>4 and status <>5"
2537       );
2538     $sth->execute($subscriptionid);
2539     my @serials;
2540     my $num = 1;
2541     while ( my $line = $sth->fetchrow_hashref ) {
2542         $line->{ "status" . $line->{status} } =
2543           1;    # fills a "statusX" value, used for template status select list
2544         $line->{"planneddate"} = format_date( $line->{"planneddate"} );
2545         $line->{"num"}         = $num;
2546         $num++;
2547         push @serials, $line;
2548     }
2549     $sth = $dbh->prepare("select count(*) from serial where subscriptionid=?");
2550     $sth->execute($subscriptionid);
2551     my ($totalissues) = $sth->fetchrow;
2552     return ( $totalissues, @serials );
2553 }
2554
2555 =head2 GetNextDate
2556
2557 ($resultdate) = &GetNextDate($planneddate,$subscription)
2558
2559 this function is an extension of GetNextDate which allows for checking for irregularity
2560
2561 it takes the planneddate and will return the next issue's date and will skip dates if there
2562 exists an irregularity
2563 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2564 skipped then the returned date will be 2007-05-10
2565
2566 return :
2567 $resultdate - then next date in the sequence
2568
2569 Return 0 if periodicity==0
2570
2571 =cut
2572 sub in_array { # used in next sub down
2573   my ($val,@elements) = @_;
2574   foreach my $elem(@elements) {
2575     if($val == $elem) {
2576             return 1;
2577     }
2578   }
2579   return 0;
2580 }
2581
2582 sub GetNextDate(@) {
2583     my ( $planneddate, $subscription ) = @_;
2584     my @irreg = split( /\,/, $subscription->{irregularity} );
2585
2586     #date supposed to be in ISO.
2587
2588     my ( $year, $month, $day ) = split(/-/, $planneddate);
2589     $month=1 unless ($month);
2590     $day=1 unless ($day);
2591     my @resultdate;
2592
2593     #       warn "DOW $dayofweek";
2594     if ( $subscription->{periodicity} % 16 == 0 ) {
2595       return 0;
2596     }
2597     if ( $subscription->{periodicity} == 1 ) {
2598         my $dayofweek = Day_of_Week( $year,$month, $day );
2599         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2600             $dayofweek = 0 if ( $dayofweek == 7 );
2601             if ( in_array( ($dayofweek + 1), @irreg ) ) {
2602                 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 1 );
2603                 $dayofweek++;
2604             }
2605         }
2606         @resultdate = Add_Delta_Days($year,$month, $day , 1 );
2607     }
2608     if ( $subscription->{periodicity} == 2 ) {
2609         my ($wkno,$year) = Week_of_Year( $year,$month, $day );
2610         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2611             if ( $irreg[$i] == (($wkno!=51)?($wkno +1) % 52 :52)) {
2612                 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 7 );
2613                 $wkno=(($wkno!=51)?($wkno +1) % 52 :52);
2614             }
2615         }
2616         @resultdate = Add_Delta_Days( $year,$month, $day, 7);
2617     }
2618     if ( $subscription->{periodicity} == 3 ) {
2619         my ($wkno,$year) = Week_of_Year( $year,$month, $day );
2620         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2621             if ( $irreg[$i] == (($wkno!=50)?($wkno +2) % 52 :52)) {
2622             ### BUGFIX was previously +1 ^
2623                 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 14 );
2624                 $wkno=(($wkno!=50)?($wkno +2) % 52 :52);
2625             }
2626         }
2627         @resultdate = Add_Delta_Days($year,$month, $day , 14 );
2628     }
2629     if ( $subscription->{periodicity} == 4 ) {
2630         my ($wkno,$year) = Week_of_Year( $year,$month, $day );
2631         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2632             if ( $irreg[$i] == (($wkno!=49)?($wkno +3) % 52 :52)) {
2633                 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 21 );
2634                 $wkno=(($wkno!=49)?($wkno +3) % 52 :52);
2635             }
2636         }
2637         @resultdate = Add_Delta_Days($year,$month, $day , 21 );
2638     }
2639     my $tmpmonth=$month;
2640     if ( $subscription->{periodicity} == 5 ) {
2641         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2642             if ( $irreg[$i] == (($tmpmonth!=11)?($tmpmonth +1) % 12 :12)) {
2643                 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2644                 $tmpmonth=(($tmpmonth!=11)?($tmpmonth +1) % 12 :12);
2645             }
2646         }
2647         @resultdate = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2648     }
2649     if ( $subscription->{periodicity} == 6 ) {
2650         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2651             if ( $irreg[$i] == (($tmpmonth!=10)?($tmpmonth +2) % 12 :12)) {
2652                 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,2,0 );
2653                 $tmpmonth=(($tmpmonth!=10)?($tmpmonth + 2) % 12 :12);
2654             }
2655         }
2656         @resultdate = Add_Delta_YMD($year,$month, $day, 0, 2,0 );
2657     }
2658     if ( $subscription->{periodicity} == 7 ) {
2659         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2660             if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2661                 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2662                 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2663             }
2664         }
2665         @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2666     }
2667     if ( $subscription->{periodicity} == 8 ) {
2668         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2669             if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2670                 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2671                 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2672             }
2673         }
2674         @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2675     }
2676     if ( $subscription->{periodicity} == 9 ) {
2677         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2678             if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2679             ### BUFIX Seems to need more Than One ?
2680                 ($year,$month,$day) = Add_Delta_YM($year,$month, $day, 0, 6 );
2681                 $tmpmonth=(($tmpmonth!=6)?($tmpmonth + 6) % 12 :12);
2682             }
2683         }
2684         @resultdate = Add_Delta_YM($year,$month, $day, 0, 6);
2685     }
2686     if ( $subscription->{periodicity} == 10 ) {
2687         @resultdate = Add_Delta_YM($year,$month, $day, 1, 0 );
2688     }
2689     if ( $subscription->{periodicity} == 11 ) {
2690         @resultdate = Add_Delta_YM($year,$month, $day, 2, 0 );
2691     }
2692     my $resultdate=sprintf("%04d-%02d-%02d",$resultdate[0],$resultdate[1],$resultdate[2]);
2693 #     warn "dateNEXTSEQ : ".$resultdate;
2694     return "$resultdate";
2695 }
2696
2697 =head2 itemdata
2698
2699   $item = &itemdata($barcode);
2700
2701 Looks up the item with the given barcode, and returns a
2702 reference-to-hash containing information about that item. The keys of
2703 the hash are the fields from the C<items> and C<biblioitems> tables in
2704 the Koha database.
2705
2706 =cut
2707
2708 #'
2709 sub itemdata {
2710     my ($barcode) = @_;
2711     my $dbh       = C4::Context->dbh;
2712     my $sth       = $dbh->prepare(
2713         "Select * from items LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
2714         WHERE barcode=?"
2715     );
2716     $sth->execute($barcode);
2717     my $data = $sth->fetchrow_hashref;
2718     $sth->finish;
2719     return ($data);
2720 }
2721
2722 END { }    # module clean-up code here (global destructor)
2723
2724 1;
2725
2726 =back
2727
2728 =head1 AUTHOR
2729
2730 Koha Developement team <info@koha.org>
2731
2732 =cut