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