C4/Serials.pm

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