C4/Serials.pm

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