[Koha-cvs] CVS: koha/C4 Bull.pm,1.13,1.14 Letters.pm,1.1,1.2
Paul POULAIN
tipaul at users.sourceforge.net
Fri Aug 5 16:47:26 CEST 2005
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)=@_;
- # 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)=@_;
+ 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 => 'paul.poulain at free.fr',#.$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)
More information about the Koha-cvs
mailing list