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