[Koha-cvs] CVS: koha/C4 Bull.pm,1.13,1.14 Letters.pm,1.1,1.2

[Paul POULAIN]

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

Modified Files:
        Bull.pm Letters.pm 
Log Message:
2 new features :
- a mail is sent everytime an issue if recieved in serial module. The mail is 
sent to all borrowers that have put an alert on the subscription (remember that 
you can put an alert only if the librarian have defined a "letter" as mail to 
send)
- the librarian can see, for a given subscription, who has put an alert.


Index: Bull.pm
===================================================================
RCS file: /cvsroot/koha/koha/C4/Bull.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -C2 -r1.13 -r1.14
*** Bull.pm     4 Aug 2005 13:31:22 -0000       1.13
--- Bull.pm     5 Aug 2005 14:47:23 -0000       1.14
***************
*** 23,26 ****
--- 23,27 ----
  use Date::Manip;
  use C4::Suggestions;
+ use C4::Letters;
  require Exporter;
  
***************
*** 396,400 ****
  sub serialchangestatus {
        my ($serialid,$serialseq,$planneddate,$status)address@hidden;
- #     warn "($serialid,$serialseq,$planneddate,$status)";
        # 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;
--- 397,400 ----
***************
*** 420,432 ****
        }
        # 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;
                # next issue number
!               my 
($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3)
 = Get_Next_Seq($val);
                # next date (calculated from actual date & frequency parameters)
!               my $nextplanneddate = Get_Next_Date($planneddate,$val);
!               newissue($newserialseq, $subscriptionid, 
$val->{'biblionumber'}, 1, $nextplanneddate);
                $sth = $dbh->prepare("update subscription set lastvalue1=?, 
lastvalue2=?,lastvalue3=?,
                                                                                
                                innerloop1=?,innerloop2=?,innerloop3=?
--- 420,432 ----
        }
        # create new waited entry if needed (ie : was a "waited" and has 
changed)
+       $sth = $dbh->prepare("select * from subscription where subscriptionid = 
? ");
+       $sth->execute($subscriptionid);
+       my $subscription = $sth->fetchrow_hashref;
        if ($oldstatus eq 1 && $status ne 1) {
                # next issue number
!               my 
($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3)
 = Get_Next_Seq($subscription);
                # next date (calculated from actual date & frequency parameters)
!               my $nextplanneddate = Get_Next_Date($planneddate,$subscription);
!               newissue($newserialseq, $subscriptionid, 
$subscription->{'biblionumber'}, 1, $nextplanneddate);
                $sth = $dbh->prepare("update subscription set lastvalue1=?, 
lastvalue2=?,lastvalue3=?,
                                                                                
                                innerloop1=?,innerloop2=?,innerloop3=?
***************
*** 434,437 ****
--- 434,441 ----
                
$sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3,$subscriptionid);
        }
+       # check if an alert must be sent... (= a letter is defined & status 
became "arrived"
+       if ($subscription->{letter} && $status eq 2) {
+               
sendalerts('issue',$subscription->{subscriptionid},$subscription->{letter});
+       }
  }
  

Index: Letters.pm
===================================================================
RCS file: /cvsroot/koha/koha/C4/Letters.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
*** Letters.pm  4 Aug 2005 08:54:55 -0000       1.1
--- Letters.pm  5 Aug 2005 14:47:24 -0000       1.2
***************
*** 20,26 ****
--- 20,28 ----
  
  use strict;
+ use Mail::Sendmail;
  use C4::Date;
  use Date::Manip;
  use C4::Suggestions;
+ use C4::Members;
  require Exporter;
  
***************
*** 48,52 ****
  
  @ISA = qw(Exporter);
! @EXPORT = qw(&GetLetterList &addalert &getalert &delalert &findrelatedto);
  
  =head2 GetLetterList
--- 50,54 ----
  
  @ISA = qw(Exporter);
! @EXPORT = qw(&GetLetterList &getletter &addalert &getalert &delalert 
&findrelatedto &sendalerts);
  
  =head2 GetLetterList
***************
*** 75,78 ****
--- 77,89 ----
  }
  
+ sub getletter {
+       my ($module,$code) = @_;
+       my $dbh = C4::Context->dbh;
+       my $sth = $dbh->prepare("select * from letter where module=? and 
code=?");
+       $sth->execute($module,$code);
+       my $line = $sth->fetchrow_hashref;
+       return $line;
+ }
+ 
  =head2 addalert
  
***************
*** 138,142 ****
        }
        $query =~ s/ and$//;
- #     warn "Q : $query";
        my $sth = $dbh->prepare($query);
        $sth->execute(@bind);
--- 149,152 ----
***************
*** 148,151 ****
--- 158,162 ----
        return;
  }
+ 
  =head2 findrelatedto
        parameters :
***************
*** 157,167 ****
        When type=virtual, the id is related to a virtual shelf and this sub 
returns the name of the sub
  =cut
  sub findrelatedto {
        my ($type,$externalid) = @_;
        my $dbh=C4::Context->dbh;
        my $sth;
!       if ($type eq "issue") {
                $sth=$dbh->prepare("select title as result from subscription 
left join biblio on subscription.biblionumber=biblio.biblionumber where 
subscriptionid=?");
        }
        $sth->execute($externalid);
        my ($result) = $sth->fetchrow;
--- 168,182 ----
        When type=virtual, the id is related to a virtual shelf and this sub 
returns the name of the sub
  =cut
+ 
  sub findrelatedto {
        my ($type,$externalid) = @_;
        my $dbh=C4::Context->dbh;
        my $sth;
!       if ($type eq 'issue') {
                $sth=$dbh->prepare("select title as result from subscription 
left join biblio on subscription.biblionumber=biblio.biblionumber where 
subscriptionid=?");
        }
+       if ($type eq 'borrower') {
+               $sth=$dbh->prepare("select concat(firstname,' ',surname) from 
borrowers where borrowernumber=?");
+       }
        $sth->execute($externalid);
        my ($result) = $sth->fetchrow;
***************
*** 169,171 ****
--- 184,264 ----
  }
  
+ =head2 sendalert
+       parameters :
+       - $type : the type of alert
+       - $externalid : the id of the "object" to query
+       - $letter : the letter to send.
+ 
+       send an alert to all borrowers having put an alert on a given subject.
+ 
+ =cut
+ 
+ sub sendalerts {
+       my ($type,$externalid,$letter)address@hidden;
+       warn "sendalerts : ($type,$externalid,$letter)";
+       my $dbh=C4::Context->dbh;
+       if ($type eq 'issue') {
+ #             warn "sending issues...";
+               my $letter = getletter('serial',$letter);
+               # prepare the letter...
+               # search the biblionumber
+               my $sth=$dbh->prepare("select biblionumber from subscription 
where subscriptionid=?");
+               $sth->execute($externalid);
+               my ($biblionumber)=$sth->fetchrow;
+               parseletter($letter,'biblio',$biblionumber);
+               parseletter($letter,'biblioitems',$biblionumber);
+               # find the list of borrowers to alert
+               my $alerts = getalert('','issue',$externalid);
+               foreach (@$alerts) {
+                       my $innerletter = $letter;
+                       my $borinfo = getmember('',$_->{'borrowernumber'});
+                       
parseletter($innerletter,'borrowers',$_->{'borrowernumber'});
+                       my $userenv = C4::Context->userenv;
+                       if ($borinfo->{emailaddress}) {
+                               my %mail = ( To => $borinfo->{emailaddress},
+                                                       From => 
'address@hidden',#.$userenv->{emailaddress},
+                                                       Subject => 
"".$innerletter->{title},
+                                                       Message => 
"".$innerletter->{content},
+                                                       );
+                               sendmail(%mail);
+ #                             warn "sending to $mail{To} From $mail{From} 
subj $mail{Subject} Mess $mail{Message}";
+                       }
+               }
+       }
+ }
+ 
+ =head2
+       parameters :
+       - $letter : a hash to letter fields (title & content useful)
+       - $table : the Koha table to parse.
+       - $pk : the primary key to query on the $table table
+       parse all fields from a table, and replace values in title & content 
with the appropriate value
+ =cut
+ sub parseletter {
+       my ($letter,$table,$pk) = @_;
+ #     warn "Parseletter : ($letter,$table,$pk)";
+       my $dbh=C4::Context->dbh;
+       my $sth;
+       if ($table eq 'biblio') {
+               $sth = $dbh->prepare("select * from biblio where 
biblionumber=?");
+       } elsif ($table eq 'biblioitems') {
+               $sth = $dbh->prepare("select * from biblioitems where 
biblionumber=?");
+       } elsif ($table eq 'borrowers') {
+               $sth = $dbh->prepare("select * from borrowers where 
borrowernumber=?");
+       }
+       $sth->execute($pk);
+       # store the result in an hash
+       my $values = $sth->fetchrow_hashref;
+       # and get all fields from the table
+       $sth = $dbh->prepare("show columns from $table");
+       $sth->execute;
+       while ((my $field) = $sth->fetchrow_array) {
+               my $replacefield="<<$table.$field>>";
+               my $replacedby = $values->{$field};
+ #             warn "REPLACE $replacefield by $replacedby";
+               $letter->{title} =~ s/$replacefield/$replacedby/g;
+               $letter->{content} =~ s/$replacefield/$replacedby/g;
+       }
+ }
+ 
  END { }       # module clean-up code here (global destructor)