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 require Exporter;
  23
  24 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  25
  26 # set the version for version checking
  27 $VERSION = 0.01;
  28
  29 =head1 NAME
  30
  31 C4::Bull - Give functions for serializing.
  32
  33 =head1 SYNOPSIS
  34
  35   use C4::Bull;
  36
  37 =head1 DESCRIPTION
  38
  39 Give all XYZ functions
  40
  41 =cut
  42
  43 @ISA = qw(Exporter);
  44 @EXPORT = qw(&newsubscription &modsubscription &getsubscriptions &getsubscription
  45         &modsubscriptionhistory
  46                         &getserials &serialchangestatus
  47                         &Initialize_Sequence &Find_Next_Date, &Get_Next_Seq);
  48
  49 sub newsubscription {
  50         my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,$startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,$seqnum1,$seqnum1,$seqtype1,$freq1, $step1,$seqnum2,$seqnum2,$seqtype2,$freq2, $step2,$seqnum3,$seqnum3,$seqtype3,$freq3, $step3, $numberingmethod, $arrivalplanified, $status, $notes) = @_;
  51         my $dbh = C4::Context->dbh;
  52         #save subscription
  53         my $sth=$dbh->prepare("insert into subscription (librarian, aqbooksellerid,cost,aqbudgetid,biblionumber,startdate, periodicity,dow,numberlength,weeklength,monthlength,seqnum1,startseqnum1,seqtype1,freq1,step1,seqnum2,startseqnum2,seqtype2,freq2, step2, seqnum3,startseqnum3,seqtype3, freq3, step3,numberingmethod, arrivalplanified, status, notes, pos1, pos2, pos3) values (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?, 0, 0, 0)");
  54         $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,$startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,$seqnum1,$seqnum1,$seqtype1,$freq1, $step1,$seqnum2,$seqnum2,$seqtype2,$freq2, $step2,$seqnum3,$seqnum3,$seqtype3,$freq3, $step3, $numberingmethod, $arrivalplanified, $status, $notes);
  55         #then create the 1st waited number
  56         my $subscriptionid = $dbh->{'mysql_insertid'};
  57         $sth = $dbh->prepare("insert into subscriptionhistory (biblionumber, subscriptionid, startdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)");
  58         $sth->execute($biblionumber, $subscriptionid, $startdate, 0, "", "", 0, $notes);
  59         $sth = $dbh->prepare("insert into serial (biblionumber, subscriptionid, serialseq, status, planneddate) values (?,?,?,?,?)");
  60         $sth->execute($biblionumber, $subscriptionid, Initialize_Sequence($numberingmethod, $seqnum1, $seqtype1, $freq1, $step1, $seqnum2, $seqtype2, $freq2, $step2, $seqnum3, $seqtype3, $freq3, $step3), $status, C4::Bull::Find_Next_Date());
  61         $sth->finish;
  62
  63 }
  64 sub getsubscription {
  65         my ($subscriptionid) = @_;
  66         my $dbh = C4::Context->dbh;
  67         my $sth = $dbh->prepare('select subscription.*,aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,biblio.title as bibliotitle
  68                                                         from subscription
  69                                                         left join aqbudget on subscription.aqbudgetid=aqbudget.aqbudgetid
  70                                                         left join aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
  71                                                         left join biblio on biblio.biblionumber=subscription.biblionumber
  72                                                         where subscriptionid = ?');
  73         $sth->execute($subscriptionid);
  74         my $subs = $sth->fetchrow_hashref;
  75         return $subs;
  76 }
  77
  78 sub modsubscription {
  79         my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
  80                                         $periodicity,$dow,$numberlength,$weeklength,$monthlength,
  81                                         $seqnum1,$startseqnum1,$seqtype1,$freq1,$step1,
  82                                         $seqnum2,$startseqnum2,$seqtype2,$freq2,$step2,
  83                                         $seqnum3,$startseqnum3,$seqtype3,$freq3,$step3,
  84                                         $numberingmethod, $arrivalplanified, $status, $biblionumber, $notes, $subscriptionid)= @_;
  85         my $dbh = C4::Context->dbh;
  86         my $sth=$dbh->prepare("update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?, periodicity=?,dow=?,numberlength=?,weeklength=?,monthlength=?,seqnum1=?,startseqnum1=?,seqtype1=?,freq1=?,step1=?,seqnum2=?,startseqnum2=?,seqtype2=?,freq2=?, step2=?, seqnum3=?,startseqnum3=?,seqtype3=?, freq3=?, step3=?,numberingmethod=?, arrivalplanified=?, status=?, biblionumber=?, notes=? where subscriptionid = ?");
  87         $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
  88                                         $periodicity,$dow,$numberlength,$weeklength,$monthlength,
  89                                         $seqnum1,$startseqnum1,$seqtype1,$freq1,$step1,
  90                                         $seqnum2,$startseqnum2,$seqtype2,$freq2,$step2,
  91                                         $seqnum3,$startseqnum3,$seqtype3,$freq3,$step3,
  92                                         $numberingmethod, $arrivalplanified, $status, $biblionumber, $notes, $subscriptionid);
  93         $sth->finish;
  94
  95 }
  96
  97 sub getsubscriptions {
  98         my ($title,$ISSN) = @_;
  99         my $dbh = C4::Context->dbh;
 100         my $sth;
 101         $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 = ? )");
 102         $sth->execute($title,$ISSN);
 103         my @results;
 104         while (my $line = $sth->fetchrow_hashref) {
 105                 push @results, $line;
 106         }
 107         return @results;
 108 }
 109
 110 sub modsubscriptionhistory {
 111         my ($subscriptionid,$startdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote)=@_;
 112         my $dbh=C4::Context->dbh;
 113         my $sth = $dbh->prepare("update subscriptionhistory set startdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=? where subscriptionid=?");
 114         $sth->execute($startdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote,$subscriptionid);
 115 }
 116 # get every serial not arrived for a given subscription.
 117 sub getserials {
 118         my ($subscriptionid) = @_;
 119         my $dbh = C4::Context->dbh;
 120         # status = 2 is "arrived"
 121         my $sth=$dbh->prepare("select serialid,serialseq, status, planneddate from serial where subscriptionid = ? and status <>2 and status <>4");
 122         $sth->execute($subscriptionid);
 123         my @serials;
 124         while(my $line = $sth->fetchrow_hashref) {
 125                 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
 126                 push @serials,$line;
 127         }
 128         return @serials;
 129 }
 130
 131 sub serialchangestatus {
 132         my ($serialid,$serialseq,$planneddate,$status)=@_;
 133         warn "($serialid,$serialseq,$planneddate,$status)";
 134 #       return 1;
 135         # 1st, get previous status : if we change from "waited" to something else, then we will have to create a new "waited" entry
 136         my $dbh = C4::Context->dbh;
 137         my $sth = $dbh->prepare("select subscriptionid,status from serial where serialid=?");
 138         $sth->execute($serialid);
 139         my ($subscriptionid,$oldstatus) = $sth->fetchrow;
 140         # change status & update subscriptionhistory
 141         $sth = $dbh->prepare("update serial set serialseq=?,planneddate=?,status=? where serialid = ?");
 142         $sth->execute($serialseq,$planneddate,$status,$serialid);
 143         $sth = $dbh->prepare("select missinglist,recievedlist from subscriptionhistory where subscriptionid=?");
 144         $sth->execute($subscriptionid);
 145         my ($missinglist,$recievedlist) = $sth->fetchrow;
 146         if ($status eq 2) {
 147                 $recievedlist .= ",$serialseq";
 148         }
 149         if ($status eq 4) {
 150                 $missinglist .= ",$serialseq";
 151         }
 152         $sth=$dbh->prepare("update subscriptionhistory set recievedlist=?, missinglist=? where subscriptionid=?");
 153         $sth->execute($recievedlist,$missinglist,$subscriptionid);
 154         # create new waited entry if needed (ie : was a "waited" and has changed)
 155         if ($oldstatus eq 1 && $status ne 1) {
 156            $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
 157            $sth->execute($subscriptionid);
 158            my $val = $sth->fetchrow_hashref;
 159            $sth = $dbh->prepare("insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)");
 160            my ($temp, $X, $Y, $Z, $pos1, $pos2, $pos3) = Get_Next_Seq($val->{'numberingmethod'},$val->{'seqnum1'},$val->{'freq1'}, $val->{'step1'}, $val->{'seqtype1'}, $val->{'seqnum2'}, $val->{'freq2'}, $val->{'step2'}, $val->{'seqtype2'}, $val->{'seqnum3'}, $val->{'freq3'}, $val->{'step3'}, $val->{'seqtype3'}, $val->{'pos1'}, $val->{'pos2'}, $val->{'pos3'});
 161            $sth->execute($temp, $subscriptionid, $val->{'biblionumber'}, 1, 0);
 162            $sth = $dbh->prepare("update subscription set seqnum1=?, seqnum2=?,seqnum3=?,pos1=?,pos2=?,pos3=? where subscriptionid = ?");
 163            $sth->execute($X, $Y, $Z, $pos1, $pos2, $pos3, $subscriptionid);
 164
 165         }
 166 }
 167 sub GetValue(@) {
 168     my $seq = shift;
 169     my $X = shift;
 170     my $Y = shift;
 171     my $Z = shift;
 172
 173     return $X if ($seq eq 'X');
 174     return $Y if ($seq eq 'Y');
 175     return $Z if ($seq eq 'Z');
 176     return "5 Syntax Error in Sequence";
 177 }
 178
 179
 180 sub Initialize_Sequence(@) {
 181         my $sequence = shift;
 182         my $X = shift;
 183         my $seqtype1 = shift;
 184         my $freq1 = shift;
 185         my $step1 = shift;
 186         my $Y = shift;
 187         my $seqtype2 = shift;
 188         my $freq2 = shift;
 189         my $step2 = shift;
 190         my $Z = shift;
 191         my $seqtype3 = shift;
 192         my $freq3 = shift;
 193         my $step3 = shift;
 194         my $finalstring = "";
 195         my @string = split //, $sequence;
 196         my $etat = 0;
 197
 198         for (my $i = 0; $i < (scalar @string); $i++) {
 199                 if ($string[$i] ne '{') {
 200                         if (!$etat) {
 201                                 $finalstring .= $string[$i];
 202                         } else {
 203                                 return "1 Syntax Error in Sequence";
 204                         }
 205                 } else {
 206                         return "3 Syntax Error in Sequence"
 207                                         if ($string[$i + 1] ne 'X' && $string[$i + 1] ne 'Y' && $string[$i + 1] ne 'Z');
 208                         $finalstring .= GetValue($string[$i + 1], $X, $Y, $Z);
 209                         $i += 2;
 210                 }
 211         }
 212         return "$finalstring";
 213 }
 214
 215 sub Find_Next_Date(@) {
 216     return "2004-29-03";
 217 }
 218
 219 sub Step(@) {
 220         my $seqnum1 = shift;
 221         my $seqtype1 = shift;
 222         my $freq1 = shift;
 223         my $step1 = shift;
 224         my $seqnum2 = shift;
 225         my $seqtype2 = shift;
 226         my $freq2 = shift;
 227         my $step2 = shift;
 228         my $seqnum3 = shift;
 229         my $seqtype3 = shift;
 230         my $freq3 = shift;
 231         my $step3 = shift;
 232         my $pos1 = shift;
 233         my $pos2 = shift;
 234         my $pos3 = shift;
 235
 236         $seqnum1 += $step1 if ($seqtype1 == 1);
 237         if ($seqtype1 == 2) {
 238                 $pos1 += 1;
 239                 if ($pos1 >= $freq1) {
 240                         $pos1 = 0;
 241                         $seqnum1 += $step1;
 242                 }
 243         }
 244
 245         $seqnum2 += $step2 if ($seqtype2 == 1);
 246         if ($seqtype2 == 2) {
 247                 $pos2 += 1;
 248                 if ($pos2 >= $freq2) {
 249                         $pos2 = 0;
 250                         $seqnum2 += $step2;
 251                 }
 252         }
 253
 254         $seqnum3 += $step3 if ($seqtype3 == 1);
 255         if ($seqtype3 == 2) {
 256                 $pos3 += 1;
 257                 if ($pos3 >= $freq3) {
 258                         $pos3 = 0;
 259                         $seqnum3 += $step3;
 260                 }
 261         }
 262
 263 #    $Y += $step2; if ($seqtype2 == 1);
 264  #   if ($seqtype2 == 2) { $pos2 += 1; if ($pos2 >= $freq2) {
 265         #$pos2 = 0; $Y += $step2; } }
 266
 267
 268    # $Z += $step3; if ($seqtype3 == 1);
 269    # if ($seqtype3 == 2) { $pos3 += 1; if ($pos3 >= $freq3) {
 270 #       $pos3 = 0; $Z += $step3; } }
 271
 272     return ($seqnum1, $seqnum2, $seqnum3, $pos1, $pos2, $pos3);
 273 }
 274
 275 sub Get_Next_Seq(@) {
 276     my $sequence = shift;
 277     my $seqnum1 = shift;
 278     my $freq1 = shift;
 279     my $step1 = shift;
 280     my $seqtype1 = shift;
 281     my $seqnum2 = shift;
 282     my $freq2 = shift;
 283     my $step2 = shift;
 284     my $seqtype2 = shift;
 285     my $seqnum3 = shift;
 286     my $freq3 = shift;
 287     my $step3 = shift;
 288     my $seqtype3 = shift;
 289     my $pos1 = shift;
 290     my $pos2 = shift;
 291     my $pos3 = shift;
 292
 293     return ("$sequence", $seqnum1, $seqnum2, $seqnum3)
 294         if (!defined($seqnum1) && !defined($seqnum2) && !defined($seqnum3));
 295
 296     ($seqnum1, $seqnum2, $seqnum3, $pos1, $pos2, $pos3) =
 297         Step($seqnum1, $seqtype1, $freq1, $step1, $seqnum2, $seqtype2, $freq2,
 298                   $step2, $seqnum3, $seqtype3, $freq3, $step3, $pos1, $pos2, $pos3);
 299
 300     return (Initialize_Sequence($sequence, $seqnum1, $seqtype1,
 301                                 $freq1, $step1, $seqnum2, $seqtype2, $freq2,
 302                                 $step2, $seqnum3, $seqtype3, $freq3, $step3),
 303                 $seqnum1, $seqnum2, $seqnum3, $pos1, $pos2, $pos3);
 304 }
 305
 306 END { }       # module clean-up code here (global destructor)