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