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 =over 2
  52
  53 =cut
  54 @ISA = qw(Exporter);
  55 @EXPORT = qw(
  56     &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions &GetSubscription
  57     &GetSubscriptionFromBiblionumber &GetSubscriptionListFromBiblionumber
  58     &GetFullSubscriptionListFromBiblionumber
  59     &ModSubscriptionHistory &NewIssue &ItemizeSerials
  60     &GetSerials &GetLatestSerials &ModSerialStatus
  61     &HasSubscriptionExpired &SubscriptionExpirationDate &SubscriptionReNew
  62     &GetSupplierListWithLateIssues &GetLateIssues
  63     );
  64
  65 =item GetSupplierListWithLateIssues
  66
  67 %supplierlist = &GetSupplierListWithLateIssues
  68
  69  this function get all supplier with late issue.
  70
  71 return :
  72 the supplierlist into an hash.
  73 =cut
  74 sub GetSupplierListWithLateIssues {
  75     my $dbh = C4::Context->dbh;
  76     my $query = qq|
  77         SELECT DISTINCT id, name
  78         FROM            subscription, serial
  79         LEFT JOIN       aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
  80         WHERE           subscription.subscriptionid = serial.subscriptionid
  81         AND             (planneddate < now() OR serial.STATUS = 3)
  82     |;
  83     my $sth = $dbh->prepare($query);
  84     $sth->execute;
  85     my %supplierlist;
  86     while (my ($id,$name) = $sth->fetchrow) {
  87         $supplierlist{$id} = $name;
  88     }
  89     return %supplierlist;
  90 }
  91
  92 =item GetLateIssues
  93
  94 @issuelist = &GetLateIssues($supplierid)
  95
  96 this function select late issues on database
  97
  98 return :
  99 the issuelist into an table.
 100
 101 =cut
 102
 103 sub GetLateIssues {
 104     my ($supplierid) = @_;
 105     my $dbh = C4::Context->dbh;
 106     my $sth;
 107     if ($supplierid) {
 108         my $query = qq |
 109             SELECT     name,title,planneddate,serialseq,serial.subscriptionid
 110             FROM       subscription, serial, biblio
 111             LEFT JOIN  aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
 112             WHERE      subscription.subscriptionid = serial.subscriptionid
 113             AND        ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
 114             AND        subscription.aqbooksellerid=$supplierid
 115             AND        biblio.biblionumber = subscription.biblionumber
 116             ORDER BY   title
 117         |;
 118         $sth = $dbh->prepare($query);
 119     } else {
 120         my $query = qq|
 121             SELECT     name,title,planneddate,serialseq,serial.subscriptionid
 122             FROM       subscription, serial, biblio
 123             LEFT JOIN  aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
 124             WHERE      subscription.subscriptionid = serial.subscriptionid
 125             AND        ((planneddate < now() AND serial.STATUS <=3) OR serial.STATUS = 3)
 126             AND        biblio.biblionumber = subscription.biblionumber
 127             ORDER BY   title
 128         |;
 129         $sth = $dbh->prepare($query);
 130     }
 131     $sth->execute;
 132     my @issuelist;
 133     my $last_title;
 134     my $odd=0;
 135     while (my $line = $sth->fetchrow_hashref) {
 136         $odd++ unless $line->{title} eq $last_title;
 137         $line->{title} = "" if $line->{title} eq $last_title;
 138         $last_title = $line->{title} if ($line->{title});
 139         $line->{planneddate} = format_date($line->{planneddate});
 140         $line->{'odd'} = 1 if $odd %2 ;
 141         push @issuelist,$line;
 142     }
 143     return @issuelist;
 144 }
 145
 146 =item NewSubscription
 147
 148 $subscriptionid = &NewSubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
 149     $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
 150     $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
 151     $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
 152     $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
 153     $numberingmethod, $status, $notes)
 154
 155 Create a new subscription.
 156
 157 return :
 158 the id of this new subscription
 159
 160 =cut
 161 sub NewSubscription {
 162     my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
 163     $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
 164     $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
 165     $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
 166     $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
 167     $numberingmethod, $status, $notes) = @_;
 168     my $dbh = C4::Context->dbh;
 169     #save subscription
 170     my $query = qq|
 171         INSERT INTO subscription
 172             (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
 173             startdate,periodicity,dow,numberlength,weeklength,monthlength,
 174             add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
 175             add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
 176             add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
 177             numberingmethod, status, notes)
 178         VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
 179         |;
 180     my $sth=$dbh->prepare($query);
 181     $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
 182     format_date_in_iso($startdate),$periodicity,$dow,$numberlength,$weeklength,$monthlength,
 183     $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
 184     $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
 185     $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
 186     $numberingmethod, $status, $notes);
 187
 188     #then create the 1st waited number
 189     my $subscriptionid = $dbh->{'mysql_insertid'};
 190     my $query = qq(
 191         INSERT INTO subscriptionhistory
 192             (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote)
 193         VALUES (?,?,?,?,?,?,?,?)
 194         );
 195     $sth = $dbh->prepare($query);
 196     $sth->execute($biblionumber, $subscriptionid, format_date_in_iso($startdate), 0, "", "", "", $notes);
 197     # reread subscription to get a hash (for calculation of the 1st issue number)
 198     my $query = qq(
 199         SELECT *
 200         FROM   subscription
 201         WHERE  subscriptionid = ?
 202     );
 203     $sth = $dbh->prepare($query);
 204     $sth->execute($subscriptionid);
 205     my $val = $sth->fetchrow_hashref;
 206
 207     # calculate issue number
 208     my $serialseq = GetSeq($val);
 209     my $query = qq(
 210         INSERT INTO serial
 211             (serialseq,subscriptionid,biblionumber,status, planneddate)
 212         VALUES (?,?,?,?,?)
 213     );
 214     $sth = $dbh->prepare($query);
 215     $sth->execute($serialseq, $subscriptionid, $val->{'biblionumber'}, 1, format_date_in_iso($startdate));
 216     return $subscriptionid;
 217 }
 218 =item GetSubscription
 219     $subs = GetSubscription($subscriptionid)
 220     this function get the subscription which have $subscriptionid as id.
 221 return :
 222     a ref to a hash. This hash containts
 223         subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
 224 =cut
 225 sub GetSubscription {
 226     my ($subscriptionid) = @_;
 227     my $dbh = C4::Context->dbh;
 228     my $query =qq(
 229         SELECT  subscription.*,
 230                 subscriptionhistory.*,
 231                 aqbudget.bookfundid,
 232                 aqbooksellers.name AS aqbooksellername,
 233                 biblio.title AS bibliotitle
 234        FROM subscription
 235        LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
 236        LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
 237        LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
 238        LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
 239        WHERE subscription.subscriptionid = ?
 240     );
 241     my $sth = $dbh->prepare($query);
 242     $sth->execute($subscriptionid);
 243     my $subs = $sth->fetchrow_hashref;
 244     return $subs;
 245 }
 246 =item GetSubscriptionFromBiblionumber
 247     $subscriptionsnumber = GetSubscriptionFromBiblionumber($biblionumber)
 248 return :
 249     the number of subscription with biblionumber given on input arg.
 250 =cut
 251 sub GetSubscriptionFromBiblionumber {
 252     my ($biblionumber) = @_;
 253     my $dbh = C4::Context->dbh;
 254     my $query = qq(
 255         SELECT count(*)
 256         FROM   subscription
 257         WHERE  biblionumber=?
 258     );
 259     my $sth = $dbh->prepare($query);
 260     $sth->execute($biblionumber);
 261     my $subscriptionsnumber = $sth->fetchrow;
 262     return $subscriptionsnumber;
 263 }
 264 =item GetSubscriptionListFromBiblionumber
 265     \@res = GetSubscriptionListFromBiblionumber($biblionumber)
 266     TODO !
 267 =cut
 268 sub GetSubscriptionListFromBiblionumber {
 269     my ($biblionumber) = @_;
 270     my $dbh = C4::Context->dbh;
 271     my $query = qq(
 272         SELECT subscription.*,
 273                subscriptionhistory.*,
 274                aqbudget.bookfundid,
 275                aqbooksellers.name AS aqbooksellername,
 276                biblio.title AS bibliotitle
 277        FROM subscription
 278        LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
 279        LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
 280        LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
 281        LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
 282        WHERE subscription.biblionumber = ?
 283     );
 284     my $sth = $dbh->prepare($query);
 285     $sth->execute($biblionumber);
 286     my @res;
 287     while (my $subs = $sth->fetchrow_hashref) {
 288         $subs->{startdate} = format_date($subs->{startdate});
 289         $subs->{histstartdate} = format_date($subs->{histstartdate});
 290         $subs->{opacnote} =~ s/\n/\<br\/\>/g;
 291         $subs->{missinglist} =~ s/\n/\<br\/\>/g;
 292         $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
 293         $subs->{"periodicity".$subs->{periodicity}} = 1;
 294         $subs->{"status".$subs->{'status'}} = 1;
 295         if ($subs->{enddate} eq '0000-00-00') {
 296             $subs->{enddate}='';
 297         } else {
 298             $subs->{enddate} = format_date($subs->{enddate});
 299         }
 300         push @res,$subs;
 301     }
 302     return \@res;
 303 }
 304 =item GetFullSubscriptionListFromBiblionumber
 305     GetFullSubscriptionListFromBiblionumber($biblionumber)
 306 =cut
 307 sub GetFullSubscriptionListFromBiblionumber {
 308     my ($biblionumber) = @_;
 309     my $dbh = C4::Context->dbh;
 310     my $query=qq(SELECT serial.serialseq,
 311                         serial.planneddate,
 312                         serial.publisheddate,
 313                         serial.status,
 314                         serial.notes,
 315                         year(serial.publisheddate) as year,
 316                         aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
 317                         biblio.title as bibliotitle
 318                 FROM serial
 319                 LEFT JOIN subscription ON
 320                     (serial.subscriptionid=subscription.subscriptionid AND subscription.biblionumber=serial.biblionumber)
 321                 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
 322                 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
 323                 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
 324                 WHERE subscription.biblionumber = ?
 325                 ORDER BY year,serial.publisheddate,serial.subscriptionid,serial.planneddate
 326     );
 327
 328     my $sth = $dbh->prepare($query);
 329     $sth->execute($biblionumber);
 330     my @res;
 331     my $year;
 332     my $startdate;
 333     my $aqbooksellername;
 334     my $bibliotitle;
 335     my @loopissues;
 336     my $first;
 337     my $previousnote="";
 338     while (my $subs = $sth->fetchrow_hashref) {
 339         ### BUG To FIX: When there is no published date, will create many null ids!!!
 340
 341         if ($year and ($year==$subs->{year})){
 342             if ($first eq 1){$first=0;}
 343             my $temp=$res[scalar(@res)-1]->{'serials'};
 344             push @$temp,
 345                 {'publisheddate' =>format_date($subs->{'publisheddate'}),
 346                 'planneddate' => format_date($subs->{'planneddate'}),
 347                 'serialseq' => $subs->{'serialseq'},
 348                 "status".$subs->{'status'} => 1,
 349                 'notes' => $subs->{'notes'} eq $previousnote?"":$subs->{notes},
 350                 };
 351         } else {
 352             $first=1 if (not $year);
 353             $year= $subs->{'year'};
 354             $startdate= format_date($subs->{'startdate'});
 355             $aqbooksellername= $subs->{'aqbooksellername'};
 356             $bibliotitle= $subs->{'bibliotitle'};
 357             my @temp;
 358             push @temp,
 359                 {'publisheddate' =>format_date($subs->{'publisheddate'}),
 360                             'planneddate' => format_date($subs->{'planneddate'}),
 361                 'serialseq' => $subs->{'serialseq'},
 362                 "status".$subs->{'status'} => 1,
 363                 'notes' => $subs->{'notes'} eq $previousnote?"":$subs->{notes},
 364                 };
 365
 366             push @res,{
 367                 'year'=>$year,
 368                 'startdate'=>$startdate,
 369                 'aqbooksellername'=>$aqbooksellername,
 370                 'bibliotitle'=>$bibliotitle,
 371                 'serials'=>\@temp,
 372                 'first'=>$first
 373             };
 374         }
 375         $previousnote=$subs->{notes};
 376     }
 377     return \@res;
 378 }
 379 =item ModSubscription
 380     this function modify a subscription.
 381 =cut
 382 sub ModSubscription {
 383     my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
 384         $periodicity,$dow,$numberlength,$weeklength,$monthlength,
 385         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
 386         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
 387         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
 388         $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid)= @_;
 389     my $dbh = C4::Context->dbh;
 390     my $sth=$dbh->prepare("update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
 391        periodicity=?,dow=?,numberlength=?,weeklength=?,monthlength=?,
 392       add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
 393       add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
 394       add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
 395       numberingmethod=?, status=?, biblionumber=?, notes=?, letter=? where subscriptionid = ?");
 396     $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
 397         $periodicity,$dow,$numberlength,$weeklength,$monthlength,
 398         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
 399         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
 400         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
 401         $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid);
 402     $sth->finish;
 403 }
 404 =item DelSubscription
 405     DelSubscription($subscriptionid)
 406     this function delete the subscription which have $subscriptionid as id.
 407 =cut
 408 sub DelSubscription {
 409     my ($subscriptionid) = @_;
 410     my $dbh = C4::Context->dbh;
 411     $subscriptionid=$dbh->quote($subscriptionid);
 412     $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
 413     $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
 414     $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
 415 }
 416 =item GetSubscriptions
 417    @results = GetSubscriptions($title,$ISSN,$biblionumber);
 418     this function get all subscriptions which have $title,$ISSN,$biblionumber.
 419 return:
 420     a table of ref to hash. Each hash containt the subscription.
 421 =cut
 422 sub GetSubscriptions {
 423     my ($title,$ISSN,$biblionumber) = @_;
 424     return unless $title or $ISSN or $biblionumber;
 425     my $dbh = C4::Context->dbh;
 426     my $sth;
 427     if ($biblionumber) {
 428         my $query = qq(
 429             SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber
 430             FROM   subscription,biblio,biblioitems
 431             WHERE   biblio.biblionumber = biblioitems.biblionumber
 432                 AND biblio.biblionumber = subscription.biblionumber
 433                 AND biblio.biblionumber=?
 434             ORDER BY title
 435         );
 436     $sth = $dbh->prepare($query);
 437     $sth->execute($biblionumber);
 438     } else {
 439         if ($ISSN and $title){
 440             my $query = qq(
 441                 SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber
 442                 FROM   subscription,biblio,biblioitems
 443                 WHERE  biblio.biblionumber = biblioitems.biblionumber
 444                     AND biblio.biblionumber= subscription.biblionumber
 445                     AND (biblio.title LIKE ? or biblioitems.issn = ?)
 446                 ORDER BY title
 447             );
 448             $sth = $dbh->prepare($query);
 449             $sth->execute("%$title%",$ISSN);
 450         }
 451         else{
 452             if ($ISSN){
 453                 my $query = qq(
 454                     SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber
 455                     FROM   subscription,biblio,biblioitems
 456                     WHERE  biblio.biblionumber = biblioitems.biblionumber
 457                         AND biblio.biblionumber=subscription.biblionumber
 458                         AND biblioitems.issn = ?
 459                     ORDER BY title
 460                 );
 461                 $sth = $dbh->prepare($query);
 462                 $sth->execute($ISSN);
 463             } else {
 464                 my $query = qq(
 465                     SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber
 466                     FROM   subscription,biblio,biblioitems
 467                     WHERE  biblio.biblionumber = biblioitems.biblionumber
 468                         AND biblio.biblionumber=subscription.biblionumber
 469                         AND biblio.title LIKE ?
 470                     ORDER BY title
 471                 );
 472                 $sth = $dbh->prepare($query);
 473                 $sth->execute("%$title%");
 474             }
 475         }
 476     }
 477     my @results;
 478     my $previoustitle="";
 479     my $odd=1;
 480     while (my $line = $sth->fetchrow_hashref) {
 481         if ($previoustitle eq $line->{title}) {
 482             $line->{title}="";
 483             $line->{issn}="";
 484             $line->{toggle} = 1 if $odd==1;
 485         } else {
 486             $previoustitle=$line->{title};
 487             $odd=-$odd;
 488             $line->{toggle} = 1 if $odd==1;
 489         }
 490         push @results, $line;
 491     }
 492  return @results;
 493 }
 494 =item ModSubscriptionHistory
 495     ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
 496 this function modify the history of the subscription given on input args.
 497 =cut
 498 sub ModSubscriptionHistory {
 499     my ($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote)=@_;
 500     my $dbh=C4::Context->dbh;
 501     my $query = qq(
 502         UPDATE subscriptionhistory
 503         SET histstartdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
 504         WHERE subscriptionid=?
 505     );
 506     my $sth = $dbh->prepare($query);
 507     $recievedlist =~ s/^,//g;
 508     $missinglist =~ s/^,//g;
 509     $opacnote =~ s/^,//g;
 510     $sth->execute($histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote,$subscriptionid);
 511 }
 512 =item GetSerials
 513    ($totalissues,@serials) = GetSerials($subscriptionid);
 514  this function get every serial not arrived for a given subscription
 515  as well as the number of issues registered in the database (all types)
 516  this number is used to see if a subscription can be deleted (=it must have only 1 issue)
 517 =cut
 518 sub GetSerials {
 519     my ($subscriptionid) = @_;
 520     my $dbh = C4::Context->dbh;
 521     # OK, now add the last 5 issues arrives/missing
 522     my $query = qq(
 523         SELECT   serialid,serialseq, status, planneddate,notes
 524         FROM     serial
 525         WHERE    subscriptionid = ?
 526         AND      (status in (2,4,5))
 527         ORDER BY serialid DESC
 528     );
 529     my $sth=$dbh->prepare($query);
 530     $sth->execute($subscriptionid);
 531     my $counter=0;
 532     my @serials;
 533     while((my $line = $sth->fetchrow_hashref) && $counter <5) {
 534         $counter++;
 535         $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
 536         $line->{"planneddate"} = format_date($line->{"planneddate"});
 537         push @serials,$line;
 538     }
 539     # status = 2 is "arrived"
 540     my $query = qq(
 541         SELECT serialid,serialseq, status, publisheddate, planneddate,notes
 542         FROM   serial
 543         WHERE  subscriptionid = ? AND status NOT IN (2,4,5)
 544     );
 545     my $sth=$dbh->prepare($query);
 546     $sth->execute($subscriptionid);
 547     while(my $line = $sth->fetchrow_hashref) {
 548     $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
 549     $line->{"publisheddate"} = format_date($line->{"publisheddate"});
 550     $line->{"planneddate"} = format_date($line->{"planneddate"});
 551     push @serials,$line;
 552  }
 553     my $query = qq(
 554         SELECT count(*)
 555         FROM   serial
 556         WHERE  subscriptionid=?
 557     );
 558     $sth=$dbh->prepare($query);
 559     $sth->execute($subscriptionid);
 560     my ($totalissues) = $sth->fetchrow;
 561     return ($totalissues,@serials);
 562 }
 563 =item GetLatestSerials
 564     \@serials = GetLatestSerials($subscriptionid,$limit)
 565     get the $limit's latest serials arrived or missing for a given subscription
 566 return :
 567     a ref to a table which it containts all of the latest serials.
 568 =cut
 569 sub GetLatestSerials{
 570     my ($subscriptionid,$limit) = @_;
 571     my $dbh = C4::Context->dbh;
 572     # status = 2 is "arrived"
 573     my $strsth=qq(
 574         SELECT serialid,serialseq, status, planneddate
 575         FROM   serial
 576         WHERE subscriptionid = ?
 577         AND   (status =2 or status=4)
 578         ORDER BY planneddate DESC LIMIT 0,$limit
 579     );
 580     my $sth=$dbh->prepare($strsth);
 581     $sth->execute($subscriptionid);
 582     my @serials;
 583     while(my $line = $sth->fetchrow_hashref) {
 584         $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
 585         $line->{"planneddate"} = format_date($line->{"planneddate"});
 586         push @serials,$line;
 587     }
 588     my $query = qq(
 589         SELECT count(*)
 590         FROM   serial
 591         WHERE  subscriptionid=?
 592     );
 593     $sth=$dbh->prepare($query);
 594     $sth->execute($subscriptionid);
 595     my ($totalissues) = $sth->fetchrow;
 596     return \@serials;
 597 }
 598 =item ModSerialStatus
 599     ModSerialStatus($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes)
 600
 601     this function modify the serial status
 602
 603 =cut
 604 sub ModSerialStatus {
 605     my ($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes)=@_;
 606     #  warn "($serialid,$serialseq,$planneddate,$status)";
 607     # 1st, get previous status : if we change from "waited" to something else, then we will have to create a new "waited" entry
 608     my $dbh = C4::Context->dbh;
 609     my $query = qq(
 610         SELECT subscriptionid,status
 611         FROM   serial
 612         WHERE  serialid=?
 613     );
 614     my $sth = $dbh->prepare($query);
 615     $sth->execute($serialid);
 616     my ($subscriptionid,$oldstatus) = $sth->fetchrow;
 617     # change status & update subscriptionhistory
 618     if ($status eq 6){
 619         DelIssue($serialseq, $subscriptionid)
 620     } else {
 621         my $query = qq(
 622             UPDATE serial
 623             SET    serialseq=?,publisheddate=?,planneddate=?,status=?,notes=?
 624             WHERE  serialid = ?
 625         );
 626         $sth = $dbh->prepare($query);
 627         $sth->execute($serialseq,$publisheddate,$planneddate,$status,$notes,$serialid);
 628         my $query = qq(
 629             SELECT missinglist,recievedlist
 630             FROM   subscriptionhistory
 631             WHERE  subscriptionid=?
 632         );
 633         $sth = $dbh->prepare($query);
 634         $sth->execute($subscriptionid);
 635         my ($missinglist,$recievedlist) = $sth->fetchrow;
 636         if ($status eq 2) {
 637             $recievedlist .= ",$serialseq";
 638         }
 639         $missinglist .= ",$serialseq" if ($status eq 4) ;
 640         $missinglist .= ",not issued $serialseq" if ($status eq 5);
 641         $query qq(
 642             UPDATE subscriptionhistory
 643             SET    recievedlist=?, missinglist=?
 644             WHERE  subscriptionid=?
 645         );
 646         $sth=$dbh->prepare($query);
 647         $sth->execute($recievedlist,$missinglist,$subscriptionid);
 648     }
 649     # create new waited entry if needed (ie : was a "waited" and has changed)
 650     if ($oldstatus eq 1 && $status ne 1) {
 651         my $query = qq(
 652             SELECT *
 653             FROM   subscription
 654             WHERE  subscriptionid = ?
 655         );
 656         $sth = $dbh->prepare($query);
 657         $sth->execute($subscriptionid);
 658         my $val = $sth->fetchrow_hashref;
 659         # next issue number
 660         my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3) = GetNextSeq($val);
 661         # next date (calculated from actual date & frequency parameters)
 662         my $nextpublisheddate = GetNextDate($publisheddate,$val);
 663         NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextpublisheddate,0);
 664         my $query = qq|
 665             UPDATE subscription
 666             SET    lastvalue1=?, lastvalue2=?, lastvalue3=?,
 667                    innerloop1=?, innerloop2=?, innerloop3=?
 668             WHERE  subscriptionid = ?
 669         |;
 670         $sth = $dbh->prepare($query);
 671         $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3,$subscriptionid);
 672     }
 673 }
 674 =item NewIssue
 675     NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate)
 676
 677     Create a new issue stored on the database.
 678
 679 =cut
 680 sub NewIssue {
 681     my ($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate) = @_;
 682     my $dbh = C4::Context->dbh;
 683     my $query = qq|
 684         INSERT INTO serial
 685             (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate)
 686         VALUES (?,?,?,?,?,?)
 687     |;
 688     my $sth = $dbh->prepare($query);
 689     $sth->execute($serialseq,$subscriptionid,$biblionumber,$status,$publisheddate, $planneddate);
 690     my $query = qq|
 691         SELECT missinglist,recievedlist
 692         FROM   subscriptionhistory
 693         WHERE  subscriptionid=?
 694     |;
 695     $sth = $dbh->prepare($query);
 696     $sth->execute($subscriptionid);
 697     my ($missinglist,$recievedlist) = $sth->fetchrow;
 698     if ($status eq 2) {
 699         $recievedlist .= ",$serialseq";
 700     }
 701     if ($status eq 4) {
 702         $missinglist .= ",$serialseq";
 703     }
 704     my $query = qq|
 705         UPDATE subscriptionhistory
 706         SET    recievedlist=?, missinglist=?
 707         WHERE  subscriptionid=?
 708     |;
 709     $sth=$dbh->prepare($query);
 710     $sth->execute($recievedlist,$missinglist,$subscriptionid);
 711 }
 712
 713 =item ItemizeSerials
 714
 715   ItemizeSerials($serialid, $info);
 716   $info is a hashref containing  barcode branch, itemcallnumber, status, location
 717   $serialid the serialid
 718 =cut
 719 sub ItemizeSerials {
 720     my ($serialid, $info) =@_;
 721     my $dbh= C4::Context->dbh;
 722     my $query = qq|
 723         SELECT *
 724         FROM   serial
 725         WHERE  serialid=?
 726     |;
 727     my $sth=$dbh->prepare($query);
 728     $sth->execute($serialid);
 729     my $data=$sth->fetchrow_hashref;
 730     my $bibid=MARCfind_MARCbibid_from_oldbiblionumber($dbh,$data->{biblionumber});
 731     my $fwk=MARCfind_frameworkcode($dbh,$bibid);
 732     if ($info->{barcode}){
 733         my @errors;
 734         my $exists = itemdata($info->{'barcode'});
 735         push @errors,"barcode_not_unique" if($exists);
 736         unless ($exists){
 737             my $marcrecord = MARC::Record->new();
 738             my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.barcode",$fwk);
 739             my $newField = MARC::Field->new(
 740                 "$tag",'','',
 741                 "$subfield" => $info->{barcode}
 742             );
 743             $marcrecord->insert_fields_ordered($newField);
 744             if ($info->{branch}){
 745                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.homebranch",$fwk);
 746                 #warn "items.homebranch : $tag , $subfield";
 747                 if ($marcrecord->field($tag)) {
 748                     $marcrecord->field($tag)->add_subfields("$subfield" => $info->{branch})
 749                 } else {
 750                     my $newField = MARC::Field->new(
 751                         "$tag",'','',
 752                         "$subfield" => $info->{branch}
 753                     );
 754                     $marcrecord->insert_fields_ordered($newField);
 755                 }
 756                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.holdingbranch",$fwk);
 757                 #warn "items.holdingbranch : $tag , $subfield";
 758                 if ($marcrecord->field($tag)) {
 759                     $marcrecord->field($tag)->add_subfields("$subfield" => $info->{branch})
 760                 } else {
 761                     my $newField = MARC::Field->new(
 762                         "$tag",'','',
 763                         "$subfield" => $info->{branch}
 764                     );
 765                     $marcrecord->insert_fields_ordered($newField);
 766                 }
 767             }
 768             if ($info->{itemcallnumber}){
 769                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.itemcallnumber",$fwk);
 770                 #warn "items.itemcallnumber : $tag , $subfield";
 771                 if ($marcrecord->field($tag)) {
 772                     $marcrecord->field($tag)->add_subfields("$subfield" => $info->{itemcallnumber})
 773                 } else {
 774                     my $newField = MARC::Field->new(
 775                         "$tag",'','',
 776                         "$subfield" => $info->{itemcallnumber}
 777                     );
 778                     $marcrecord->insert_fields_ordered($newField);
 779                 }
 780             }
 781             if ($info->{notes}){
 782                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.itemnotes",$fwk);
 783                 # warn "items.itemnotes : $tag , $subfield";
 784                 if ($marcrecord->field($tag)) {
 785                     $marcrecord->field($tag)->add_subfields("$subfield" => $info->{notes})
 786                 } else {
 787                     my $newField = MARC::Field->new(
 788                     "$tag",'','',
 789                     "$subfield" => $info->{notes}
 790                 );
 791                     $marcrecord->insert_fields_ordered($newField);
 792                 }
 793             }
 794             if ($info->{location}){
 795                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.location",$fwk);
 796                 # warn "items.location : $tag , $subfield";
 797                 if ($marcrecord->field($tag)) {
 798                     $marcrecord->field($tag)->add_subfields("$subfield" => $info->{location})
 799                 } else {
 800                     my $newField = MARC::Field->new(
 801                         "$tag",'','',
 802                         "$subfield" => $info->{location}
 803                     );
 804                     $marcrecord->insert_fields_ordered($newField);
 805                 }
 806             }
 807             if ($info->{status}){
 808                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.notforloan",$fwk);
 809                 # warn "items.notforloan : $tag , $subfield";
 810                 if ($marcrecord->field($tag)) {
 811                 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{status})
 812                 } else {
 813                     my $newField = MARC::Field->new(
 814                         "$tag",'','',
 815                         "$subfield" => $info->{status}
 816                     );
 817                     $marcrecord->insert_fields_ordered($newField);
 818                 }
 819             }
 820             NEWnewitem($dbh,$marcrecord,$bibid);
 821             return 1;
 822         }
 823         return (0,@errors);
 824     }
 825 }
 826 =item DelIssue
 827     DelIssue($serialseq,$subscriptionid)
 828 =cut
 829 sub DelIssue {
 830     my ($serialseq,$subscriptionid) = @_;
 831     my $dbh = C4::Context->dbh;
 832     my $query = qq|
 833         DELETE FROM serial
 834         WHERE       serialseq= ?
 835         AND         subscriptionid= ?
 836     |;
 837     my $sth = $dbh->prepare($query);
 838     $sth->execute($serialseq,$subscriptionid);
 839 }
 840 =item GetNextDate
 841
 842   $resultdate = GetNextDate($planneddate,$subscription)
 843
 844   this function get the date after $planneddate.
 845   return:
 846   the next date in iso format.
 847 =cut
 848 sub GetNextDate(@) {
 849     my ($planneddate,$subscription) = @_;
 850     my $resultdate;
 851     if ($subscription->{periodicity} == 1) {
 852         $resultdate=DateCalc($planneddate,"1 day");
 853     }
 854     if ($subscription->{periodicity} == 2) {
 855         $resultdate=DateCalc($planneddate,"1 week");
 856     }
 857     if ($subscription->{periodicity} == 3) {
 858         $resultdate=DateCalc($planneddate,"2 weeks");
 859     }
 860     if ($subscription->{periodicity} == 4) {
 861         $resultdate=DateCalc($planneddate,"3 weeks");
 862     }
 863     if ($subscription->{periodicity} == 5) {
 864         $resultdate=DateCalc($planneddate,"1 month");
 865     }
 866     if ($subscription->{periodicity} == 6) {
 867         $resultdate=DateCalc($planneddate,"2 months");
 868     }
 869     if ($subscription->{periodicity} == 7) {
 870         $resultdate=DateCalc($planneddate,"3 months");
 871     }
 872     if ($subscription->{periodicity} == 8) {
 873         $resultdate=DateCalc($planneddate,"3 months");
 874     }
 875     if ($subscription->{periodicity} == 9) {
 876         $resultdate=DateCalc($planneddate,"6 months");
 877     }
 878     if ($subscription->{periodicity} == 10) {
 879         $resultdate=DateCalc($planneddate,"1 year");
 880     }
 881     if ($subscription->{periodicity} == 11) {
 882         $resultdate=DateCalc($planneddate,"2 years");
 883     }
 884     return format_date_in_iso($resultdate);
 885 }
 886 =item GetSeq
 887     GetSeq($val)
 888 =cut
 889 sub GetSeq {
 890     my ($val) =@_;
 891     my $calculated = $val->{numberingmethod};
 892     my $x=$val->{'lastvalue1'};
 893     $calculated =~ s/\{X\}/$x/g;
 894     my $y=$val->{'lastvalue2'};
 895     $calculated =~ s/\{Y\}/$y/g;
 896     my $z=$val->{'lastvalue3'};
 897     $calculated =~ s/\{Z\}/$z/g;
 898     return $calculated;
 899 }
 900 =item GetNextSeq
 901     GetNextSeq($val)
 902 =cut
 903 sub GetNextSeq {
 904     my ($val) =@_;
 905     my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
 906     $calculated = $val->{numberingmethod};
 907     # calculate the (expected) value of the next issue recieved.
 908     $newlastvalue1 = $val->{lastvalue1};
 909     # check if we have to increase the new value.
 910     $newinnerloop1 = $val->{innerloop1}+1;
 911     $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
 912     $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
 913     $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
 914     $calculated =~ s/\{X\}/$newlastvalue1/g;
 915
 916     $newlastvalue2 = $val->{lastvalue2};
 917     # check if we have to increase the new value.
 918     $newinnerloop2 = $val->{innerloop2}+1;
 919     $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
 920     $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
 921     $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
 922     $calculated =~ s/\{Y\}/$newlastvalue2/g;
 923
 924     $newlastvalue3 = $val->{lastvalue3};
 925     # check if we have to increase the new value.
 926     $newinnerloop3 = $val->{innerloop3}+1;
 927     $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
 928     $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
 929     $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
 930     $calculated =~ s/\{Z\}/$newlastvalue3/g;
 931     return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
 932 }
 933 =item HasSubscriptionExpired
 934     1|0 = HasSubscriptionExpired($subscriptionid)
 935
 936 the subscription has expired when the next issue to arrive is out of subscription limit.
 937 return :
 938     1 if true, 0 if false.
 939 =cut
 940 sub HasSubscriptionExpired {
 941     my ($subscriptionid) = @_;
 942     my $dbh = C4::Context->dbh;
 943     my $subscription = GetSubscription($subscriptionid);
 944     # we don't do the same test if the subscription is based on X numbers or on X weeks/months
 945     if ($subscription->{numberlength}) {
 946         my $query = qq|
 947             SELECT count(*)
 948             FROM   serial
 949             WHERE  subscriptionid=? AND planneddate>=?
 950         |;
 951         my $sth = $dbh->prepare($query);
 952         $sth->execute($subscriptionid,$subscription->{startdate});
 953         my $res = $sth->fetchrow;
 954         if ($subscription->{numberlength}>=$res) {
 955             return 0;
 956         } else {
 957             return 1;
 958         }
 959     } else {
 960         #a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
 961         my $query = qq|
 962             SELECT max(planneddate)
 963             FROM   serial
 964             WHERE  subscriptionid=?
 965         |;
 966         my $sth = $dbh->prepare($query);
 967         $sth->execute($subscriptionid);
 968         my $res = ParseDate(format_date_in_iso($sth->fetchrow));
 969         my $endofsubscriptiondate;
 970         $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
 971         $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
 972         return 1 if ($res >= $endofsubscriptiondate);
 973         return 0;
 974     }
 975 }
 976 =item SubscriptionExpirationDate
 977 $sensddate = SubscriptionExpirationDate($subscriptionid)
 978
 979 this function return the expiration date for a subscription id given on input args.
 980
 981 return
 982     the subscriptionid.
 983 =cut
 984 sub SubscriptionExpirationDate {
 985     my ($subscriptionid) = @_;
 986     my $dbh = C4::Context->dbh;
 987     my $subscription = GetSubscription($subscriptionid);
 988     my $enddate=$subscription->{startdate};
 989     # we don't do the same test if the subscription is based on X numbers or on X weeks/months
 990     if ($subscription->{numberlength}) {
 991         #calculate the date of the last issue.
 992         for (my $i=1;$i<=$subscription->{numberlength};$i++) {
 993             $enddate = GetNextDate($enddate,$subscription);
 994         }
 995     } else {
 996         $enddate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
 997         $enddate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
 998     }
 999     return $enddate;
1000 }
1001 =item SubscriptionReNew
1002
1003 SubscriptionReNew($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1004
1005 this function renew a subscription.
1006 =cut
1007 sub SubscriptionReNew {
1008     my ($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note) = @_;
1009     my $dbh = C4::Context->dbh;
1010     my $subscription = GetSubscription($subscriptionid);
1011     my $query = qq|
1012         SELECT *
1013         FROM   biblio,biblioitems
1014         WHERE  biblio.biblionumber=biblioitems.biblionumber
1015         AND    biblio.biblionumber=?
1016     |;
1017     my $sth = $dbh->prepare($query);
1018     $sth->execute($subscription->{biblionumber});
1019     my $biblio = $sth->fetchrow_hashref;
1020     NewSuggestion($user,$subscription->{bibliotitle},$biblio->{author},$biblio->{publishercode},$biblio->{note},'','','','','',$subscription->{biblionumber});
1021     # renew subscription
1022     my $query = qq|
1023         UPDATE subscription
1024         SET    startdate=?,numberlength=?,weeklength=?,monthlength=?
1025         WHERE  subscriptionid=?
1026     |;
1027     $sth=$dbh->prepare($query);
1028     $sth->execute(format_date_in_iso($startdate),$numberlength,$weeklength,$monthlength, $subscriptionid);
1029 }
1030 END { }       # module clean-up code here (global destructor)
1031
1032 1;