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::Manip;
  25 use C4::Suggestions;
  26 use C4::Biblio;
  27 use C4::Search;
  28 require Exporter;
  29
  30 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  31
  32 # set the version for version checking
  33 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
  34         shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
  35
  36
  37 =head1 NAME
  38
  39 C4::Serials - Give functions for serializing.
  40
  41 =head1 SYNOPSIS
  42
  43   use C4::Serials;
  44
  45 =head1 DESCRIPTION
  46
  47 Give all XYZ functions
  48
  49 =head1 FUNCTIONS
  50
  51 =cut
  52 @ISA = qw(Exporter);
  53 @EXPORT = qw(
  54     &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions &GetSubscription
  55     &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
  56     &GetFullSubscriptionsFromBiblionumber &GetNextSeq
  57     &ModSubscriptionHistory &NewIssue &ItemizeSerials
  58     &GetSerials &GetLatestSerials &ModSerialStatus
  59     &HasSubscriptionExpired &GetSubscriptionExpirationDate &ReNewSubscription
  60     &GetSuppliersWithLateIssues &GetLateIssues
  61     &GetDistributedTo &SetDistributedto
  62 );
  63
  64 =head2 GetSuppliersWithLateIssues
  65
  66 =over 4
  67
  68 %supplierlist = &GetSuppliersWithLateIssues
  69
  70 this function get all suppliers with late issues.
  71
  72 return :
  73 the supplierlist into a hash. this hash containts id & name of the supplier
  74
  75 =back
  76
  77 =cut
  78 sub GetSuppliersWithLateIssues {
  79     my $dbh = C4::Context->dbh;
  80     my $query = qq|
  81         SELECT DISTINCT id, name
  82         FROM            subscription, serial
  83         LEFT JOIN       aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
  84         WHERE           subscription.subscriptionid = serial.subscriptionid
  85         AND             (planneddate < now() OR serial.STATUS = 3)
  86     |;
  87     my $sth = $dbh->prepare($query);
  88     $sth->execute;
  89     my %supplierlist;
  90     while (my ($id,$name) = $sth->fetchrow) {
  91         $supplierlist{$id} = $name;
  92     }
  93     return %supplierlist;
  94 }
  95
  96 =head2 GetLateIssues
  97
  98 =over 4
  99
 100 @issuelist = &GetLateIssues($supplierid)
 101
 102 this function select late issues on database
 103
 104 return :
 105 the issuelist into an table. Each line of this table containts a ref to a hash which it containts
 106 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
 107
 108 =back
 109
 110 =cut
 111 sub GetLateIssues {
 112     my ($supplierid) = @_;
 113     my $dbh = C4::Context->dbh;
 114     my $sth;
 115     if ($supplierid) {
 116         my $query = qq |
 117             SELECT     name,title,planneddate,serialseq,serial.subscriptionid
 118             FROM       subscription, serial, biblio
 119             LEFT JOIN  aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
 120             WHERE      subscription.subscriptionid = serial.subscriptionid
 121             AND        ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
 122             AND        subscription.aqbooksellerid=$supplierid
 123             AND        biblio.biblionumber = subscription.biblionumber
 124             ORDER BY   title
 125         |;
 126         $sth = $dbh->prepare($query);
 127     } else {
 128         my $query = qq|
 129             SELECT     name,title,planneddate,serialseq,serial.subscriptionid
 130             FROM       subscription, serial, biblio
 131             LEFT JOIN  aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
 132             WHERE      subscription.subscriptionid = serial.subscriptionid
 133             AND        ((planneddate < now() AND serial.STATUS <=3) OR serial.STATUS = 3)
 134             AND        biblio.biblionumber = subscription.biblionumber
 135             ORDER BY   title
 136         |;
 137         $sth = $dbh->prepare($query);
 138     }
 139     $sth->execute;
 140     my @issuelist;
 141     my $last_title;
 142     my $odd=0;
 143     while (my $line = $sth->fetchrow_hashref) {
 144         $odd++ unless $line->{title} eq $last_title;
 145         $line->{title} = "" if $line->{title} eq $last_title;
 146         $last_title = $line->{title} if ($line->{title});
 147         $line->{planneddate} = format_date($line->{planneddate});
 148         $line->{'odd'} = 1 if $odd %2 ;
 149         push @issuelist,$line;
 150     }
 151     return @issuelist;
 152 }
 153
 154 =head2 GetSubscriptionHistoryFromSubscriptionId
 155
 156 =over 4
 157
 158 $sth = GetSubscriptionHistoryFromSubscriptionId()
 159 this function just prepare the SQL request.
 160 After this function, don't forget to execute it by using $sth->execute($subscriptionid)
 161 return :
 162 $sth = $dbh->prepare($query).
 163
 164 =back
 165
 166 =cut
 167 sub GetSubscriptionHistoryFromSubscriptionId() {
 168     my $dbh = C4::Context->dbh;
 169     my $query = qq|
 170         SELECT *
 171         FROM   subcriptionhistory
 172         WHERE  subscriptionid = ?
 173     |;
 174     return $dbh->prepare($query);
 175 }
 176
 177 =head2 GetSerialStatusFromSerialId
 178
 179 =over 4
 180
 181 $sth = GetSerialStatusFromSerialId();
 182 this function just prepare the SQL request.
 183 After this function, don't forget to execute it by using $sth->execute($serialid)
 184 return :
 185 $sth = $dbh->prepare($query).
 186
 187 =back
 188
 189 =cut
 190 sub GetSerialStatusFromSerialId(){
 191     my $dbh = C4::Context->dbh;
 192     my $query = qq|
 193         SELECT status
 194         FROM   serial
 195         WHERE  serialid = ?
 196     |;
 197     return $dbh->prepare($query);
 198 }
 199
 200
 201 =head2 GetSubscription
 202
 203 =over 4
 204
 205 $subs = GetSubscription($subscriptionid)
 206 this function get the subscription which has $subscriptionid as id.
 207 return :
 208 a hashref. This hash containts
 209 subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
 210
 211 =back
 212
 213 =cut
 214 sub GetSubscription {
 215     my ($subscriptionid) = @_;
 216     my $dbh = C4::Context->dbh;
 217     my $query =qq(
 218         SELECT  subscription.*,
 219                 subscriptionhistory.*,
 220                 aqbudget.bookfundid,
 221                 aqbooksellers.name AS aqbooksellername,
 222                 biblio.title AS bibliotitle
 223        FROM subscription
 224        LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
 225        LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
 226        LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
 227        LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
 228        WHERE subscription.subscriptionid = ?
 229     );
 230     my $sth = $dbh->prepare($query);
 231     $sth->execute($subscriptionid);
 232     my $subs = $sth->fetchrow_hashref;
 233     return $subs;
 234 }
 235
 236 =head2 GetSubscriptionsFromBiblionumber
 237
 238 =over 4
 239
 240 \@res = GetSubscriptionsFromBiblionumber($biblionumber)
 241 this function get the subscription list. it reads on subscription table.
 242 return :
 243 table of subscription which has the biblionumber given on input arg.
 244 each line of this table is a hashref. All hashes containt
 245 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
 246
 247 =back
 248
 249 =cut
 250 sub GetSubscriptionsFromBiblionumber {
 251     my ($biblionumber) = @_;
 252     my $dbh = C4::Context->dbh;
 253     my $query = qq(
 254         SELECT subscription.*,
 255                subscriptionhistory.*,
 256                aqbudget.bookfundid,
 257                aqbooksellers.name AS aqbooksellername,
 258                biblio.title AS bibliotitle
 259        FROM subscription
 260        LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
 261        LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
 262        LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
 263        LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
 264        WHERE subscription.biblionumber = ?
 265     );
 266     my $sth = $dbh->prepare($query);
 267     $sth->execute($biblionumber);
 268     my @res;
 269     while (my $subs = $sth->fetchrow_hashref) {
 270         $subs->{startdate} = format_date($subs->{startdate});
 271         $subs->{histstartdate} = format_date($subs->{histstartdate});
 272         $subs->{opacnote} =~ s/\n/\<br\/\>/g;
 273         $subs->{missinglist} =~ s/\n/\<br\/\>/g;
 274         $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
 275         $subs->{"periodicity".$subs->{periodicity}} = 1;
 276         $subs->{"status".$subs->{'status'}} = 1;
 277         if ($subs->{enddate} eq '0000-00-00') {
 278             $subs->{enddate}='';
 279         } else {
 280             $subs->{enddate} = format_date($subs->{enddate});
 281         }
 282         push @res,$subs;
 283     }
 284     return \@res;
 285 }
 286 =head2 GetFullSubscriptionsFromBiblionumber
 287
 288 =over 4
 289
 290    \@res = GetFullSubscriptionsFromBiblionumber($biblionumber)
 291    this function read on serial table.
 292
 293 =back
 294
 295 =cut
 296 sub GetFullSubscriptionsFromBiblionumber {
 297     my ($biblionumber) = @_;
 298     my $dbh = C4::Context->dbh;
 299     my $query=qq|
 300                 SELECT  serial.serialseq,
 301                         serial.planneddate,
 302                         serial.publisheddate,
 303                         serial.status,
 304                         serial.notes,
 305                         year(serial.publisheddate) AS year,
 306                         aqbudget.bookfundid,aqbooksellers.name AS aqbooksellername,
 307                         biblio.title AS bibliotitle
 308                 FROM serial
 309                 LEFT JOIN subscription ON
 310                     (serial.subscriptionid=subscription.subscriptionid AND subscription.biblionumber=serial.biblionumber)
 311                 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
 312                 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
 313                 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
 314                 WHERE subscription.biblionumber = ?
 315                 ORDER BY year,serial.publisheddate,serial.subscriptionid,serial.planneddate
 316     |;
 317
 318     my $sth = $dbh->prepare($query);
 319     $sth->execute($biblionumber);
 320     my @res;
 321     my $year;
 322     my $startdate;
 323     my $aqbooksellername;
 324     my $bibliotitle;
 325     my @loopissues;
 326     my $first;
 327     my $previousnote="";
 328     while (my $subs = $sth->fetchrow_hashref) {
 329         ### BUG To FIX: When there is no published date, will create many null ids!!!
 330
 331         if ($year and ($year==$subs->{year})){
 332             if ($first eq 1){$first=0;}
 333             my $temp=$res[scalar(@res)-1]->{'serials'};
 334             push @$temp,
 335                 {'publisheddate' =>format_date($subs->{'publisheddate'}),
 336                 'planneddate' => format_date($subs->{'planneddate'}),
 337                 'serialseq' => $subs->{'serialseq'},
 338                 "status".$subs->{'status'} => 1,
 339                 'notes' => $subs->{'notes'} eq $previousnote?"":$subs->{notes},
 340                 };
 341         } else {
 342             $first=1 if (not $year);
 343             $year= $subs->{'year'};
 344             $startdate= format_date($subs->{'startdate'});
 345             $aqbooksellername= $subs->{'aqbooksellername'};
 346             $bibliotitle= $subs->{'bibliotitle'};
 347             my @temp;
 348             push @temp,
 349                 {'publisheddate' =>format_date($subs->{'publisheddate'}),
 350                             'planneddate' => format_date($subs->{'planneddate'}),
 351                 'serialseq' => $subs->{'serialseq'},
 352                 "status".$subs->{'status'} => 1,
 353                 'notes' => $subs->{'notes'} eq $previousnote?"":$subs->{notes},
 354                 };
 355
 356             push @res,{
 357                 'year'=>$year,
 358                 'startdate'=>$startdate,
 359                 'aqbooksellername'=>$aqbooksellername,
 360                 'bibliotitle'=>$bibliotitle,
 361                 'serials'=>\@temp,
 362                 'first'=>$first
 363             };
 364         }
 365         $previousnote=$subs->{notes};
 366     }
 367     return \@res;
 368 }
 369
 370
 371 =head2 GetSubscriptions
 372
 373 =over 4
 374
 375 @results = GetSubscriptions($title,$ISSN,$biblionumber);
 376 this function get all subscriptions which has title like $title,ISSN like $ISSN and biblionumber like $biblionumber.
 377 return:
 378 a table of hashref. Each hash containt the subscription.
 379
 380 =back
 381
 382 =cut
 383 sub GetSubscriptions {
 384     my ($title,$ISSN,$biblionumber) = @_;
 385     return unless $title or $ISSN or $biblionumber;
 386     my $dbh = C4::Context->dbh;
 387     my $sth;
 388     if ($biblionumber) {
 389         my $query = qq(
 390             SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber
 391             FROM   subscription,biblio,biblioitems
 392             WHERE   biblio.biblionumber = biblioitems.biblionumber
 393                 AND biblio.biblionumber = subscription.biblionumber
 394                 AND biblio.biblionumber=?
 395             ORDER BY title
 396         );
 397     $sth = $dbh->prepare($query);
 398     $sth->execute($biblionumber);
 399     } else {
 400         if ($ISSN and $title){
 401             my $query = qq|
 402                 SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber
 403                 FROM   subscription,biblio,biblioitems
 404                 WHERE  biblio.biblionumber = biblioitems.biblionumber
 405                     AND biblio.biblionumber= subscription.biblionumber
 406                     AND (biblio.title LIKE ? or biblioitems.issn = ?)
 407                 ORDER BY title
 408             |;
 409             $sth = $dbh->prepare($query);
 410             $sth->execute("%$title%",$ISSN);
 411         }
 412         else{
 413             if ($ISSN){
 414                 my $query = qq(
 415                     SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber
 416                     FROM   subscription,biblio,biblioitems
 417                     WHERE  biblio.biblionumber = biblioitems.biblionumber
 418                         AND biblio.biblionumber=subscription.biblionumber
 419                         AND biblioitems.issn = ?
 420                     ORDER BY title
 421                 );
 422                 $sth = $dbh->prepare($query);
 423                 $sth->execute($ISSN);
 424             } else {
 425                 my $query = qq(
 426                     SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber
 427                     FROM   subscription,biblio,biblioitems
 428                     WHERE  biblio.biblionumber = biblioitems.biblionumber
 429                         AND biblio.biblionumber=subscription.biblionumber
 430                         AND biblio.title LIKE ?
 431                     ORDER BY title
 432                 );
 433                 $sth = $dbh->prepare($query);
 434                 $sth->execute("%$title%");
 435             }
 436         }
 437     }
 438     my @results;
 439     my $previoustitle="";
 440     my $odd=1;
 441     while (my $line = $sth->fetchrow_hashref) {
 442         if ($previoustitle eq $line->{title}) {
 443             $line->{title}="";
 444             $line->{issn}="";
 445             $line->{toggle} = 1 if $odd==1;
 446         } else {
 447             $previoustitle=$line->{title};
 448             $odd=-$odd;
 449             $line->{toggle} = 1 if $odd==1;
 450         }
 451         push @results, $line;
 452     }
 453     return @results;
 454 }
 455
 456 =head2 GetSerials
 457
 458 =over 4
 459
 460 ($totalissues,@serials) = GetSerials($subscriptionid);
 461 this function get every serial not arrived for a given subscription
 462 as well as the number of issues registered in the database (all types)
 463 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
 464
 465 =back
 466
 467 =cut
 468 sub GetSerials {
 469     my ($subscriptionid) = @_;
 470     my $dbh = C4::Context->dbh;
 471     # OK, now add the last 5 issues arrives/missing
 472     my $query = qq|
 473         SELECT   serialid,serialseq, status, planneddate,notes
 474         FROM     serial
 475         WHERE    subscriptionid = ?
 476         AND      (status in (2,4,5))
 477         ORDER BY serialid DESC
 478     |;
 479     my $sth=$dbh->prepare($query);
 480     $sth->execute($subscriptionid);
 481     my $counter=0;
 482     my @serials;
 483     while((my $line = $sth->fetchrow_hashref) && $counter <5) {
 484         $counter++;
 485         $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
 486         $line->{"planneddate"} = format_date($line->{"planneddate"});
 487         push @serials,$line;
 488     }
 489     # status = 2 is "arrived"
 490     my $query = qq|
 491         SELECT serialid,serialseq, status, publisheddate, planneddate,notes
 492         FROM   serial
 493         WHERE  subscriptionid = ? AND status NOT IN (2,4,5)
 494     |;
 495     my $sth=$dbh->prepare($query);
 496     $sth->execute($subscriptionid);
 497     while(my $line = $sth->fetchrow_hashref) {
 498         $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
 499         $line->{"publisheddate"} = format_date($line->{"publisheddate"});
 500         $line->{"planneddate"} = format_date($line->{"planneddate"});
 501         push @serials,$line;
 502     }
 503     my $query = qq|
 504         SELECT count(*)
 505         FROM   serial
 506         WHERE  subscriptionid=?
 507     |;
 508     $sth=$dbh->prepare($query);
 509     $sth->execute($subscriptionid);
 510     my ($totalissues) = $sth->fetchrow;
 511     return ($totalissues,@serials);
 512 }
 513
 514 =head2 GetLatestSerials
 515
 516 =over 4
 517
 518 \@serials = GetLatestSerials($subscriptionid,$limit)
 519 get the $limit's latest serials arrived or missing for a given subscription
 520 return :
 521 a ref to a table which it containts all of the latest serials stored into a hash.
 522
 523 =back
 524
 525 =cut
 526 sub GetLatestSerials {
 527     my ($subscriptionid,$limit) = @_;
 528     my $dbh = C4::Context->dbh;
 529     # status = 2 is "arrived"
 530     my $strsth=qq(
 531         SELECT   serialid,serialseq, status, planneddate
 532         FROM     serial
 533         WHERE    subscriptionid = ?
 534         AND      (status =2 or status=4)
 535         ORDER BY planneddate DESC LIMIT 0,$limit
 536     );
 537     my $sth=$dbh->prepare($strsth);
 538     $sth->execute($subscriptionid);
 539     my @serials;
 540     while(my $line = $sth->fetchrow_hashref) {
 541         $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
 542         $line->{"planneddate"} = format_date($line->{"planneddate"});
 543         push @serials,$line;
 544     }
 545 #     my $query = qq|
 546 #         SELECT count(*)
 547 #         FROM   serial
 548 #         WHERE  subscriptionid=?
 549 #     |;
 550 #     $sth=$dbh->prepare($query);
 551 #     $sth->execute($subscriptionid);
 552 #     my ($totalissues) = $sth->fetchrow;
 553     return \@serials;
 554 }
 555
 556 =head2 GetDistributedTo
 557
 558 =over 4
 559
 560 $distributedto=GetDistributedTo($subscriptionid)
 561 This function select the old previous value of distributedto in the database.
 562
 563 =back
 564
 565 =cut
 566 sub GetDistributedTo {
 567     my $dbh = C4::Context->dbh;
 568     my $distributedto;
 569     my $subscriptionid = @_;
 570     my $query = qq|
 571         SELECT distributedto
 572         FROM   subscription
 573         WHERE  subscriptionid=?
 574     |;
 575     my $sth = $dbh->prepare($query);
 576     $sth->execute($subscriptionid);
 577     return ($distributedto) = $sth->fetchrow;
 578 }
 579
 580 =head2 GetNextSeq
 581
 582 =over 4
 583
 584 GetNextSeq($val)
 585 $val is a hashref containing all the attributes of the table 'subscription'
 586 This function get the next issue for the subscription given on input arg
 587 return:
 588 all the input params updated.
 589
 590 =back
 591
 592 =cut
 593 sub GetNextSeq {
 594     my ($val) =@_;
 595     my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
 596     $calculated = $val->{numberingmethod};
 597 # calculate the (expected) value of the next issue recieved.
 598     $newlastvalue1 = $val->{lastvalue1};
 599 # check if we have to increase the new value.
 600     $newinnerloop1 = $val->{innerloop1}+1;
 601     $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
 602     $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
 603     $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
 604     $calculated =~ s/\{X\}/$newlastvalue1/g;
 605
 606     $newlastvalue2 = $val->{lastvalue2};
 607 # check if we have to increase the new value.
 608     $newinnerloop2 = $val->{innerloop2}+1;
 609     $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
 610     $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
 611     $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
 612     $calculated =~ s/\{Y\}/$newlastvalue2/g;
 613
 614     $newlastvalue3 = $val->{lastvalue3};
 615 # check if we have to increase the new value.
 616     $newinnerloop3 = $val->{innerloop3}+1;
 617     $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
 618     $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
 619     $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
 620     $calculated =~ s/\{Z\}/$newlastvalue3/g;
 621     return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
 622 }
 623
 624 =head2 GetNextDate
 625
 626 =over 4
 627
 628 $resultdate = GetNextDate($planneddate,$subscription)
 629
 630 this function get the date after $planneddate.
 631 return:
 632 the date on ISO format.
 633
 634 =back
 635
 636 =cut
 637 sub GetNextDate(@) {
 638     my ($planneddate,$subscription) = @_;
 639     my $resultdate;
 640     if ($subscription->{periodicity} == 1) {
 641         $resultdate=DateCalc($planneddate,"1 day");
 642     }
 643     if ($subscription->{periodicity} == 2) {
 644         $resultdate=DateCalc($planneddate,"1 week");
 645     }
 646     if ($subscription->{periodicity} == 3) {
 647         $resultdate=DateCalc($planneddate,"2 weeks");
 648     }
 649     if ($subscription->{periodicity} == 4) {
 650         $resultdate=DateCalc($planneddate,"3 weeks");
 651     }
 652     if ($subscription->{periodicity} == 5) {
 653         $resultdate=DateCalc($planneddate,"1 month");
 654     }
 655     if ($subscription->{periodicity} == 6) {
 656         $resultdate=DateCalc($planneddate,"2 months");
 657     }
 658     if ($subscription->{periodicity} == 7) {
 659         $resultdate=DateCalc($planneddate,"3 months");
 660     }
 661     if ($subscription->{periodicity} == 8) {
 662         $resultdate=DateCalc($planneddate,"3 months");
 663     }
 664     if ($subscription->{periodicity} == 9) {
 665         $resultdate=DateCalc($planneddate,"6 months");
 666     }
 667     if ($subscription->{periodicity} == 10) {
 668         $resultdate=DateCalc($planneddate,"1 year");
 669     }
 670     if ($subscription->{periodicity} == 11) {
 671         $resultdate=DateCalc($planneddate,"2 years");
 672     }
 673     return format_date_in_iso($resultdate);
 674 }
 675
 676 =head2 GetSeq
 677
 678 =over 4
 679
 680 $calculated = GetSeq($val)
 681 $val is a hashref containing all the attributes of the table 'subscription'
 682 this function transforms {X},{Y},{Z} to 150,0,0 for example.
 683 return:
 684 the sequence in integer format
 685
 686 =back
 687
 688 =cut
 689 sub GetSeq {
 690     my ($val) =@_;
 691     my $calculated = $val->{numberingmethod};
 692     my $x=$val->{'lastvalue1'};
 693     $calculated =~ s/\{X\}/$x/g;
 694     my $y=$val->{'lastvalue2'};
 695     $calculated =~ s/\{Y\}/$y/g;
 696     my $z=$val->{'lastvalue3'};
 697     $calculated =~ s/\{Z\}/$z/g;
 698     return $calculated;
 699 }
 700
 701 =head2 GetSubscriptionExpirationDate
 702
 703 =over 4
 704
 705 $sensddate = GetSubscriptionExpirationDate($subscriptionid)
 706
 707 this function return the expiration date for a subscription given on input args.
 708
 709 return
 710 the enddate
 711
 712 =back
 713
 714 =cut
 715 sub GetSubscriptionExpirationDate {
 716     my ($subscriptionid) = @_;
 717     my $dbh = C4::Context->dbh;
 718     my $subscription = GetSubscription($subscriptionid);
 719     my $enddate=$subscription->{startdate};
 720     # we don't do the same test if the subscription is based on X numbers or on X weeks/months
 721     if ($subscription->{numberlength}) {
 722         #calculate the date of the last issue.
 723         for (my $i=1;$i<=$subscription->{numberlength};$i++) {
 724             $enddate = GetNextDate($enddate,$subscription);
 725         }
 726     }
 727     else {
 728         $enddate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
 729         $enddate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
 730     }
 731     return $enddate;
 732 }
 733
 734 =head2 CountSubscriptionFromBiblionumber
 735
 736 =over 4
 737
 738 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
 739 this count the number of subscription for a biblionumber given.
 740 return :
 741 the number of subscriptions with biblionumber given on input arg.
 742
 743 =back
 744
 745 =cut
 746 sub CountSubscriptionFromBiblionumber {
 747     my ($biblionumber) = @_;
 748     my $dbh = C4::Context->dbh;
 749     my $query = qq|
 750         SELECT count(*)
 751         FROM   subscription
 752         WHERE  biblionumber=?
 753     |;
 754     my $sth = $dbh->prepare($query);
 755     $sth->execute($biblionumber);
 756     my $subscriptionsnumber = $sth->fetchrow;
 757     return $subscriptionsnumber;
 758 }
 759
 760
 761 =head2 ModSubscriptionHistory
 762
 763 =over 4
 764
 765 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
 766
 767 this function modify the history of a subscription. Put your new values on input arg.
 768
 769 =back
 770
 771 =cut
 772 sub ModSubscriptionHistory {
 773     my ($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote)=@_;
 774     my $dbh=C4::Context->dbh;
 775     my $query = qq(
 776         UPDATE subscriptionhistory
 777         SET histstartdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
 778         WHERE subscriptionid=?
 779     );
 780     my $sth = $dbh->prepare($query);
 781     $recievedlist =~ s/^,//g;
 782     $missinglist =~ s/^,//g;
 783     $opacnote =~ s/^,//g;
 784     $sth->execute($histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote,$subscriptionid);
 785 }
 786
 787 =head2 ModSerialStatus
 788
 789 =over 4
 790
 791 ModSerialStatus($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes)
 792
 793 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
 794 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
 795
 796 =back
 797
 798 =cut
 799 sub ModSerialStatus {
 800     my ($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes)=@_;
 801     # 1st, get previous status :
 802     my $dbh = C4::Context->dbh;
 803     my $query = qq|
 804         SELECT subscriptionid,status
 805         FROM   serial
 806         WHERE  serialid=?
 807     |;
 808     my $sth = $dbh->prepare($query);
 809     $sth->execute($serialid);
 810     my ($subscriptionid,$oldstatus) = $sth->fetchrow;
 811     # change status & update subscriptionhistory
 812     if ($status eq 6){
 813         DelIssue($serialseq, $subscriptionid)
 814     } else {
 815         my $query = qq(
 816             UPDATE serial
 817             SET    serialseq=?,publisheddate=?,planneddate=?,status=?,notes=?
 818             WHERE  serialid = ?
 819         );
 820         $sth = $dbh->prepare($query);
 821         $sth->execute($serialseq,$publisheddate,$planneddate,$status,$notes,$serialid);
 822         my $query = qq(
 823             SELECT missinglist,recievedlist
 824             FROM   subscriptionhistory
 825             WHERE  subscriptionid=?
 826         );
 827         $sth = $dbh->prepare($query);
 828         $sth->execute($subscriptionid);
 829         my ($missinglist,$recievedlist) = $sth->fetchrow;
 830         if ($status eq 2) {
 831             $recievedlist .= ",$serialseq";
 832         }
 833         $missinglist .= ",$serialseq" if ($status eq 4) ;
 834         $missinglist .= ",not issued $serialseq" if ($status eq 5);
 835         my $query = qq(
 836             UPDATE subscriptionhistory
 837             SET    recievedlist=?, missinglist=?
 838             WHERE  subscriptionid=?
 839         );
 840         $sth=$dbh->prepare($query);
 841         $sth->execute($recievedlist,$missinglist,$subscriptionid);
 842     }
 843     # create new waited entry if needed (ie : was a "waited" and has changed)
 844     if ($oldstatus eq 1 && $status ne 1) {
 845         my $query = qq(
 846             SELECT *
 847             FROM   subscription
 848             WHERE  subscriptionid = ?
 849         );
 850         $sth = $dbh->prepare($query);
 851         $sth->execute($subscriptionid);
 852         my $val = $sth->fetchrow_hashref;
 853         # next issue number
 854         my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3) = GetNextSeq($val);
 855         # next date (calculated from actual date & frequency parameters)
 856         my $nextpublisheddate = GetNextDate($publisheddate,$val);
 857         NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextpublisheddate,0);
 858         my $query = qq|
 859             UPDATE subscription
 860             SET    lastvalue1=?, lastvalue2=?, lastvalue3=?,
 861                    innerloop1=?, innerloop2=?, innerloop3=?
 862             WHERE  subscriptionid = ?
 863         |;
 864         $sth = $dbh->prepare($query);
 865         $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3,$subscriptionid);
 866     }
 867 }
 868
 869 =head2 ModSubscription
 870
 871 =over 4
 872
 873 this function modify a subscription. Put all new values on input args.
 874
 875 =back
 876
 877 =cut
 878 sub ModSubscription {
 879     my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
 880         $periodicity,$dow,$numberlength,$weeklength,$monthlength,
 881         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
 882         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
 883         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
 884         $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid)= @_;
 885     my $dbh = C4::Context->dbh;
 886     my $query = qq|
 887         UPDATE subscription
 888         SET     librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
 889                 periodicity=?,dow=?,numberlength=?,weeklength=?,monthlength=?,
 890                 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
 891                 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
 892                 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
 893                 numberingmethod=?, status=?, biblionumber=?, notes=?, letter=?
 894         WHERE subscriptionid = ?
 895     |;
 896     my $sth=$dbh->prepare($query);
 897     $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
 898         $periodicity,$dow,$numberlength,$weeklength,$monthlength,
 899         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
 900         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
 901         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
 902         $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid);
 903     $sth->finish;
 904 }
 905
 906
 907 =head2 NewSubscription
 908
 909 =over 4
 910
 911 $subscriptionid = &NewSubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
 912     $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
 913     $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
 914     $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
 915     $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
 916     $numberingmethod, $status, $notes)
 917
 918 Create a new subscription with value given on input args.
 919
 920 return :
 921 the id of this new subscription
 922
 923 =back
 924
 925 =cut
 926 sub NewSubscription {
 927     my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
 928         $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
 929         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
 930         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
 931         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
 932         $numberingmethod, $status, $notes) = @_;
 933     my $dbh = C4::Context->dbh;
 934 #save subscription (insert into database)
 935     my $query = qq|
 936         INSERT INTO subscription
 937             (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
 938             startdate,periodicity,dow,numberlength,weeklength,monthlength,
 939             add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
 940             add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
 941             add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
 942             numberingmethod, status, notes)
 943         VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
 944         |;
 945     my $sth=$dbh->prepare($query);
 946     $sth->execute(
 947         $auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
 948         format_date_in_iso($startdate),$periodicity,$dow,$numberlength,$weeklength,$monthlength,
 949         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
 950         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
 951         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
 952         $numberingmethod, $status, $notes);
 953
 954 #then create the 1st waited number
 955     my $subscriptionid = $dbh->{'mysql_insertid'};
 956     my $query = qq(
 957         INSERT INTO subscriptionhistory
 958             (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote)
 959         VALUES (?,?,?,?,?,?,?,?)
 960         );
 961     $sth = $dbh->prepare($query);
 962     $sth->execute($biblionumber, $subscriptionid, format_date_in_iso($startdate), 0, "", "", "", $notes);
 963
 964 # reread subscription to get a hash (for calculation of the 1st issue number)
 965     my $query = qq(
 966         SELECT *
 967         FROM   subscription
 968         WHERE  subscriptionid = ?
 969     );
 970     $sth = $dbh->prepare($query);
 971     $sth->execute($subscriptionid);
 972     my $val = $sth->fetchrow_hashref;
 973
 974 # calculate issue number
 975     my $serialseq = GetSeq($val);
 976     my $query = qq|
 977         INSERT INTO serial
 978             (serialseq,subscriptionid,biblionumber,status, planneddate)
 979         VALUES (?,?,?,?,?)
 980     |;
 981     $sth = $dbh->prepare($query);
 982     $sth->execute($serialseq, $subscriptionid, $val->{'biblionumber'}, 1, format_date_in_iso($startdate));
 983     return $subscriptionid;
 984 }
 985
 986
 987 =head2 ReNewSubscription
 988
 989 =over 4
 990
 991 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
 992
 993 this function renew a subscription with values given on input args.
 994
 995 =back
 996
 997 =cut
 998 sub ReNewSubscription {
 999     my ($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note) = @_;
1000     my $dbh = C4::Context->dbh;
1001     my $subscription = GetSubscription($subscriptionid);
1002     my $query = qq|
1003         SELECT *
1004         FROM   biblio,biblioitems
1005         WHERE  biblio.biblionumber=biblioitems.biblionumber
1006         AND    biblio.biblionumber=?
1007     |;
1008     my $sth = $dbh->prepare($query);
1009     $sth->execute($subscription->{biblionumber});
1010     my $biblio = $sth->fetchrow_hashref;
1011     NewSuggestion($user,$subscription->{bibliotitle},$biblio->{author},$biblio->{publishercode},$biblio->{note},'','','','','',$subscription->{biblionumber});
1012     # renew subscription
1013     my $query = qq|
1014         UPDATE subscription
1015         SET    startdate=?,numberlength=?,weeklength=?,monthlength=?
1016         WHERE  subscriptionid=?
1017     |;
1018     $sth=$dbh->prepare($query);
1019     $sth->execute(format_date_in_iso($startdate),$numberlength,$weeklength,$monthlength, $subscriptionid);
1020 }
1021
1022
1023 =head2 NewIssue
1024
1025 =over 4
1026
1027 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate)
1028
1029 Create a new issue stored on the database.
1030 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1031
1032 =back
1033
1034 =cut
1035 sub NewIssue {
1036     my ($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate) = @_;
1037     my $dbh = C4::Context->dbh;
1038     my $query = qq|
1039         INSERT INTO serial
1040             (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate)
1041         VALUES (?,?,?,?,?,?)
1042     |;
1043     my $sth = $dbh->prepare($query);
1044     $sth->execute($serialseq,$subscriptionid,$biblionumber,$status,$publisheddate, $planneddate);
1045     my $query = qq|
1046         SELECT missinglist,recievedlist
1047         FROM   subscriptionhistory
1048         WHERE  subscriptionid=?
1049     |;
1050     $sth = $dbh->prepare($query);
1051     $sth->execute($subscriptionid);
1052     my ($missinglist,$recievedlist) = $sth->fetchrow;
1053     if ($status eq 2) {
1054         $recievedlist .= ",$serialseq";
1055     }
1056     if ($status eq 4) {
1057         $missinglist .= ",$serialseq";
1058     }
1059     my $query = qq|
1060         UPDATE subscriptionhistory
1061         SET    recievedlist=?, missinglist=?
1062         WHERE  subscriptionid=?
1063     |;
1064     $sth=$dbh->prepare($query);
1065     $sth->execute($recievedlist,$missinglist,$subscriptionid);
1066 }
1067
1068 =head2 ItemizeSerials
1069
1070 =over 4
1071
1072 ItemizeSerials($serialid, $info);
1073 $info is a hashref containing  barcode branch, itemcallnumber, status, location
1074 $serialid the serialid
1075 return :
1076 1 if the itemize is a succes.
1077 0 and @error else. @error containts the list of errors found.
1078
1079 =back
1080
1081 =cut
1082 sub ItemizeSerials {
1083     my ($serialid, $info) =@_;
1084     my $dbh= C4::Context->dbh;
1085     my $query = qq|
1086         SELECT *
1087         FROM   serial
1088         WHERE  serialid=?
1089     |;
1090     my $sth=$dbh->prepare($query);
1091     $sth->execute($serialid);
1092     my $data=$sth->fetchrow_hashref;
1093     my $bibid=MARCfind_MARCbibid_from_oldbiblionumber($dbh,$data->{biblionumber});
1094     my $fwk=MARCfind_frameworkcode($dbh,$bibid);
1095     if ($info->{barcode}){
1096         my @errors;
1097         my $exists = itemdata($info->{'barcode'});
1098         push @errors,"barcode_not_unique" if($exists);
1099         unless ($exists){
1100             my $marcrecord = MARC::Record->new();
1101             my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.barcode",$fwk);
1102             my $newField = MARC::Field->new(
1103                 "$tag",'','',
1104                 "$subfield" => $info->{barcode}
1105             );
1106             $marcrecord->insert_fields_ordered($newField);
1107             if ($info->{branch}){
1108                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.homebranch",$fwk);
1109                 #warn "items.homebranch : $tag , $subfield";
1110                 if ($marcrecord->field($tag)) {
1111                     $marcrecord->field($tag)->add_subfields("$subfield" => $info->{branch})
1112                 } else {
1113                     my $newField = MARC::Field->new(
1114                         "$tag",'','',
1115                         "$subfield" => $info->{branch}
1116                     );
1117                     $marcrecord->insert_fields_ordered($newField);
1118                 }
1119                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.holdingbranch",$fwk);
1120                 #warn "items.holdingbranch : $tag , $subfield";
1121                 if ($marcrecord->field($tag)) {
1122                     $marcrecord->field($tag)->add_subfields("$subfield" => $info->{branch})
1123                 } else {
1124                     my $newField = MARC::Field->new(
1125                         "$tag",'','',
1126                         "$subfield" => $info->{branch}
1127                     );
1128                     $marcrecord->insert_fields_ordered($newField);
1129                 }
1130             }
1131             if ($info->{itemcallnumber}){
1132                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.itemcallnumber",$fwk);
1133                 #warn "items.itemcallnumber : $tag , $subfield";
1134                 if ($marcrecord->field($tag)) {
1135                     $marcrecord->field($tag)->add_subfields("$subfield" => $info->{itemcallnumber})
1136                 } else {
1137                     my $newField = MARC::Field->new(
1138                         "$tag",'','',
1139                         "$subfield" => $info->{itemcallnumber}
1140                     );
1141                     $marcrecord->insert_fields_ordered($newField);
1142                 }
1143             }
1144             if ($info->{notes}){
1145                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.itemnotes",$fwk);
1146                 # warn "items.itemnotes : $tag , $subfield";
1147                 if ($marcrecord->field($tag)) {
1148                     $marcrecord->field($tag)->add_subfields("$subfield" => $info->{notes})
1149                 } else {
1150                     my $newField = MARC::Field->new(
1151                     "$tag",'','',
1152                     "$subfield" => $info->{notes}
1153                 );
1154                     $marcrecord->insert_fields_ordered($newField);
1155                 }
1156             }
1157             if ($info->{location}){
1158                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.location",$fwk);
1159                 # warn "items.location : $tag , $subfield";
1160                 if ($marcrecord->field($tag)) {
1161                     $marcrecord->field($tag)->add_subfields("$subfield" => $info->{location})
1162                 } else {
1163                     my $newField = MARC::Field->new(
1164                         "$tag",'','',
1165                         "$subfield" => $info->{location}
1166                     );
1167                     $marcrecord->insert_fields_ordered($newField);
1168                 }
1169             }
1170             if ($info->{status}){
1171                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.notforloan",$fwk);
1172                 # warn "items.notforloan : $tag , $subfield";
1173                 if ($marcrecord->field($tag)) {
1174                 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{status})
1175                 } else {
1176                     my $newField = MARC::Field->new(
1177                         "$tag",'','',
1178                         "$subfield" => $info->{status}
1179                     );
1180                     $marcrecord->insert_fields_ordered($newField);
1181                 }
1182             }
1183             NEWnewitem($dbh,$marcrecord,$bibid);
1184             return 1;
1185         }
1186         return (0,@errors);
1187     }
1188 }
1189
1190 =head2 HasSubscriptionExpired
1191
1192 =over 4
1193
1194 1 or 0 = HasSubscriptionExpired($subscriptionid)
1195
1196 the subscription has expired when the next issue to arrive is out of subscription limit.
1197
1198 return :
1199 1 if true, 0 if false.
1200
1201 =back
1202
1203 =cut
1204 sub HasSubscriptionExpired {
1205     my ($subscriptionid) = @_;
1206     my $dbh = C4::Context->dbh;
1207     my $subscription = GetSubscription($subscriptionid);
1208     # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1209     if ($subscription->{numberlength}) {
1210         my $query = qq|
1211             SELECT count(*)
1212             FROM   serial
1213             WHERE  subscriptionid=? AND planneddate>=?
1214         |;
1215         my $sth = $dbh->prepare($query);
1216         $sth->execute($subscriptionid,$subscription->{startdate});
1217         my $res = $sth->fetchrow;
1218         if ($subscription->{numberlength}>=$res) {
1219             return 0;
1220         } else {
1221             return 1;
1222         }
1223     } else {
1224         #a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
1225         my $query = qq|
1226             SELECT max(planneddate)
1227             FROM   serial
1228             WHERE  subscriptionid=?
1229         |;
1230         my $sth = $dbh->prepare($query);
1231         $sth->execute($subscriptionid);
1232         my $res = ParseDate(format_date_in_iso($sth->fetchrow));
1233         my $endofsubscriptiondate;
1234         $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
1235         $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
1236         return 1 if ($res >= $endofsubscriptiondate);
1237         return 0;
1238     }
1239 }
1240
1241 =head2 SetDistributedto
1242
1243 =over 4
1244
1245 SetDistributedto($distributedto,$subscriptionid);
1246 This function update the value of distributedto for a subscription given on input arg.
1247
1248 =back
1249
1250 =cut
1251 sub SetDistributedto {
1252     my ($distributedto,$subscriptionid) = @_;
1253     my $dbh = C4::Context->dbh;
1254     my $query = qq|
1255         UPDATE subscription
1256         SET    distributedto=?
1257         WHERE  subscriptionid=?
1258     |;
1259     my $sth = $dbh->prepare($query);
1260     $sth->execute($distributedto,$subscriptionid);
1261 }
1262
1263 =head2 DelSubscription
1264
1265 =over 4
1266
1267 DelSubscription($subscriptionid)
1268 this function delete the subscription which has $subscriptionid as id.
1269
1270 =back
1271
1272 =cut
1273 sub DelSubscription {
1274     my ($subscriptionid) = @_;
1275     my $dbh = C4::Context->dbh;
1276     $subscriptionid=$dbh->quote($subscriptionid);
1277     $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1278     $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1279     $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1280 }
1281
1282 =head2 DelIssue
1283
1284 =over 4
1285
1286 DelIssue($serialseq,$subscriptionid)
1287 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1288
1289 =back
1290
1291 =cut
1292 sub DelIssue {
1293     my ($serialseq,$subscriptionid) = @_;
1294     my $dbh = C4::Context->dbh;
1295     my $query = qq|
1296         DELETE FROM serial
1297         WHERE       serialseq= ?
1298         AND         subscriptionid= ?
1299     |;
1300     my $sth = $dbh->prepare($query);
1301     $sth->execute($serialseq,$subscriptionid);
1302 }
1303
1304 END { }       # module clean-up code here (global destructor)
1305
1306 1;