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
 144             LEFT JOIN  serial ON subscription.subscriptionid = serial.subscriptionid
 145             LEFT JOIN  biblio ON biblio.biblionumber = subscription.biblionumber
 146             LEFT JOIN  aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
 147             WHERE      ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
 148             AND        subscription.aqbooksellerid=$supplierid
 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
 157             LEFT JOIN  serial ON subscription.subscriptionid = serial.subscriptionid
 158             LEFT JOIN  biblio ON biblio.biblionumber = subscription.biblionumber
 159             LEFT JOIN  aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
 160             WHERE      ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
 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( {'serialid'=>$serialid, 'subscriptionid'=>$subscriptionid,'serialseq'=>$serialseq} );
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
1435          LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1436          WHERE    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 ( $dataissue) = @_;
1830     my $dbh   = C4::Context->dbh;
1831     ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1832
1833     my $query = qq|
1834         DELETE FROM serial
1835         WHERE       serialid= ?
1836         AND         subscriptionid= ?
1837     |;
1838     my $mainsth = $dbh->prepare($query);
1839     $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'});
1840
1841     #Delete element from subscription history
1842     $query = "SELECT * FROM   subscription WHERE  subscriptionid = ?";
1843     my $sth   = $dbh->prepare($query);
1844     $sth->execute($dataissue->{'subscriptionid'});
1845     my $val = $sth->fetchrow_hashref;
1846     unless ( $val->{manualhistory} ) {
1847         my $query = qq|
1848           SELECT * FROM subscriptionhistory
1849           WHERE       subscriptionid= ?
1850       |;
1851         my $sth = $dbh->prepare($query);
1852         $sth->execute($dataissue->{'subscriptionid'});
1853         my $data = $sth->fetchrow_hashref;
1854         my $serialseq= $dataissue->{'serialseq'};
1855         $data->{'missinglist'}  =~ s/\b$serialseq\b//;
1856         $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1857         my $strsth = "UPDATE subscriptionhistory SET "
1858           . join( ",",
1859             map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data )
1860           . " WHERE subscriptionid=?";
1861         $sth = $dbh->prepare($strsth);
1862         $sth->execute($dataissue->{'subscriptionid'});
1863     }
1864
1865     return $mainsth->rows;
1866 }
1867
1868 =head2 GetLateOrMissingIssues
1869
1870 =over 4
1871
1872 ($count,@issuelist) = &GetLateMissingIssues($supplierid,$serialid)
1873
1874 this function select missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1875
1876 return :
1877 a count of the number of missing issues
1878 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1879 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1880
1881 =back
1882
1883 =cut
1884
1885 sub GetLateOrMissingIssues {
1886     my ( $supplierid, $serialid,$order ) = @_;
1887     my $dbh = C4::Context->dbh;
1888     my $sth;
1889     my $byserial = '';
1890     if ($serialid) {
1891         $byserial = "and serialid = " . $serialid;
1892     }
1893     if ($order){
1894       $order.=", title";
1895     } else {
1896       $order="title";
1897     }
1898     if ($supplierid) {
1899         $sth = $dbh->prepare(
1900 "SELECT
1901    serialid,
1902    aqbooksellerid,
1903    name,
1904    biblio.title,
1905    planneddate,
1906    serialseq,
1907    serial.status,
1908    serial.subscriptionid,
1909    claimdate
1910 FROM      serial
1911 LEFT JOIN subscription  ON serial.subscriptionid=subscription.subscriptionid
1912 LEFT JOIN biblio        ON serial.biblionumber=biblio.biblionumber
1913 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1914 WHERE subscription.subscriptionid = serial.subscriptionid
1915 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1916 AND subscription.aqbooksellerid=$supplierid
1917 $byserial
1918 ORDER BY $order"
1919         );
1920     }
1921     else {
1922         $sth = $dbh->prepare(
1923 "SELECT
1924    serialid,
1925    aqbooksellerid,
1926    name,
1927    biblio.title,
1928    planneddate,
1929    serialseq,
1930    serial.status,
1931    serial.subscriptionid,
1932    claimdate
1933 FROM serial
1934 LEFT JOIN subscription
1935 ON serial.subscriptionid=subscription.subscriptionid
1936 LEFT JOIN biblio
1937 ON serial.biblionumber=biblio.biblionumber
1938 LEFT JOIN aqbooksellers
1939 ON subscription.aqbooksellerid = aqbooksellers.id
1940 WHERE
1941    subscription.subscriptionid = serial.subscriptionid
1942 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1943 AND biblio.biblionumber = subscription.biblionumber
1944 $byserial
1945 ORDER BY $order"
1946         );
1947     }
1948     $sth->execute;
1949     my @issuelist;
1950     my $last_title;
1951     my $odd   = 0;
1952     my $count = 0;
1953     while ( my $line = $sth->fetchrow_hashref ) {
1954         $odd++ unless $line->{title} eq $last_title;
1955         $last_title = $line->{title} if ( $line->{title} );
1956         $line->{planneddate} = format_date( $line->{planneddate} );
1957         $line->{claimdate}   = format_date( $line->{claimdate} );
1958         $line->{"status".$line->{status}}   = 1;
1959         $line->{'odd'} = 1 if $odd % 2;
1960         $count++;
1961         push @issuelist, $line;
1962     }
1963     return $count, @issuelist;
1964 }
1965
1966 =head2 removeMissingIssue
1967
1968 =over 4
1969
1970 removeMissingIssue($subscriptionid)
1971
1972 this function removes an issue from being part of the missing string in
1973 subscriptionlist.missinglist column
1974
1975 called when a missing issue is found from the serials-recieve.pl file
1976
1977 =back
1978
1979 =cut
1980
1981 sub removeMissingIssue {
1982     my ( $sequence, $subscriptionid ) = @_;
1983     my $dbh = C4::Context->dbh;
1984     my $sth =
1985       $dbh->prepare(
1986         "SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1987     $sth->execute($subscriptionid);
1988     my $data              = $sth->fetchrow_hashref;
1989     my $missinglist       = $data->{'missinglist'};
1990     my $missinglistbefore = $missinglist;
1991
1992     # warn $missinglist." before";
1993     $missinglist =~ s/($sequence)//;
1994
1995     # warn $missinglist." after";
1996     if ( $missinglist ne $missinglistbefore ) {
1997         $missinglist =~ s/\|\s\|/\|/g;
1998         $missinglist =~ s/^\| //g;
1999         $missinglist =~ s/\|$//g;
2000         my $sth2 = $dbh->prepare(
2001             "UPDATE subscriptionhistory
2002                                        SET missinglist = ?
2003                                        WHERE subscriptionid = ?"
2004         );
2005         $sth2->execute( $missinglist, $subscriptionid );
2006     }
2007 }
2008
2009 =head2 updateClaim
2010
2011 =over 4
2012
2013 &updateClaim($serialid)
2014
2015 this function updates the time when a claim is issued for late/missing items
2016
2017 called from claims.pl file
2018
2019 =back
2020
2021 =cut
2022
2023 sub updateClaim {
2024     my ($serialid) = @_;
2025     my $dbh        = C4::Context->dbh;
2026     my $sth        = $dbh->prepare(
2027         "UPDATE serial SET claimdate = now()
2028                                    WHERE serialid = ?
2029                                    "
2030     );
2031     $sth->execute($serialid);
2032 }
2033
2034 =head2 getsupplierbyserialid
2035
2036 =over 4
2037
2038 ($result) = &getsupplierbyserialid($serialid)
2039
2040 this function is used to find the supplier id given a serial id
2041
2042 return :
2043 hashref containing serialid, subscriptionid, and aqbooksellerid
2044
2045 =back
2046
2047 =cut
2048
2049 sub getsupplierbyserialid {
2050     my ($serialid) = @_;
2051     my $dbh        = C4::Context->dbh;
2052     my $sth        = $dbh->prepare(
2053         "SELECT serialid, serial.subscriptionid, aqbooksellerid
2054          FROM serial
2055          LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2056          WHERE serialid = ?
2057                                    "
2058     );
2059     $sth->execute($serialid);
2060     my $line   = $sth->fetchrow_hashref;
2061     my $result = $line->{'aqbooksellerid'};
2062     return $result;
2063 }
2064
2065 =head2 check_routing
2066
2067 =over 4
2068
2069 ($result) = &check_routing($subscriptionid)
2070
2071 this function checks to see if a serial has a routing list and returns the count of routingid
2072 used to show either an 'add' or 'edit' link
2073 =back
2074
2075 =cut
2076
2077 sub check_routing {
2078     my ($subscriptionid) = @_;
2079     my $dbh              = C4::Context->dbh;
2080     my $sth              = $dbh->prepare(
2081 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2082                               ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2083                               WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2084                               "
2085     );
2086     $sth->execute($subscriptionid);
2087     my $line   = $sth->fetchrow_hashref;
2088     my $result = $line->{'routingids'};
2089     return $result;
2090 }
2091
2092 =head2 addroutingmember
2093
2094 =over 4
2095
2096 &addroutingmember($borrowernumber,$subscriptionid)
2097
2098 this function takes a borrowernumber and subscriptionid and add the member to the
2099 routing list for that serial subscription and gives them a rank on the list
2100 of either 1 or highest current rank + 1
2101
2102 =back
2103
2104 =cut
2105
2106 sub addroutingmember {
2107     my ( $borrowernumber, $subscriptionid ) = @_;
2108     my $rank;
2109     my $dbh = C4::Context->dbh;
2110     my $sth =
2111       $dbh->prepare(
2112 "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?"
2113       );
2114     $sth->execute($subscriptionid);
2115     while ( my $line = $sth->fetchrow_hashref ) {
2116         if ( $line->{'rank'} > 0 ) {
2117             $rank = $line->{'rank'} + 1;
2118         }
2119         else {
2120             $rank = 1;
2121         }
2122     }
2123     $sth =
2124       $dbh->prepare(
2125 "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)"
2126       );
2127     $sth->execute( $subscriptionid, $borrowernumber, $rank );
2128 }
2129
2130 =head2 reorder_members
2131
2132 =over 4
2133
2134 &reorder_members($subscriptionid,$routingid,$rank)
2135
2136 this function is used to reorder the routing list
2137
2138 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2139 - it gets all members on list puts their routingid's into an array
2140 - removes the one in the array that is $routingid
2141 - then reinjects $routingid at point indicated by $rank
2142 - then update the database with the routingids in the new order
2143
2144 =back
2145
2146 =cut
2147
2148 sub reorder_members {
2149     my ( $subscriptionid, $routingid, $rank ) = @_;
2150     my $dbh = C4::Context->dbh;
2151     my $sth =
2152       $dbh->prepare(
2153 "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC"
2154       );
2155     $sth->execute($subscriptionid);
2156     my @result;
2157     while ( my $line = $sth->fetchrow_hashref ) {
2158         push( @result, $line->{'routingid'} );
2159     }
2160
2161     # To find the matching index
2162     my $i;
2163     my $key = -1;    # to allow for 0 being a valid response
2164     for ( $i = 0 ; $i < @result ; $i++ ) {
2165         if ( $routingid == $result[$i] ) {
2166             $key = $i;    # save the index
2167             last;
2168         }
2169     }
2170
2171     # if index exists in array then move it to new position
2172     if ( $key > -1 && $rank > 0 ) {
2173         my $new_rank = $rank -
2174           1;    # $new_rank is what you want the new index to be in the array
2175         my $moving_item = splice( @result, $key, 1 );
2176         splice( @result, $new_rank, 0, $moving_item );
2177     }
2178     for ( my $j = 0 ; $j < @result ; $j++ ) {
2179         my $sth =
2180           $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '"
2181               . ( $j + 1 )
2182               . "' WHERE routingid = '"
2183               . $result[$j]
2184               . "'" );
2185         $sth->execute;
2186     }
2187 }
2188
2189 =head2 delroutingmember
2190
2191 =over 4
2192
2193 &delroutingmember($routingid,$subscriptionid)
2194
2195 this function either deletes one member from routing list if $routingid exists otherwise
2196 deletes all members from the routing list
2197
2198 =back
2199
2200 =cut
2201
2202 sub delroutingmember {
2203
2204 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2205     my ( $routingid, $subscriptionid ) = @_;
2206     my $dbh = C4::Context->dbh;
2207     if ($routingid) {
2208         my $sth =
2209           $dbh->prepare(
2210             "DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2211         $sth->execute($routingid);
2212         reorder_members( $subscriptionid, $routingid );
2213     }
2214     else {
2215         my $sth =
2216           $dbh->prepare(
2217             "DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2218         $sth->execute($subscriptionid);
2219     }
2220 }
2221
2222 =head2 getroutinglist
2223
2224 =over 4
2225
2226 ($count,@routinglist) = &getroutinglist($subscriptionid)
2227
2228 this gets the info from the subscriptionroutinglist for $subscriptionid
2229
2230 return :
2231 a count of the number of members on routinglist
2232 the routinglist into a table. Each line of this table containts a ref to a hash which containts
2233 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2234
2235 =back
2236
2237 =cut
2238
2239 sub getroutinglist {
2240     my ($subscriptionid) = @_;
2241     my $dbh              = C4::Context->dbh;
2242     my $sth              = $dbh->prepare(
2243         "SELECT routingid, borrowernumber,
2244                               ranking, biblionumber
2245          FROM subscription
2246          LEFT JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2247          WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2248                               "
2249     );
2250     $sth->execute($subscriptionid);
2251     my @routinglist;
2252     my $count = 0;
2253     while ( my $line = $sth->fetchrow_hashref ) {
2254         $count++;
2255         push( @routinglist, $line );
2256     }
2257     return ( $count, @routinglist );
2258 }
2259
2260 =head2 countissuesfrom
2261
2262 =over 4
2263
2264 $result = &countissuesfrom($subscriptionid,$startdate)
2265
2266
2267 =back
2268
2269 =cut
2270
2271 sub countissuesfrom {
2272     my ($subscriptionid,$startdate) = @_;
2273     my $dbh              = C4::Context->dbh;
2274     my $query = qq|
2275             SELECT count(*)
2276             FROM   serial
2277             WHERE  subscriptionid=?
2278             AND serial.publisheddate>?
2279         |;
2280     my $sth=$dbh->prepare($query);
2281     $sth->execute($subscriptionid, $startdate);
2282     my ($countreceived)=$sth->fetchrow;
2283     return $countreceived;
2284 }
2285
2286 =head2 abouttoexpire
2287
2288 =over 4
2289
2290 $result = &abouttoexpire($subscriptionid)
2291
2292 this function alerts you to the penultimate issue for a serial subscription
2293
2294 returns 1 - if this is the penultimate issue
2295 returns 0 - if not
2296
2297 =back
2298
2299 =cut
2300
2301 sub abouttoexpire {
2302     my ($subscriptionid) = @_;
2303     my $dbh              = C4::Context->dbh;
2304     my $subscription     = GetSubscription($subscriptionid);
2305     my $per = $subscription->{'periodicity'};
2306     if ($per>0){
2307       my $expirationdate   = GetExpirationDate($subscriptionid);
2308       my $sth =
2309         $dbh->prepare(
2310           "select max(planneddate) from serial where subscriptionid=?");
2311       $sth->execute($subscriptionid);
2312       my ($res) = $sth->fetchrow ;
2313 #        warn "date expiration : ".$expirationdate." date courante ".$res;
2314       my @res=split /-/,$res;
2315       @res=Date::Calc::Today if ($res[0]*$res[1]==0);
2316       my @endofsubscriptiondate=split/-/,$expirationdate;
2317       my $per = $subscription->{'periodicity'};
2318       my $x;
2319       if ( $per == 1 ) {$x=7;}
2320       if ( $per == 2 ) {$x=7; }
2321       if ( $per == 3 ) {$x=14;}
2322       if ( $per == 4 ) { $x = 21; }
2323       if ( $per == 5 ) { $x = 31; }
2324       if ( $per == 6 ) { $x = 62; }
2325       if ( $per == 7 || $per == 8 ) { $x = 93; }
2326       if ( $per == 9 )  { $x = 190; }
2327       if ( $per == 10 ) { $x = 365; }
2328       if ( $per == 11 ) { $x = 730; }
2329       my @datebeforeend=Add_Delta_Days(  $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
2330                     - (3 * $x)) if (@endofsubscriptiondate);
2331               # warn "DATE BEFORE END: $datebeforeend";
2332       return 1 if ( @res &&
2333                     (@datebeforeend &&
2334                         Delta_Days($res[0],$res[1],$res[2],
2335                         $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) &&
2336                     (@endofsubscriptiondate &&
2337                         Delta_Days($res[0],$res[1],$res[2],
2338                         $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
2339       return 0;
2340    } elsif ($subscription->{numberlength}>0) {
2341     return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2342    } else {return 0}
2343 }
2344
2345 =head2 old_newsubscription
2346
2347 =over 4
2348
2349 ($subscriptionid) = &old_newsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2350                         $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2351                         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2352                         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2353                         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2354                         $numberingmethod, $status, $callnumber, $notes, $hemisphere)
2355
2356 this function is similar to the NewSubscription subroutine but has a few different
2357 values passed in
2358 $firstacquidate - date of first serial issue to arrive
2359 $irregularity - the issues not expected separated by a '|'
2360 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2361 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2362    subscription-add.tmpl file
2363 $callnumber - display the callnumber of the serial
2364 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2365
2366 return :
2367 the $subscriptionid number of the new subscription
2368
2369 =back
2370
2371 =cut
2372
2373 sub old_newsubscription {
2374     my (
2375         $auser,         $aqbooksellerid,  $cost,          $aqbudgetid,
2376         $biblionumber,  $startdate,       $periodicity,   $firstacquidate,
2377         $dow,           $irregularity,    $numberpattern, $numberlength,
2378         $weeklength,    $monthlength,     $add1,          $every1,
2379         $whenmorethan1, $setto1,          $lastvalue1,    $add2,
2380         $every2,        $whenmorethan2,   $setto2,        $lastvalue2,
2381         $add3,          $every3,          $whenmorethan3, $setto3,
2382         $lastvalue3,    $numberingmethod, $status,        $callnumber,
2383         $notes,         $hemisphere
2384     ) = @_;
2385     my $dbh = C4::Context->dbh;
2386
2387     #save subscription
2388     my $sth = $dbh->prepare(
2389 "insert into subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
2390                                                         startdate,periodicity,firstacquidate,dow,irregularity,numberpattern,numberlength,weeklength,monthlength,
2391                                                                 add1,every1,whenmorethan1,setto1,lastvalue1,
2392                                                                 add2,every2,whenmorethan2,setto2,lastvalue2,
2393                                                                 add3,every3,whenmorethan3,setto3,lastvalue3,
2394                                                                 numberingmethod, status, callnumber, notes, hemisphere) values
2395                                                           (?,?,?,?,?,?,?,?,?,?,?,
2396                                                                                            ?,?,?,?,?,?,?,?,?,?,?,
2397                                                                                            ?,?,?,?,?,?,?,?,?,?,?,?)"
2398     );
2399     $sth->execute(
2400         $auser,         $aqbooksellerid,
2401         $cost,          $aqbudgetid,
2402         $biblionumber,  format_date_in_iso($startdate),
2403         $periodicity,   format_date_in_iso($firstacquidate),
2404         $dow,           $irregularity,
2405         $numberpattern, $numberlength,
2406         $weeklength,    $monthlength,
2407         $add1,          $every1,
2408         $whenmorethan1, $setto1,
2409         $lastvalue1,    $add2,
2410         $every2,        $whenmorethan2,
2411         $setto2,        $lastvalue2,
2412         $add3,          $every3,
2413         $whenmorethan3, $setto3,
2414         $lastvalue3,    $numberingmethod,
2415         $status,        $callnumber,
2416         $notes,         $hemisphere
2417     );
2418
2419     #then create the 1st waited number
2420     my $subscriptionid = $dbh->{'mysql_insertid'};
2421     my $enddate        = GetExpirationDate($subscriptionid);
2422
2423     $sth =
2424       $dbh->prepare(
2425 "insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)"
2426       );
2427     $sth->execute(
2428         $biblionumber, $subscriptionid,
2429         format_date_in_iso($startdate),
2430         format_date_in_iso($enddate),
2431         "", "", "", $notes
2432     );
2433
2434    # reread subscription to get a hash (for calculation of the 1st issue number)
2435     $sth =
2436       $dbh->prepare("select * from subscription where subscriptionid = ? ");
2437     $sth->execute($subscriptionid);
2438     my $val = $sth->fetchrow_hashref;
2439
2440     # calculate issue number
2441     my $serialseq = GetSeq($val);
2442     $sth =
2443       $dbh->prepare(
2444 "insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)"
2445       );
2446     $sth->execute( $serialseq, $subscriptionid, $val->{'biblionumber'},
2447         1, format_date_in_iso($startdate) );
2448     return $subscriptionid;
2449 }
2450
2451 =head2 old_modsubscription
2452
2453 =over 4
2454
2455 ($subscriptionid) = &old_modsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2456                         $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2457                         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2458                         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2459                         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2460                         $numberingmethod, $status, $callnumber, $notes, $hemisphere, $subscriptionid)
2461
2462 this function is similar to the ModSubscription subroutine but has a few different
2463 values passed in
2464 $firstacquidate - date of first serial issue to arrive
2465 $irregularity - the issues not expected separated by a '|'
2466 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2467 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2468    subscription-add.tmpl file
2469 $callnumber - display the callnumber of the serial
2470 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2471
2472 =back
2473
2474 =cut
2475
2476 sub old_modsubscription {
2477     my (
2478         $auser,        $aqbooksellerid, $cost,           $aqbudgetid,
2479         $startdate,    $periodicity,    $firstacquidate, $dow,
2480         $irregularity, $numberpattern,  $numberlength,   $weeklength,
2481         $monthlength,  $add1,           $every1,         $whenmorethan1,
2482         $setto1,       $lastvalue1,     $innerloop1,     $add2,
2483         $every2,       $whenmorethan2,  $setto2,         $lastvalue2,
2484         $innerloop2,   $add3,           $every3,         $whenmorethan3,
2485         $setto3,       $lastvalue3,     $innerloop3,     $numberingmethod,
2486         $status,       $biblionumber,   $callnumber,     $notes,
2487         $hemisphere,   $subscriptionid
2488     ) = @_;
2489     my $dbh = C4::Context->dbh;
2490     my $sth = $dbh->prepare(
2491 "update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
2492                                                    periodicity=?,firstacquidate=?,dow=?,irregularity=?,numberpattern=?,numberlength=?,weeklength=?,monthlength=?,
2493                                                   add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
2494                                                   add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
2495                                                   add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
2496                                                   numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, hemisphere=? where subscriptionid = ?"
2497     );
2498     $sth->execute(
2499         $auser,        $aqbooksellerid, $cost,           $aqbudgetid,
2500         $startdate,    $periodicity,    $firstacquidate, $dow,
2501         $irregularity, $numberpattern,  $numberlength,   $weeklength,
2502         $monthlength,  $add1,           $every1,         $whenmorethan1,
2503         $setto1,       $lastvalue1,     $innerloop1,     $add2,
2504         $every2,       $whenmorethan2,  $setto2,         $lastvalue2,
2505         $innerloop2,   $add3,           $every3,         $whenmorethan3,
2506         $setto3,       $lastvalue3,     $innerloop3,     $numberingmethod,
2507         $status,       $biblionumber,   $callnumber,     $notes,
2508         $hemisphere,   $subscriptionid
2509     );
2510     $sth->finish;
2511
2512     $sth =
2513       $dbh->prepare("select * from subscription where subscriptionid = ? ");
2514     $sth->execute($subscriptionid);
2515     my $val = $sth->fetchrow_hashref;
2516
2517     # calculate issue number
2518     my $serialseq = Get_Seq($val);
2519     $sth =
2520       $dbh->prepare("UPDATE serial SET serialseq = ? WHERE subscriptionid = ?");
2521     $sth->execute( $serialseq, $subscriptionid );
2522
2523     my $enddate = subscriptionexpirationdate($subscriptionid);
2524     $sth = $dbh->prepare("update subscriptionhistory set enddate=?");
2525     $sth->execute( format_date_in_iso($enddate) );
2526 }
2527
2528 =head2 old_getserials
2529
2530 =over 4
2531
2532 ($totalissues,@serials) = &old_getserials($subscriptionid)
2533
2534 this function get a hashref of serials and the total count of them
2535
2536 return :
2537 $totalissues - number of serial lines
2538 the serials into a table. Each line of this table containts a ref to a hash which it containts
2539 serialid, serialseq, status,planneddate,notes,routingnotes  from tables : serial where status is not 2, 4, or 5
2540
2541 =back
2542
2543 =cut
2544
2545 sub old_getserials {
2546     my ($subscriptionid) = @_;
2547     my $dbh = C4::Context->dbh;
2548
2549     # status = 2 is "arrived"
2550     my $sth =
2551       $dbh->prepare(
2552 "select serialid,serialseq, status, planneddate,notes,routingnotes from serial where subscriptionid = ? and status <>2 and status <>4 and status <>5"
2553       );
2554     $sth->execute($subscriptionid);
2555     my @serials;
2556     my $num = 1;
2557     while ( my $line = $sth->fetchrow_hashref ) {
2558         $line->{ "status" . $line->{status} } =
2559           1;    # fills a "statusX" value, used for template status select list
2560         $line->{"planneddate"} = format_date( $line->{"planneddate"} );
2561         $line->{"num"}         = $num;
2562         $num++;
2563         push @serials, $line;
2564     }
2565     $sth = $dbh->prepare("select count(*) from serial where subscriptionid=?");
2566     $sth->execute($subscriptionid);
2567     my ($totalissues) = $sth->fetchrow;
2568     return ( $totalissues, @serials );
2569 }
2570
2571 =head2 GetNextDate
2572
2573 ($resultdate) = &GetNextDate($planneddate,$subscription)
2574
2575 this function is an extension of GetNextDate which allows for checking for irregularity
2576
2577 it takes the planneddate and will return the next issue's date and will skip dates if there
2578 exists an irregularity
2579 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2580 skipped then the returned date will be 2007-05-10
2581
2582 return :
2583 $resultdate - then next date in the sequence
2584
2585 Return 0 if periodicity==0
2586
2587 =cut
2588 sub in_array { # used in next sub down
2589   my ($val,@elements) = @_;
2590   foreach my $elem(@elements) {
2591     if($val == $elem) {
2592             return 1;
2593     }
2594   }
2595   return 0;
2596 }
2597
2598 sub GetNextDate(@) {
2599     my ( $planneddate, $subscription ) = @_;
2600     my @irreg = split( /\,/, $subscription->{irregularity} );
2601
2602     #date supposed to be in ISO.
2603
2604     my ( $year, $month, $day ) = split(/-/, $planneddate);
2605     $month=1 unless ($month);
2606     $day=1 unless ($day);
2607     my @resultdate;
2608
2609     #       warn "DOW $dayofweek";
2610     if ( $subscription->{periodicity} == 0 ) {
2611       return 0;
2612     }
2613     if ( $subscription->{periodicity} == 1 ) {
2614         my $dayofweek = Day_of_Week( $year,$month, $day );
2615         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2616             $dayofweek = 0 if ( $dayofweek == 7 );
2617             if ( in_array( ($dayofweek + 1), @irreg ) ) {
2618                 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 1 );
2619                 $dayofweek++;
2620             }
2621         }
2622         @resultdate = Add_Delta_Days($year,$month, $day , 1 );
2623     }
2624     if ( $subscription->{periodicity} == 2 ) {
2625         my ($wkno,$year) = Week_of_Year( $year,$month, $day );
2626         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2627             if ( $irreg[$i] == (($wkno!=51)?($wkno +1) % 52 :52)) {
2628                 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 7 );
2629                 $wkno=(($wkno!=51)?($wkno +1) % 52 :52);
2630             }
2631         }
2632         @resultdate = Add_Delta_Days( $year,$month, $day, 7);
2633     }
2634     if ( $subscription->{periodicity} == 3 ) {
2635         my ($wkno,$year) = Week_of_Year( $year,$month, $day );
2636         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2637             if ( $irreg[$i] == (($wkno!=50)?($wkno +2) % 52 :52)) {
2638             ### BUGFIX was previously +1 ^
2639                 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 14 );
2640                 $wkno=(($wkno!=50)?($wkno +2) % 52 :52);
2641             }
2642         }
2643         @resultdate = Add_Delta_Days($year,$month, $day , 14 );
2644     }
2645     if ( $subscription->{periodicity} == 4 ) {
2646         my ($wkno,$year) = Week_of_Year( $year,$month, $day );
2647         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2648             if ( $irreg[$i] == (($wkno!=49)?($wkno +3) % 52 :52)) {
2649                 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 21 );
2650                 $wkno=(($wkno!=49)?($wkno +3) % 52 :52);
2651             }
2652         }
2653         @resultdate = Add_Delta_Days($year,$month, $day , 21 );
2654     }
2655     my $tmpmonth=$month;
2656     if ( $subscription->{periodicity} == 5 ) {
2657         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2658             if ( $irreg[$i] == (($tmpmonth!=11)?($tmpmonth +1) % 12 :12)) {
2659                 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2660                 $tmpmonth=(($tmpmonth!=11)?($tmpmonth +1) % 12 :12);
2661             }
2662         }
2663         @resultdate = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2664     }
2665     if ( $subscription->{periodicity} == 6 ) {
2666         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2667             if ( $irreg[$i] == (($tmpmonth!=10)?($tmpmonth +2) % 12 :12)) {
2668                 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,2,0 );
2669                 $tmpmonth=(($tmpmonth!=10)?($tmpmonth + 2) % 12 :12);
2670             }
2671         }
2672         @resultdate = Add_Delta_YMD($year,$month, $day, 0, 2,0 );
2673     }
2674     if ( $subscription->{periodicity} == 7 ) {
2675         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2676             if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2677                 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2678                 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2679             }
2680         }
2681         @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2682     }
2683     if ( $subscription->{periodicity} == 8 ) {
2684         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2685             if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2686                 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2687                 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2688             }
2689         }
2690         @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2691     }
2692     if ( $subscription->{periodicity} == 9 ) {
2693         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2694             if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2695             ### BUFIX Seems to need more Than One ?
2696                 ($year,$month,$day) = Add_Delta_YM($year,$month, $day, 0, 6 );
2697                 $tmpmonth=(($tmpmonth!=6)?($tmpmonth + 6) % 12 :12);
2698             }
2699         }
2700         @resultdate = Add_Delta_YM($year,$month, $day, 0, 6);
2701     }
2702     if ( $subscription->{periodicity} == 10 ) {
2703         @resultdate = Add_Delta_YM($year,$month, $day, 1, 0 );
2704     }
2705     if ( $subscription->{periodicity} == 11 ) {
2706         @resultdate = Add_Delta_YM($year,$month, $day, 2, 0 );
2707     }
2708     my $resultdate=sprintf("%04d-%02d-%02d",$resultdate[0],$resultdate[1],$resultdate[2]);
2709 #     warn "dateNEXTSEQ : ".$resultdate;
2710     return "$resultdate";
2711 }
2712
2713 =head2 itemdata
2714
2715   $item = &itemdata($barcode);
2716
2717 Looks up the item with the given barcode, and returns a
2718 reference-to-hash containing information about that item. The keys of
2719 the hash are the fields from the C<items> and C<biblioitems> tables in
2720 the Koha database.
2721
2722 =cut
2723
2724 #'
2725 sub itemdata {
2726     my ($barcode) = @_;
2727     my $dbh       = C4::Context->dbh;
2728     my $sth       = $dbh->prepare(
2729         "Select * from items LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
2730         WHERE barcode=?"
2731     );
2732     $sth->execute($barcode);
2733     my $data = $sth->fetchrow_hashref;
2734     $sth->finish;
2735     return ($data);
2736 }
2737
2738 END { }    # module clean-up code here (global destructor)
2739
2740 1;
2741
2742 =back
2743
2744 =head1 AUTHOR
2745
2746 Koha Developement team <info@koha.org>
2747
2748 =cut