[Koha-cvs] CVS: koha/C4 Bull.pm,1.1,1.2 Output.pm,1.49,1.50

[Paul POULAIN]

Update of /cvsroot/koha/koha/C4
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3192/C4

Modified Files:
        Bull.pm Output.pm 
Log Message:
reordering code & debugging

Index: Bull.pm
===================================================================
RCS file: /cvsroot/koha/koha/C4/Bull.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
*** Bull.pm     30 Jul 2004 14:01:48 -0000      1.1
--- Bull.pm     5 Aug 2004 16:35:25 -0000       1.2
***************
*** 42,49 ****
  
  @ISA = qw(Exporter);
! @EXPORT = qw(&Initialize_Sequence &Find_Next_Date, &Get_Next_Seq);
  
! # FIXME - Retirer ce FIXME il ne sert pas. 
  
  sub GetValue(@) {
      my $seq = shift;
--- 42,168 ----
  
  @ISA = qw(Exporter);
! @EXPORT = qw(&newsubscription &modsubscription &getsubscriptions 
&getsubscription
!       &modsubscriptionhistory
!                       &getserials &serialchangestatus
!                       &Initialize_Sequence &Find_Next_Date, &Get_Next_Seq);
! 
! sub newsubscription {
!       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) = @_;
!       my $dbh = C4::Context->dbh;
!       #save subscription
!       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)");
!       
$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);
!       #then create the 1st waited number
!       my $subscriptionid = $dbh->{'mysql_insertid'};
!       $sth = $dbh->prepare("insert into subscriptionhistory (biblionumber, 
subscriptionid, startdate, enddate, missinglist, recievedlist, opacnote, 
librariannote) values (?,?,?,?,?,?,?,?)");
!       $sth->execute($biblionumber, $subscriptionid, $startdate, 0, "", "", 0, 
$notes);
!       $sth = $dbh->prepare("insert into serial (biblionumber, subscriptionid, 
serialseq, status, planneddate) values (?,?,?,?,?)");
!       $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());
!       $sth->finish;  
  
! }
! sub getsubscription {
!       my ($subscriptionid) = @_;
!       my $dbh = C4::Context->dbh;
!       my $sth = $dbh->prepare('select 
subscription.*,aqbudget.bookfundid,aqbooksellers.name as 
aqbooksellername,biblio.title as bibliotitle 
!                                                       from subscription 
!                                                       left join aqbudget on 
subscription.aqbudgetid=aqbudget.aqbudgetid 
!                                                       left join aqbooksellers 
on subscription.aqbooksellerid=aqbooksellers.id 
!                                                       left join biblio on 
biblio.biblionumber=subscription.biblionumber 
!                                                       where subscriptionid = 
?');
!       $sth->execute($subscriptionid);
!       my $subs = $sth->fetchrow_hashref;
!       return $subs;
! }
! 
! sub modsubscription {
!       my ($auser,$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, $subscriptionid)= @_;
!       my $dbh = C4::Context->dbh;
!       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 = ?");
!       $sth->execute($auser,$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, $subscriptionid);
!       $sth->finish;
! 
! }
! 
! sub getsubscriptions {
!       my ($title,$ISSN) = @_;
!       my $dbh = C4::Context->dbh;
!       my $sth;
!       $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 = ? )");
!       $sth->execute($title,$ISSN);
!       my @results;
!       while (my $line = $sth->fetchrow_hashref) {
!               push @results, $line;
!       }
!       return @results;
! }
  
+ sub modsubscriptionhistory {
+       my 
($subscriptionid,$startdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote)address@hidden;
+       my $dbh=C4::Context->dbh;
+       my $sth = $dbh->prepare("update subscriptionhistory set 
startdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=? 
where subscriptionid=?");
+       
$sth->execute($startdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote,$subscriptionid);
+ }
+ # get every serial not arrived for a given subscription.
+ sub getserials {
+       my ($subscriptionid) = @_;
+       my $dbh = C4::Context->dbh;
+       # status = 2 is "arrived"
+       my $sth=$dbh->prepare("select serialid,serialseq, status, planneddate 
from serial where subscriptionid = ? and status <>2 and status <>4");
+       $sth->execute($subscriptionid);
+       my @serials;
+       while(my $line = $sth->fetchrow_hashref) {
+               $line->{"status".$line->{status}} = 1; # fills a "statusX" 
value, used for template status select list
+               push @serials,$line;
+       }
+       return @serials;
+ }
+ 
+ sub serialchangestatus {
+       my ($serialid,$serialseq,$planneddate,$status)address@hidden;
+       warn "($serialid,$serialseq,$planneddate,$status)";
+ #     return 1;
+       # 1st, get previous status : if we change from "waited" to something 
else, then we will have to create a new "waited" entry
+       my $dbh = C4::Context->dbh;
+       my $sth = $dbh->prepare("select subscriptionid,status from serial where 
serialid=?");
+       $sth->execute($serialid);
+       my ($subscriptionid,$oldstatus) = $sth->fetchrow;
+       # change status & update subscriptionhistory
+       $sth = $dbh->prepare("update serial set 
serialseq=?,planneddate=?,status=? where serialid = ?");
+       $sth->execute($serialseq,$planneddate,$status,$serialid);
+       $sth = $dbh->prepare("select missinglist,recievedlist from 
subscriptionhistory where subscriptionid=?");
+       $sth->execute($subscriptionid);
+       my ($missinglist,$recievedlist) = $sth->fetchrow;
+       if ($status eq 2) {
+               $recievedlist .= ",$serialseq";
+       }
+       if ($status eq 4) {
+               $missinglist .= ",$serialseq";
+       }
+       $sth=$dbh->prepare("update subscriptionhistory set recievedlist=?, 
missinglist=? where subscriptionid=?");
+       $sth->execute($recievedlist,$missinglist,$subscriptionid);
+       # create new waited entry if needed (ie : was a "waited" and has 
changed)
+       if ($oldstatus eq 1 && $status ne 1) {
+          $sth = $dbh->prepare("select * from subscription where 
subscriptionid = ? ");
+          $sth->execute($subscriptionid);
+          my $val = $sth->fetchrow_hashref;
+          $sth = $dbh->prepare("insert into serial 
(serialseq,subscriptionid,biblionumber,status, planneddate) values 
(?,?,?,?,?)");
+          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'});
+          $sth->execute($temp, $subscriptionid, $val->{'biblionumber'}, 1, 0);
+          $sth = $dbh->prepare("update subscription set seqnum1=?, 
seqnum2=?,seqnum3=?,pos1=?,pos2=?,pos3=? where subscriptionid = ?");
+          $sth->execute($X, $Y, $Z, $pos1, $pos2, $pos3, $subscriptionid);
+ 
+       }
+ }
  sub GetValue(@) {
      my $seq = shift;
***************
*** 60,115 ****
  
  sub Initialize_Sequence(@) {
!     my $sequence = shift;
!     my $X = shift;
!     my $Xstate = shift;
!     my $Xfreq = shift;
!     my $Xstep = shift;
!     my $Y = shift;
!     my $Ystate = shift;
!     my $Yfreq = shift;
!     my $Ystep = shift;
!     my $Z = shift;
!     my $Zstate = shift;
!     my $Zfreq = shift;
!     my $Zstep = shift;
!     my $finalstring = "";
!     my @string = split //, $sequence;
!     my $etat = 0;
!     
!     for (my $i = 0; $i < (scalar @string); $i++)
!     {
!       if ($string[$i] ne '{')
!           {
!                   if (!$etat)
!                           {
                                $finalstring .= $string[$i];
!                                   }
!                       else
!                               {
!                                   return "1 Syntax Error in Sequence";
!                                       }
!                   }
!       else
!           {
! #     if ($string[$i + 1] eq '\'')
! #     {
! # return "2 Syntax Error in Sequence"
! #     if ($string[$i + 2] ne 'X' && $string[$i + 2] ne 'Y' && $string[$i + 2] 
ne 'Z');
! 
! # $finalstring .= GetValueAsc($string[$i + 2], $X, $Y, $Z);
! # $i += 3;
! #     }
! #     else
! #     {
!               return "3 Syntax Error in Sequence"
!                       if ($string[$i + 1] ne 'X' && $string[$i + 1] ne 'Y' && 
$string[$i + 1] ne 'Z');
! 
!                   
!               $finalstring .= GetValue($string[$i + 1], $X, $Y, $Z);
!               $i += 2;
! #     }
                }
!     }
!     return "$finalstring";
  }
  
--- 179,214 ----
  
  sub Initialize_Sequence(@) {
!       my $sequence = shift;
!       my $X = shift;
!       my $seqtype1 = shift;
!       my $freq1 = shift;
!       my $step1 = shift;
!       my $Y = shift;
!       my $seqtype2 = shift;
!       my $freq2 = shift;
!       my $step2 = shift;
!       my $Z = shift;
!       my $seqtype3 = shift;
!       my $freq3 = shift;
!       my $step3 = shift;
!       my $finalstring = "";
!       my @string = split //, $sequence;
!       my $etat = 0;
!       
!       for (my $i = 0; $i < (scalar @string); $i++) {
!               if ($string[$i] ne '{') {
!                       if (!$etat) {
                                $finalstring .= $string[$i];
!                       } else {
!                               return "1 Syntax Error in Sequence";
!                       }
!               } else {
!                       return "3 Syntax Error in Sequence"
!                                       if ($string[$i + 1] ne 'X' && 
$string[$i + 1] ne 'Y' && $string[$i + 1] ne 'Z');  
!                       $finalstring .= GetValue($string[$i + 1], $X, $Y, $Z);
!                       $i += 2;
                }
!       }
!       return "$finalstring";
  }
  
***************
*** 119,190 ****
  
  sub Step(@) {
!     my $X = shift;
!     my $Xstate = shift;
!     my $Xfreq = shift;
!     my $Xstep = shift;
!     my $Y = shift;
!     my $Ystate = shift;
!     my $Yfreq = shift;
!     my $Ystep = shift;
!     my $Z = shift;
!     my $Zstate = shift;
!     my $Zfreq = shift;
!     my $Zstep = shift;
!     my $Xpos = shift;
!     my $Ypos = shift;
!     my $Zpos = shift;
!     
!     
!     $X += $Xstep if ($Xstate == 1);
!     if ($Xstate == 2) { $Xpos += 1; if ($Xpos >= $Xfreq) {
!       $Xpos = 0; $X += $Xstep; } }
! 
!     $Y += $Ystep if ($Ystate == 1);
!     if ($Ystate == 2) { $Ypos += 1; if ($Ypos >= $Yfreq) {
!       $Ypos = 0; $Y += $Ystep; } }
! 
!     $Z += $Zstep if ($Zstate == 1);
!     if ($Zstate == 2) { $Zpos += 1; if ($Zpos >= $Zfreq) {
!       $Zpos = 0; $Z += $Zstep; } }
      
! #    $Y += $Ystep; if ($Ystate == 1);
!  #   if ($Ystate == 2) { $Ypos += 1; if ($Ypos >= $Yfreq) {
!       #$Ypos = 0; $Y += $Ystep; } }
  
  
!    # $Z += $Zstep; if ($Zstate == 1);
!    # if ($Zstate == 2) { $Zpos += 1; if ($Zpos >= $Zfreq) {
! #     $Zpos = 0; $Z += $Zstep; } }
  
!     return ($X, $Y, $Z, $Xpos, $Ypos, $Zpos);
  }
  
  sub Get_Next_Seq(@) {
      my $sequence = shift;
!     my $X = shift;
!     my $Xfreq = shift;
!     my $Xstep = shift;
!     my $Xstate = shift;
!     my $Y = shift;
!     my $Yfreq = shift;
!     my $Ystep = shift;
!     my $Ystate = shift;
!     my $Z = shift;
!     my $Zfreq = shift;
!     my $Zstep = shift;
!     my $Zstate = shift;
!     my $Xpos = shift;
!     my $Ypos = shift;
!     my $Zpos = shift;
! 
!     return ("$sequence", $X, $Y, $Z)
!       if (!defined($X) && !defined($Y) && !defined($Z));
!     ($X, $Y, $Z, $Xpos, $Ypos, $Zpos) = 
!       Step($X, $Xstate, $Xfreq, $Xstep, $Y, $Ystate, $Yfreq, 
!                 $Ystep, $Z, $Zstate, $Zfreq, $Zstep, $Xpos, $Ypos, $Zpos);
!     return (Initialize_Sequence($sequence, $X, $Xstate,
!                               $Xfreq, $Xstep, $Y, $Ystate, $Yfreq,
!                               $Ystep, $Z, $Zstate, $Zfreq, $Zstep),
!               $X, $Y, $Z, $Xpos, $Ypos, $Zpos);
  }
  
--- 218,305 ----
  
  sub Step(@) {
!       my $seqnum1 = shift;
!       my $seqtype1 = shift;
!       my $freq1 = shift;
!       my $step1 = shift;
!       my $seqnum2 = shift;
!       my $seqtype2 = shift;
!       my $freq2 = shift;
!       my $step2 = shift;
!       my $seqnum3 = shift;
!       my $seqtype3 = shift;
!       my $freq3 = shift;
!       my $step3 = shift;
!       my $pos1 = shift;
!       my $pos2 = shift;
!       my $pos3 = shift; 
! 
!       $seqnum1 += $step1 if ($seqtype1 == 1);
!       if ($seqtype1 == 2) {
!               $pos1 += 1;
!               if ($pos1 >= $freq1) {
!                       $pos1 = 0;
!                       $seqnum1 += $step1;
!               }
!       }
! 
!       $seqnum2 += $step2 if ($seqtype2 == 1);
!       if ($seqtype2 == 2) {
!               $pos2 += 1;
!               if ($pos2 >= $freq2) {
!                       $pos2 = 0;
!                       $seqnum2 += $step2;
!               }
!       }
! 
!       $seqnum3 += $step3 if ($seqtype3 == 1);
!       if ($seqtype3 == 2) {
!               $pos3 += 1;
!               if ($pos3 >= $freq3) {
!                       $pos3 = 0;
!                       $seqnum3 += $step3;
!               }
!       }
      
! #    $Y += $step2; if ($seqtype2 == 1);
!  #   if ($seqtype2 == 2) { $pos2 += 1; if ($pos2 >= $freq2) {
!       #$pos2 = 0; $Y += $step2; } }
  
  
!    # $Z += $step3; if ($seqtype3 == 1);
!    # if ($seqtype3 == 2) { $pos3 += 1; if ($pos3 >= $freq3) {
! #     $pos3 = 0; $Z += $step3; } }
  
!     return ($seqnum1, $seqnum2, $seqnum3, $pos1, $pos2, $pos3);
  }
  
  sub Get_Next_Seq(@) {
      my $sequence = shift;
!     my $seqnum1 = shift;
!     my $freq1 = shift;
!     my $step1 = shift;
!     my $seqtype1 = shift;
!     my $seqnum2 = shift;
!     my $freq2 = shift;
!     my $step2 = shift;
!     my $seqtype2 = shift;
!     my $seqnum3 = shift;
!     my $freq3 = shift;
!     my $step3 = shift;
!     my $seqtype3 = shift;
!     my $pos1 = shift;
!     my $pos2 = shift;
!     my $pos3 = shift;
! 
!     return ("$sequence", $seqnum1, $seqnum2, $seqnum3)
!       if (!defined($seqnum1) && !defined($seqnum2) && !defined($seqnum3));
!       
!     ($seqnum1, $seqnum2, $seqnum3, $pos1, $pos2, $pos3) = 
!       Step($seqnum1, $seqtype1, $freq1, $step1, $seqnum2, $seqtype2, $freq2, 
!                 $step2, $seqnum3, $seqtype3, $freq3, $step3, $pos1, $pos2, 
$pos3);
!                         
!     return (Initialize_Sequence($sequence, $seqnum1, $seqtype1,
!                               $freq1, $step1, $seqnum2, $seqtype2, $freq2,
!                               $step2, $seqnum3, $seqtype3, $freq3, $step3),
!               $seqnum1, $seqnum2, $seqnum3, $pos1, $pos2, $pos3);
  }
  

Index: Output.pm
===================================================================
RCS file: /cvsroot/koha/koha/C4/Output.pm,v
retrieving revision 1.49
retrieving revision 1.50
diff -C2 -r1.49 -r1.50
*** Output.pm   16 Jul 2004 00:36:56 -0000      1.49
--- Output.pm   5 Aug 2004 16:35:25 -0000       1.50
***************
*** 80,85 ****
                                   path              => 
["$htdocs/$theme/$lang/includes"]);
  
-       # XXX temporary patch for Bug 182 for themelang
-       warn "theme is $theme lang is $lang";
        $template->param(themelang => ($opac ne 'intranet'? '/opac-tmpl': 
'/intranet-tmpl') . "/$theme/$lang",
                                                        interface => ($opac ne 
'intranet'? '/opac-tmpl': '/intranet-tmpl'),
--- 80,83 ----
***************
*** 95,102 ****
  sub themelanguage {
    my ($htdocs, $tmpl, $section, $query) = @_;
!   if (!$query) {
!     warn "no query";
!     
!   }
    my $dbh = C4::Context->dbh;
    my @languages;
--- 93,99 ----
  sub themelanguage {
    my ($htdocs, $tmpl, $section, $query) = @_;
! #   if (!$query) {
! #     warn "no query";
! #   }
    my $dbh = C4::Context->dbh;
    my @languages;