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