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