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