C4/Serials.pm

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