C4/Serials.pm

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