C4/Bull.pm

   1 package C4::Bull; #assumes C4/Bull.pm
   2
   3
   4 # Copyright 2000-2002 Katipo Communications
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it under the
   9 # terms of the GNU General Public License as published by the Free Software
  10 # Foundation; either version 2 of the License, or (at your option) any later
  11 # version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  15 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License along with
  18 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  19 # Suite 330, Boston, MA  02111-1307 USA
  20
  21 use strict;
  22 use C4::Date;
  23 require Exporter;
  24
  25 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  26
  27 # set the version for version checking
  28 $VERSION = 0.01;
  29
  30 =head1 NAME
  31
  32 C4::Bull - Give functions for serializing.
  33
  34 =head1 SYNOPSIS
  35
  36   use C4::Bull;
  37
  38 =head1 DESCRIPTION
  39
  40 Give all XYZ functions
  41
  42 =cut
  43
  44 @ISA = qw(Exporter);
  45 @EXPORT = qw(&newsubscription &modsubscription &getsubscriptions &getsubscription
  46         &modsubscriptionhistory
  47                         &getserials &serialchangestatus
  48                         &Find_Next_Date, &Get_Next_Seq);
  49
  50 sub newsubscription {
  51         my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
  52                 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
  53                 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
  54                 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
  55                 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
  56                 $numberingmethod, $arrivalplanified, $status, $notes) = @_;
  57         my $dbh = C4::Context->dbh;
  58         #save subscription
  59         my $sth=$dbh->prepare("insert into subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
  60                                                         startdate,periodicity,dow,numberlength,weeklength,monthlength,
  61                                                         add1,every1,whenmorethan1,setto1,lastvalue1,
  62                                                         add2,every2,whenmorethan2,setto2,lastvalue2,
  63                                                         add3,every3,whenmorethan3,setto3,lastvalue3,
  64                                                         numberingmethod, arrivalplanified, status, notes) values
  65                                                         (?,?,?,?,?,?,?,?,?,?,
  66                                                          ?,?,?,?,?,?,?,?,?,?,
  67                                                          ?,?,?,?,?,?,?,?,?,?)");
  68         $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
  69                                         format_date_in_iso($startdate),$periodicity,$dow,$numberlength,$weeklength,$monthlength,
  70                                         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
  71                                         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
  72                                         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
  73                                         $numberingmethod, format_date_in_iso($arrivalplanified), $status, $notes);
  74         #then create the 1st waited number
  75         my $subscriptionid = $dbh->{'mysql_insertid'};
  76         $sth = $dbh->prepare("insert into subscriptionhistory (biblionumber, subscriptionid, startdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)");
  77         $sth->execute($biblionumber, $subscriptionid, $startdate, 0, "", "", 0, $notes);
  78         # reread subscription to get a hash (for calculation of the 1st issue number)
  79         $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
  80         $sth->execute($subscriptionid);
  81         my $val = $sth->fetchrow_hashref;
  82         $sth = $dbh->prepare("insert into serial (biblionumber, subscriptionid, serialseq, status, planneddate) values (?,?,?,?,?)");
  83         $sth->execute($biblionumber, $subscriptionid,
  84                                         &Get_Next_Seq($val),
  85                                         $status, Find_Next_Date());
  86         $sth->finish;
  87 }
  88 sub getsubscription {
  89         my ($subscriptionid) = @_;
  90         my $dbh = C4::Context->dbh;
  91         my $sth = $dbh->prepare('select subscription.*,aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,biblio.title as bibliotitle
  92                                                         from subscription
  93                                                         left join aqbudget on subscription.aqbudgetid=aqbudget.aqbudgetid
  94                                                         left join aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
  95                                                         left join biblio on biblio.biblionumber=subscription.biblionumber
  96                                                         where subscriptionid = ?');
  97         $sth->execute($subscriptionid);
  98         my $subs = $sth->fetchrow_hashref;
  99         return $subs;
 100 }
 101
 102 sub modsubscription {
 103         my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
 104                                         $periodicity,$dow,$numberlength,$weeklength,$monthlength,
 105                                         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
 106                                         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
 107                                         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
 108                                         $numberingmethod, $arrivalplanified, $status, $biblionumber, $notes, $subscriptionid)= @_;
 109         my $dbh = C4::Context->dbh;
 110         my $sth=$dbh->prepare("update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
 111                                                  periodicity=?,dow=?,numberlength=?,weeklength=?,monthlength=?,
 112                                                 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,
 113                                                 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,
 114                                                 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,
 115                                                 numberingmethod=?, arrivalplanified=?, status=?, biblionumber=?, notes=? where subscriptionid = ?");
 116         $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
 117                                         $periodicity,$dow,$numberlength,$weeklength,$monthlength,
 118                                         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
 119                                         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
 120                                         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
 121                                         $numberingmethod, $arrivalplanified, $status, $biblionumber, $notes, $subscriptionid);
 122         $sth->finish;
 123
 124 }
 125
 126 sub getsubscriptions {
 127         my ($title,$ISSN) = @_;
 128         my $dbh = C4::Context->dbh;
 129         my $sth;
 130         $sth = $dbh->prepare("select subscription.subscriptionid,biblio.title,biblioitems.issn from subscription,biblio,biblioitems where  biblio.biblionumber = biblioitems.biblionumber and biblio.biblionumber=subscription.biblionumber and (biblio.title like ? or biblioitems.issn = ? )");
 131         $sth->execute($title,$ISSN);
 132         my @results;
 133         while (my $line = $sth->fetchrow_hashref) {
 134                 push @results, $line;
 135         }
 136         return @results;
 137 }
 138
 139 sub modsubscriptionhistory {
 140         my ($subscriptionid,$startdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote)=@_;
 141         my $dbh=C4::Context->dbh;
 142         my $sth = $dbh->prepare("update subscriptionhistory set startdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=? where subscriptionid=?");
 143         $sth->execute($startdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote,$subscriptionid);
 144 }
 145 # get every serial not arrived for a given subscription.
 146 sub getserials {
 147         my ($subscriptionid) = @_;
 148         my $dbh = C4::Context->dbh;
 149         # status = 2 is "arrived"
 150         my $sth=$dbh->prepare("select serialid,serialseq, status, planneddate from serial where subscriptionid = ? and status <>2 and status <>4");
 151         $sth->execute($subscriptionid);
 152         my @serials;
 153         while(my $line = $sth->fetchrow_hashref) {
 154                 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
 155                 push @serials,$line;
 156         }
 157         return @serials;
 158 }
 159
 160 sub serialchangestatus {
 161         my ($serialid,$serialseq,$planneddate,$status)=@_;
 162 #       warn "($serialid,$serialseq,$planneddate,$status)";
 163         # 1st, get previous status : if we change from "waited" to something else, then we will have to create a new "waited" entry
 164         my $dbh = C4::Context->dbh;
 165         my $sth = $dbh->prepare("select subscriptionid,status from serial where serialid=?");
 166         $sth->execute($serialid);
 167         my ($subscriptionid,$oldstatus) = $sth->fetchrow;
 168         # change status & update subscriptionhistory
 169         $sth = $dbh->prepare("update serial set serialseq=?,planneddate=?,status=? where serialid = ?");
 170         $sth->execute($serialseq,$planneddate,$status,$serialid);
 171         $sth = $dbh->prepare("select missinglist,recievedlist from subscriptionhistory where subscriptionid=?");
 172         $sth->execute($subscriptionid);
 173         my ($missinglist,$recievedlist) = $sth->fetchrow;
 174         if ($status eq 2) {
 175                 $recievedlist .= ",$serialseq";
 176         }
 177         if ($status eq 4) {
 178                 $missinglist .= ",$serialseq";
 179         }
 180         $sth=$dbh->prepare("update subscriptionhistory set recievedlist=?, missinglist=? where subscriptionid=?");
 181         $sth->execute($recievedlist,$missinglist,$subscriptionid);
 182         # create new waited entry if needed (ie : was a "waited" and has changed)
 183         if ($oldstatus eq 1 && $status ne 1) {
 184                 $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
 185                 $sth->execute($subscriptionid);
 186                 my $val = $sth->fetchrow_hashref;
 187                 my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3) = Get_Next_Seq($val);
 188                 $sth = $dbh->prepare("insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)");
 189                 $sth->execute($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, 0);
 190                 $sth = $dbh->prepare("update subscription set lastvalue1=?, lastvalue2=?,lastvalue3=?,
 191                                                                                                                 innerloop1=?,innerloop2=?,innerloop3=?
 192                                                                                                                 where subscriptionid = ?");
 193                 $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3,$subscriptionid);
 194         }
 195 }
 196
 197 sub Find_Next_Date(@) {
 198     return "2004-29-03";
 199 }
 200
 201 sub Get_Next_Seq {
 202         my ($val) =@_;
 203 #     return ("$sequence", $seqnum1, $seqnum2, $seqnum3)
 204 #       if (!defined($seqnum1) && !defined($seqnum2) && !defined($seqnum3));
 205         my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
 206         $calculated = $val->{numberingmethod};
 207         # calculate the (expected) value of the next issue recieved.
 208         $newlastvalue1 = $val->{lastvalue1};
 209         # check if we have to increase the new value.
 210         $newinnerloop1 = $val->{innerloop1}+1;
 211         $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
 212         $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
 213         $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
 214         $calculated =~ s/\{X\}/$newlastvalue1/g;
 215
 216         $newlastvalue2 = $val->{lastvalue2};
 217         # check if we have to increase the new value.
 218         $newinnerloop2 = $val->{innerloop2}+1;
 219         $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
 220         $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
 221         $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
 222         $calculated =~ s/\{Y\}/$newlastvalue2/g;
 223
 224         $newlastvalue3 = $val->{lastvalue3};
 225         # check if we have to increase the new value.
 226         $newinnerloop3 = $val->{innerloop3}+1;
 227         $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
 228         $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
 229         $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
 230         $calculated =~ s/\{Z\}/$newlastvalue3/g;
 231         return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
 232 }
 233
 234 END { }       # module clean-up code here (global destructor)