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

   1 package C4::Serials;    #assumes C4/Serials.pm
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 USA
  19
  20 # $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 $query = qq|
1768             SELECT count(*)
1769             FROM   serial
1770             WHERE  subscriptionid=?
1771             AND serial.publisheddate>?
1772         |;
1773         my $sth=$dbh->prepare($query);
1774         $sth->execute($subscriptionid, $subscription->{startdate});
1775         my ($countreceived)=$sth->fetchrow;
1776         return 1 if ($countreceived) >$subscription->{numberlentgh}-3;
1777         return 0;
1778       } else {
1779         return 0;
1780       }
1781     }
1782     return 0;
1783 }
1784
1785 =head2 SetDistributedto
1786
1787 =over 4
1788
1789 SetDistributedto($distributedto,$subscriptionid);
1790 This function update the value of distributedto for a subscription given on input arg.
1791
1792 =back
1793
1794 =cut
1795
1796 sub SetDistributedto {
1797     my ( $distributedto, $subscriptionid ) = @_;
1798     my $dbh   = C4::Context->dbh;
1799     my $query = qq|
1800         UPDATE subscription
1801         SET    distributedto=?
1802         WHERE  subscriptionid=?
1803     |;
1804     my $sth = $dbh->prepare($query);
1805     $sth->execute( $distributedto, $subscriptionid );
1806 }
1807
1808 =head2 DelSubscription
1809
1810 =over 4
1811
1812 DelSubscription($subscriptionid)
1813 this function delete the subscription which has $subscriptionid as id.
1814
1815 =back
1816
1817 =cut
1818
1819 sub DelSubscription {
1820     my ($subscriptionid) = @_;
1821     my $dbh = C4::Context->dbh;
1822     $subscriptionid = $dbh->quote($subscriptionid);
1823     $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1824     $dbh->do(
1825         "DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1826     $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1827
1828     &logaction(C4::Context->userenv->{'number'},"SERIAL","DELETE",$subscriptionid,"")
1829         if C4::Context->preference("SubscriptionLog");
1830 }
1831
1832 =head2 DelIssue
1833
1834 =over 4
1835
1836 DelIssue($serialseq,$subscriptionid)
1837 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1838
1839 =back
1840
1841 =cut
1842
1843 sub DelIssue {
1844     my ( $serialseq, $subscriptionid ) = @_;
1845     my $dbh   = C4::Context->dbh;
1846     my $query = qq|
1847         DELETE FROM serial
1848         WHERE       serialseq= ?
1849         AND         subscriptionid= ?
1850     |;
1851     my $mainsth = $dbh->prepare($query);
1852     $mainsth->execute( $serialseq, $subscriptionid );
1853
1854     #Delete element from subscription history
1855     $query = "SELECT * FROM   subscription WHERE  subscriptionid = ?";
1856     my $sth   = $dbh->prepare($query);
1857     $sth->execute($subscriptionid);
1858     my $val = $sth->fetchrow_hashref;
1859     unless ( $val->{manualhistory} ) {
1860         my $query = qq|
1861           SELECT * FROM subscriptionhistory
1862           WHERE       subscriptionid= ?
1863       |;
1864         my $sth = $dbh->prepare($query);
1865         $sth->execute($subscriptionid);
1866         my $data = $sth->fetchrow_hashref;
1867         $data->{'missinglist'}  =~ s/$serialseq//;
1868         $data->{'recievedlist'} =~ s/$serialseq//;
1869         my $strsth = "UPDATE subscriptionhistory SET "
1870           . join( ",",
1871             map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data )
1872           . " WHERE subscriptionid=?";
1873         $sth = $dbh->prepare($strsth);
1874         $sth->execute($subscriptionid);
1875     }
1876     ### TODO Add itemdeletion. Should be in a pref ?
1877
1878     return $mainsth->rows;
1879 }
1880
1881 =head2 GetLateOrMissingIssues
1882
1883 =over 4
1884
1885 ($count,@issuelist) = &GetLateMissingIssues($supplierid,$serialid)
1886
1887 this function select missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1888
1889 return :
1890 a count of the number of missing issues
1891 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1892 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1893
1894 =back
1895
1896 =cut
1897
1898 sub GetLateOrMissingIssues {
1899     my ( $supplierid, $serialid,$order ) = @_;
1900     my $dbh = C4::Context->dbh;
1901     my $sth;
1902     my $byserial = '';
1903     if ($serialid) {
1904         $byserial = "and serialid = " . $serialid;
1905     }
1906     if ($order){
1907       $order.=", title";
1908     } else {
1909       $order="title";
1910     }
1911     if ($supplierid) {
1912         $sth = $dbh->prepare(
1913 "SELECT
1914    serialid,
1915    aqbooksellerid,
1916    name,
1917    biblio.title,
1918    planneddate,
1919    serialseq,
1920    serial.status,
1921    serial.subscriptionid,
1922    claimdate
1923 FROM      serial
1924 LEFT JOIN subscription  ON serial.subscriptionid=subscription.subscriptionid
1925 LEFT JOIN biblio        ON serial.biblionumber=biblio.biblionumber
1926 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1927 WHERE subscription.subscriptionid = serial.subscriptionid
1928 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1929 AND subscription.aqbooksellerid=$supplierid
1930 $byserial
1931 ORDER BY $order"
1932         );
1933     }
1934     else {
1935         $sth = $dbh->prepare(
1936 "SELECT
1937    serialid,
1938    aqbooksellerid,
1939    name,
1940    biblio.title,
1941    planneddate,
1942    serialseq,
1943    serial.status,
1944    serial.subscriptionid,
1945    claimdate
1946 FROM serial
1947 LEFT JOIN subscription
1948 ON serial.subscriptionid=subscription.subscriptionid
1949 LEFT JOIN biblio
1950 ON serial.biblionumber=biblio.biblionumber
1951 LEFT JOIN aqbooksellers
1952 ON subscription.aqbooksellerid = aqbooksellers.id
1953 WHERE
1954    subscription.subscriptionid = serial.subscriptionid
1955 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1956 AND biblio.biblionumber = subscription.biblionumber
1957 $byserial
1958 ORDER BY $order"
1959         );
1960     }
1961     $sth->execute;
1962     my @issuelist;
1963     my $last_title;
1964     my $odd   = 0;
1965     my $count = 0;
1966     while ( my $line = $sth->fetchrow_hashref ) {
1967         $odd++ unless $line->{title} eq $last_title;
1968         $last_title = $line->{title} if ( $line->{title} );
1969         $line->{planneddate} = format_date( $line->{planneddate} );
1970         $line->{claimdate}   = format_date( $line->{claimdate} );
1971         $line->{"status".$line->{status}}   = 1;
1972         $line->{'odd'} = 1 if $odd % 2;
1973         $count++;
1974         push @issuelist, $line;
1975     }
1976     return $count, @issuelist;
1977 }
1978
1979 =head2 removeMissingIssue
1980
1981 =over 4
1982
1983 removeMissingIssue($subscriptionid)
1984
1985 this function removes an issue from being part of the missing string in
1986 subscriptionlist.missinglist column
1987
1988 called when a missing issue is found from the serials-recieve.pl file
1989
1990 =back
1991
1992 =cut
1993
1994 sub removeMissingIssue {
1995     my ( $sequence, $subscriptionid ) = @_;
1996     my $dbh = C4::Context->dbh;
1997     my $sth =
1998       $dbh->prepare(
1999         "SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
2000     $sth->execute($subscriptionid);
2001     my $data              = $sth->fetchrow_hashref;
2002     my $missinglist       = $data->{'missinglist'};
2003     my $missinglistbefore = $missinglist;
2004
2005     # warn $missinglist." before";
2006     $missinglist =~ s/($sequence)//;
2007
2008     # warn $missinglist." after";
2009     if ( $missinglist ne $missinglistbefore ) {
2010         $missinglist =~ s/\|\s\|/\|/g;
2011         $missinglist =~ s/^\| //g;
2012         $missinglist =~ s/\|$//g;
2013         my $sth2 = $dbh->prepare(
2014             "UPDATE subscriptionhistory
2015                                        SET missinglist = ?
2016                                        WHERE subscriptionid = ?"
2017         );
2018         $sth2->execute( $missinglist, $subscriptionid );
2019     }
2020 }
2021
2022 =head2 updateClaim
2023
2024 =over 4
2025
2026 &updateClaim($serialid)
2027
2028 this function updates the time when a claim is issued for late/missing items
2029
2030 called from claims.pl file
2031
2032 =back
2033
2034 =cut
2035
2036 sub updateClaim {
2037     my ($serialid) = @_;
2038     my $dbh        = C4::Context->dbh;
2039     my $sth        = $dbh->prepare(
2040         "UPDATE serial SET claimdate = now()
2041                                    WHERE serialid = ?
2042                                    "
2043     );
2044     $sth->execute($serialid);
2045 }
2046
2047 =head2 getsupplierbyserialid
2048
2049 =over 4
2050
2051 ($result) = &getsupplierbyserialid($serialid)
2052
2053 this function is used to find the supplier id given a serial id
2054
2055 return :
2056 hashref containing serialid, subscriptionid, and aqbooksellerid
2057
2058 =back
2059
2060 =cut
2061
2062 sub getsupplierbyserialid {
2063     my ($serialid) = @_;
2064     my $dbh        = C4::Context->dbh;
2065     my $sth        = $dbh->prepare(
2066         "SELECT serialid, serial.subscriptionid, aqbooksellerid
2067                                    FROM serial, subscription
2068                                    WHERE serial.subscriptionid = subscription.subscriptionid
2069                                    AND serialid = ?
2070                                    "
2071     );
2072     $sth->execute($serialid);
2073     my $line   = $sth->fetchrow_hashref;
2074     my $result = $line->{'aqbooksellerid'};
2075     return $result;
2076 }
2077
2078 =head2 check_routing
2079
2080 =over 4
2081
2082 ($result) = &check_routing($subscriptionid)
2083
2084 this function checks to see if a serial has a routing list and returns the count of routingid
2085 used to show either an 'add' or 'edit' link
2086 =back
2087
2088 =cut
2089
2090 sub check_routing {
2091     my ($subscriptionid) = @_;
2092     my $dbh              = C4::Context->dbh;
2093     my $sth              = $dbh->prepare(
2094 "SELECT count(routingid) routingids FROM subscriptionroutinglist, subscription
2095                               WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2096                               AND subscription.subscriptionid = ? ORDER BY ranking ASC
2097                               "
2098     );
2099     $sth->execute($subscriptionid);
2100     my $line   = $sth->fetchrow_hashref;
2101     my $result = $line->{'routingids'};
2102     return $result;
2103 }
2104
2105 =head2 addroutingmember
2106
2107 =over 4
2108
2109 &addroutingmember($borrowernumber,$subscriptionid)
2110
2111 this function takes a borrowernumber and subscriptionid and add the member to the
2112 routing list for that serial subscription and gives them a rank on the list
2113 of either 1 or highest current rank + 1
2114
2115 =back
2116
2117 =cut
2118
2119 sub addroutingmember {
2120     my ( $borrowernumber, $subscriptionid ) = @_;
2121     my $rank;
2122     my $dbh = C4::Context->dbh;
2123     my $sth =
2124       $dbh->prepare(
2125 "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?"
2126       );
2127     $sth->execute($subscriptionid);
2128     while ( my $line = $sth->fetchrow_hashref ) {
2129         if ( $line->{'rank'} > 0 ) {
2130             $rank = $line->{'rank'} + 1;
2131         }
2132         else {
2133             $rank = 1;
2134         }
2135     }
2136     $sth =
2137       $dbh->prepare(
2138 "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)"
2139       );
2140     $sth->execute( $subscriptionid, $borrowernumber, $rank );
2141 }
2142
2143 =head2 reorder_members
2144
2145 =over 4
2146
2147 &reorder_members($subscriptionid,$routingid,$rank)
2148
2149 this function is used to reorder the routing list
2150
2151 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2152 - it gets all members on list puts their routingid's into an array
2153 - removes the one in the array that is $routingid
2154 - then reinjects $routingid at point indicated by $rank
2155 - then update the database with the routingids in the new order
2156
2157 =back
2158
2159 =cut
2160
2161 sub reorder_members {
2162     my ( $subscriptionid, $routingid, $rank ) = @_;
2163     my $dbh = C4::Context->dbh;
2164     my $sth =
2165       $dbh->prepare(
2166 "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC"
2167       );
2168     $sth->execute($subscriptionid);
2169     my @result;
2170     while ( my $line = $sth->fetchrow_hashref ) {
2171         push( @result, $line->{'routingid'} );
2172     }
2173
2174     # To find the matching index
2175     my $i;
2176     my $key = -1;    # to allow for 0 being a valid response
2177     for ( $i = 0 ; $i < @result ; $i++ ) {
2178         if ( $routingid == $result[$i] ) {
2179             $key = $i;    # save the index
2180             last;
2181         }
2182     }
2183
2184     # if index exists in array then move it to new position
2185     if ( $key > -1 && $rank > 0 ) {
2186         my $new_rank = $rank -
2187           1;    # $new_rank is what you want the new index to be in the array
2188         my $moving_item = splice( @result, $key, 1 );
2189         splice( @result, $new_rank, 0, $moving_item );
2190     }
2191     for ( my $j = 0 ; $j < @result ; $j++ ) {
2192         my $sth =
2193           $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '"
2194               . ( $j + 1 )
2195               . "' WHERE routingid = '"
2196               . $result[$j]
2197               . "'" );
2198         $sth->execute;
2199     }
2200 }
2201
2202 =head2 delroutingmember
2203
2204 =over 4
2205
2206 &delroutingmember($routingid,$subscriptionid)
2207
2208 this function either deletes one member from routing list if $routingid exists otherwise
2209 deletes all members from the routing list
2210
2211 =back
2212
2213 =cut
2214
2215 sub delroutingmember {
2216
2217 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2218     my ( $routingid, $subscriptionid ) = @_;
2219     my $dbh = C4::Context->dbh;
2220     if ($routingid) {
2221         my $sth =
2222           $dbh->prepare(
2223             "DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2224         $sth->execute($routingid);
2225         reorder_members( $subscriptionid, $routingid );
2226     }
2227     else {
2228         my $sth =
2229           $dbh->prepare(
2230             "DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2231         $sth->execute($subscriptionid);
2232     }
2233 }
2234
2235 =head2 getroutinglist
2236
2237 =over 4
2238
2239 ($count,@routinglist) = &getroutinglist($subscriptionid)
2240
2241 this gets the info from the subscriptionroutinglist for $subscriptionid
2242
2243 return :
2244 a count of the number of members on routinglist
2245 the routinglist into a table. Each line of this table containts a ref to a hash which containts
2246 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2247
2248 =back
2249
2250 =cut
2251
2252 sub getroutinglist {
2253     my ($subscriptionid) = @_;
2254     my $dbh              = C4::Context->dbh;
2255     my $sth              = $dbh->prepare(
2256         "SELECT routingid, borrowernumber,
2257                               ranking, biblionumber FROM subscriptionroutinglist, subscription
2258                               WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2259                               AND subscription.subscriptionid = ? ORDER BY ranking ASC
2260                               "
2261     );
2262     $sth->execute($subscriptionid);
2263     my @routinglist;
2264     my $count = 0;
2265     while ( my $line = $sth->fetchrow_hashref ) {
2266         $count++;
2267         push( @routinglist, $line );
2268     }
2269     return ( $count, @routinglist );
2270 }
2271
2272 =head2 abouttoexpire
2273
2274 =over 4
2275
2276 $result = &abouttoexpire($subscriptionid)
2277
2278 this function alerts you to the penultimate issue for a serial subscription
2279
2280 returns 1 - if this is the penultimate issue
2281 returns 0 - if not
2282
2283 =back
2284
2285 =cut
2286
2287 sub abouttoexpire {
2288     my ($subscriptionid) = @_;
2289     my $dbh              = C4::Context->dbh;
2290     my $subscription     = GetSubscription($subscriptionid);
2291     my $expirationdate   = GetExpirationDate($subscriptionid);
2292     my $sth =
2293       $dbh->prepare(
2294         "select max(planneddate) from serial where subscriptionid=?");
2295     $sth->execute($subscriptionid);
2296     my ($res) = $sth->fetchrow ;
2297     warn "date expiration : ".$expirationdate." date courante ".$res;
2298     my @res=split /-/,$res;
2299     my @endofsubscriptiondate=split/-/,$expirationdate;
2300     my $per = $subscription->{'periodicity'};
2301     my $x;
2302     if ( $per == 1 ) {$x=7;}
2303     if ( $per == 2 ) {$x=7; }
2304     if ( $per == 3 ) {$x=14;}
2305     if ( $per == 4 ) { $x = 21; }
2306     if ( $per == 5 ) { $x = 31; }
2307     if ( $per == 6 ) { $x = 62; }
2308     if ( $per == 7 || $per == 8 ) { $x = 93; }
2309     if ( $per == 9 )  { $x = 190; }
2310     if ( $per == 10 ) { $x = 365; }
2311     if ( $per == 11 ) { $x = 730; }
2312     my @datebeforeend=Add_Delta_Days(  $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
2313                   - (3 * $x)) if (@endofsubscriptiondate);
2314             # warn "DATE BEFORE END: $datebeforeend";
2315     return 1 if ( @res &&
2316                   (@datebeforeend &&
2317                       Delta_Days($res[0],$res[1],$res[2],
2318                       $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) &&
2319                   (@endofsubscriptiondate &&
2320                       Delta_Days($res[0],$res[1],$res[2],
2321                       $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
2322     return 0;
2323 }
2324
2325 =head2 old_newsubscription
2326
2327 =over 4
2328
2329 ($subscriptionid) = &old_newsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2330                         $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2331                         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2332                         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2333                         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2334                         $numberingmethod, $status, $callnumber, $notes, $hemisphere)
2335
2336 this function is similar to the NewSubscription subroutine but has a few different
2337 values passed in
2338 $firstacquidate - date of first serial issue to arrive
2339 $irregularity - the issues not expected separated by a '|'
2340 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2341 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2342    subscription-add.tmpl file
2343 $callnumber - display the callnumber of the serial
2344 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2345
2346 return :
2347 the $subscriptionid number of the new subscription
2348
2349 =back
2350
2351 =cut
2352
2353 sub old_newsubscription {
2354     my (
2355         $auser,         $aqbooksellerid,  $cost,          $aqbudgetid,
2356         $biblionumber,  $startdate,       $periodicity,   $firstacquidate,
2357         $dow,           $irregularity,    $numberpattern, $numberlength,
2358         $weeklength,    $monthlength,     $add1,          $every1,
2359         $whenmorethan1, $setto1,          $lastvalue1,    $add2,
2360         $every2,        $whenmorethan2,   $setto2,        $lastvalue2,
2361         $add3,          $every3,          $whenmorethan3, $setto3,
2362         $lastvalue3,    $numberingmethod, $status,        $callnumber,
2363         $notes,         $hemisphere
2364     ) = @_;
2365     my $dbh = C4::Context->dbh;
2366
2367     #save subscription
2368     my $sth = $dbh->prepare(
2369 "insert into subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
2370                                                         startdate,periodicity,firstacquidate,dow,irregularity,numberpattern,numberlength,weeklength,monthlength,
2371                                                                 add1,every1,whenmorethan1,setto1,lastvalue1,
2372                                                                 add2,every2,whenmorethan2,setto2,lastvalue2,
2373                                                                 add3,every3,whenmorethan3,setto3,lastvalue3,
2374                                                                 numberingmethod, status, callnumber, notes, hemisphere) values
2375                                                           (?,?,?,?,?,?,?,?,?,?,?,
2376                                                                                            ?,?,?,?,?,?,?,?,?,?,?,
2377                                                                                            ?,?,?,?,?,?,?,?,?,?,?,?)"
2378     );
2379     $sth->execute(
2380         $auser,         $aqbooksellerid,
2381         $cost,          $aqbudgetid,
2382         $biblionumber,  format_date_in_iso($startdate),
2383         $periodicity,   format_date_in_iso($firstacquidate),
2384         $dow,           $irregularity,
2385         $numberpattern, $numberlength,
2386         $weeklength,    $monthlength,
2387         $add1,          $every1,
2388         $whenmorethan1, $setto1,
2389         $lastvalue1,    $add2,
2390         $every2,        $whenmorethan2,
2391         $setto2,        $lastvalue2,
2392         $add3,          $every3,
2393         $whenmorethan3, $setto3,
2394         $lastvalue3,    $numberingmethod,
2395         $status,        $callnumber,
2396         $notes,         $hemisphere
2397     );
2398
2399     #then create the 1st waited number
2400     my $subscriptionid = $dbh->{'mysql_insertid'};
2401     my $enddate        = GetExpirationDate($subscriptionid);
2402
2403     $sth =
2404       $dbh->prepare(
2405 "insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)"
2406       );
2407     $sth->execute(
2408         $biblionumber, $subscriptionid,
2409         format_date_in_iso($startdate),
2410         format_date_in_iso($enddate),
2411         "", "", "", $notes
2412     );
2413
2414    # reread subscription to get a hash (for calculation of the 1st issue number)
2415     $sth =
2416       $dbh->prepare("select * from subscription where subscriptionid = ? ");
2417     $sth->execute($subscriptionid);
2418     my $val = $sth->fetchrow_hashref;
2419
2420     # calculate issue number
2421     my $serialseq = GetSeq($val);
2422     $sth =
2423       $dbh->prepare(
2424 "insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)"
2425       );
2426     $sth->execute( $serialseq, $subscriptionid, $val->{'biblionumber'},
2427         1, format_date_in_iso($startdate) );
2428     return $subscriptionid;
2429 }
2430
2431 =head2 old_modsubscription
2432
2433 =over 4
2434
2435 ($subscriptionid) = &old_modsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2436                         $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2437                         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2438                         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2439                         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2440                         $numberingmethod, $status, $callnumber, $notes, $hemisphere, $subscriptionid)
2441
2442 this function is similar to the ModSubscription subroutine but has a few different
2443 values passed in
2444 $firstacquidate - date of first serial issue to arrive
2445 $irregularity - the issues not expected separated by a '|'
2446 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2447 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2448    subscription-add.tmpl file
2449 $callnumber - display the callnumber of the serial
2450 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2451
2452 =back
2453
2454 =cut
2455
2456 sub old_modsubscription {
2457     my (
2458         $auser,        $aqbooksellerid, $cost,           $aqbudgetid,
2459         $startdate,    $periodicity,    $firstacquidate, $dow,
2460         $irregularity, $numberpattern,  $numberlength,   $weeklength,
2461         $monthlength,  $add1,           $every1,         $whenmorethan1,
2462         $setto1,       $lastvalue1,     $innerloop1,     $add2,
2463         $every2,       $whenmorethan2,  $setto2,         $lastvalue2,
2464         $innerloop2,   $add3,           $every3,         $whenmorethan3,
2465         $setto3,       $lastvalue3,     $innerloop3,     $numberingmethod,
2466         $status,       $biblionumber,   $callnumber,     $notes,
2467         $hemisphere,   $subscriptionid
2468     ) = @_;
2469     my $dbh = C4::Context->dbh;
2470     my $sth = $dbh->prepare(
2471 "update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
2472                                                    periodicity=?,firstacquidate=?,dow=?,irregularity=?,numberpattern=?,numberlength=?,weeklength=?,monthlength=?,
2473                                                   add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
2474                                                   add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
2475                                                   add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
2476                                                   numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, hemisphere=? where subscriptionid = ?"
2477     );
2478     $sth->execute(
2479         $auser,        $aqbooksellerid, $cost,           $aqbudgetid,
2480         $startdate,    $periodicity,    $firstacquidate, $dow,
2481         $irregularity, $numberpattern,  $numberlength,   $weeklength,
2482         $monthlength,  $add1,           $every1,         $whenmorethan1,
2483         $setto1,       $lastvalue1,     $innerloop1,     $add2,
2484         $every2,       $whenmorethan2,  $setto2,         $lastvalue2,
2485         $innerloop2,   $add3,           $every3,         $whenmorethan3,
2486         $setto3,       $lastvalue3,     $innerloop3,     $numberingmethod,
2487         $status,       $biblionumber,   $callnumber,     $notes,
2488         $hemisphere,   $subscriptionid
2489     );
2490     $sth->finish;
2491
2492     $sth =
2493       $dbh->prepare("select * from subscription where subscriptionid = ? ");
2494     $sth->execute($subscriptionid);
2495     my $val = $sth->fetchrow_hashref;
2496
2497     # calculate issue number
2498     my $serialseq = Get_Seq($val);
2499     $sth =
2500       $dbh->prepare("UPDATE serial SET serialseq = ? WHERE subscriptionid = ?");
2501     $sth->execute( $serialseq, $subscriptionid );
2502
2503     my $enddate = subscriptionexpirationdate($subscriptionid);
2504     $sth = $dbh->prepare("update subscriptionhistory set enddate=?");
2505     $sth->execute( format_date_in_iso($enddate) );
2506 }
2507
2508 =head2 old_getserials
2509
2510 =over 4
2511
2512 ($totalissues,@serials) = &old_getserials($subscriptionid)
2513
2514 this function get a hashref of serials and the total count of them
2515
2516 return :
2517 $totalissues - number of serial lines
2518 the serials into a table. Each line of this table containts a ref to a hash which it containts
2519 serialid, serialseq, status,planneddate,notes,routingnotes  from tables : serial where status is not 2, 4, or 5
2520
2521 =back
2522
2523 =cut
2524
2525 sub old_getserials {
2526     my ($subscriptionid) = @_;
2527     my $dbh = C4::Context->dbh;
2528
2529     # status = 2 is "arrived"
2530     my $sth =
2531       $dbh->prepare(
2532 "select serialid,serialseq, status, planneddate,notes,routingnotes from serial where subscriptionid = ? and status <>2 and status <>4 and status <>5"
2533       );
2534     $sth->execute($subscriptionid);
2535     my @serials;
2536     my $num = 1;
2537     while ( my $line = $sth->fetchrow_hashref ) {
2538         $line->{ "status" . $line->{status} } =
2539           1;    # fills a "statusX" value, used for template status select list
2540         $line->{"planneddate"} = format_date( $line->{"planneddate"} );
2541         $line->{"num"}         = $num;
2542         $num++;
2543         push @serials, $line;
2544     }
2545     $sth = $dbh->prepare("select count(*) from serial where subscriptionid=?");
2546     $sth->execute($subscriptionid);
2547     my ($totalissues) = $sth->fetchrow;
2548     return ( $totalissues, @serials );
2549 }
2550
2551 =head2 GetNextDate
2552
2553 ($resultdate) = &GetNextDate($planneddate,$subscription)
2554
2555 this function is an extension of GetNextDate which allows for checking for irregularity
2556
2557 it takes the planneddate and will return the next issue's date and will skip dates if there
2558 exists an irregularity
2559 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2560 skipped then the returned date will be 2007-05-10
2561
2562 return :
2563 $resultdate - then next date in the sequence
2564
2565 FIXME : have to replace Date::Manip by Date::Calc in this function to improve performances.
2566
2567 =cut
2568 sub in_array { # used in next sub down
2569   my ($val,@elements) = @_;
2570   foreach my $elem(@elements) {
2571     if($val == $elem) {
2572             return 1;
2573     }
2574   }
2575   return 0;
2576 }
2577
2578 sub GetNextDate(@) {
2579     my ( $planneddate, $subscription ) = @_;
2580     my @irreg = split( /\,/, $subscription->{irregularity} );
2581
2582     #date supposed to be in ISO.
2583
2584     my ( $year, $month, $day ) = split(/-/, $planneddate);
2585     $month=1 unless ($month);
2586     $day=1 unless ($day);
2587     my @resultdate;
2588
2589     #       warn "DOW $dayofweek";
2590     if ( $subscription->{periodicity} == 1 ) {
2591         my $dayofweek = Day_of_Week( $year,$month, $day );
2592         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2593             $dayofweek = 0 if ( $dayofweek == 7 );
2594             if ( in_array( ($dayofweek + 1), @irreg ) ) {
2595                 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 1 );
2596                 $dayofweek++;
2597             }
2598         }
2599         @resultdate = Add_Delta_Days($year,$month, $day , 1 );
2600     }
2601     if ( $subscription->{periodicity} == 2 ) {
2602         my ($wkno,$year) = Week_of_Year( $year,$month, $day );
2603         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2604             if ( $irreg[$i] == (($wkno!=51)?($wkno +1) % 52 :52)) {
2605                 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 7 );
2606                 $wkno=(($wkno!=51)?($wkno +1) % 52 :52);
2607             }
2608         }
2609         @resultdate = Add_Delta_Days( $year,$month, $day, 7);
2610     }
2611     if ( $subscription->{periodicity} == 3 ) {
2612         my ($wkno,$year) = Week_of_Year( $year,$month, $day );
2613         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2614             if ( $irreg[$i] == (($wkno!=50)?($wkno +2) % 52 :52)) {
2615             ### BUGFIX was previously +1 ^
2616                 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 14 );
2617                 $wkno=(($wkno!=50)?($wkno +2) % 52 :52);
2618             }
2619         }
2620         @resultdate = Add_Delta_Days($year,$month, $day , 14 );
2621     }
2622     if ( $subscription->{periodicity} == 4 ) {
2623         my ($wkno,$year) = Week_of_Year( $year,$month, $day );
2624         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2625             if ( $irreg[$i] == (($wkno!=49)?($wkno +3) % 52 :52)) {
2626                 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 21 );
2627                 $wkno=(($wkno!=49)?($wkno +3) % 52 :52);
2628             }
2629         }
2630         @resultdate = Add_Delta_Days($year,$month, $day , 21 );
2631     }
2632     my $tmpmonth=$month;
2633     if ( $subscription->{periodicity} == 5 ) {
2634         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2635             if ( $irreg[$i] == (($tmpmonth!=11)?($tmpmonth +1) % 12 :12)) {
2636                 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2637                 $tmpmonth=(($tmpmonth!=11)?($tmpmonth +1) % 12 :12);
2638             }
2639         }
2640         @resultdate = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2641     }
2642     if ( $subscription->{periodicity} == 6 ) {
2643         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2644             if ( $irreg[$i] == (($tmpmonth!=10)?($tmpmonth +2) % 12 :12)) {
2645                 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,2,0 );
2646                 $tmpmonth=(($tmpmonth!=10)?($tmpmonth + 2) % 12 :12);
2647             }
2648         }
2649         @resultdate = Add_Delta_YMD($year,$month, $day, 0, 2,0 );
2650     }
2651     if ( $subscription->{periodicity} == 7 ) {
2652         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2653             if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2654                 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2655                 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2656             }
2657         }
2658         @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2659     }
2660     if ( $subscription->{periodicity} == 8 ) {
2661         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2662             if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2663                 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2664                 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2665             }
2666         }
2667         @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2668     }
2669     if ( $subscription->{periodicity} == 9 ) {
2670         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2671             if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2672             ### BUFIX Seems to need more Than One ?
2673                 ($year,$month,$day) = Add_Delta_YM($year,$month, $day, 0, 6 );
2674                 $tmpmonth=(($tmpmonth!=6)?($tmpmonth + 6) % 12 :12);
2675             }
2676         }
2677         @resultdate = Add_Delta_YM($year,$month, $day, 0, 6);
2678     }
2679     if ( $subscription->{periodicity} == 10 ) {
2680         @resultdate = Add_Delta_YM($year,$month, $day, 1, 0 );
2681     }
2682     if ( $subscription->{periodicity} == 11 ) {
2683         @resultdate = Add_Delta_YM($year,$month, $day, 2, 0 );
2684     }
2685     my $resultdate=sprintf("%04d-%02d-%02d",$resultdate[0],$resultdate[1],$resultdate[2]);
2686 #     warn "dateNEXTSEQ : ".$resultdate;
2687     return "$resultdate";
2688 }
2689
2690 =head2 itemdata
2691
2692   $item = &itemdata($barcode);
2693
2694 Looks up the item with the given barcode, and returns a
2695 reference-to-hash containing information about that item. The keys of
2696 the hash are the fields from the C<items> and C<biblioitems> tables in
2697 the Koha database.
2698
2699 =cut
2700
2701 #'
2702 sub itemdata {
2703     my ($barcode) = @_;
2704     my $dbh       = C4::Context->dbh;
2705     my $sth       = $dbh->prepare(
2706         "Select * from items,biblioitems where barcode=?
2707   and items.biblioitemnumber=biblioitems.biblioitemnumber"
2708     );
2709     $sth->execute($barcode);
2710     my $data = $sth->fetchrow_hashref;
2711     $sth->finish;
2712     return ($data);
2713 }
2714
2715 END { }    # module clean-up code here (global destructor)
2716
2717 1;
2718
2719 =back
2720
2721 =head1 AUTHOR
2722
2723 Koha Developement team <info@koha.org>
2724
2725 =cut