4 # Copyright 2000-2002 Katipo Communications
6 # This file is part of Koha.
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
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.
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
30 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
32 # set the version for version checking
33 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
34 shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
39 C4::Letters - Give functions for Letters management
47 "Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like
48 late issues, as well as other tasks like sending a mail to users that have subscribed to a "serial issue alert" (= being warned every time a new issue has arrived at the library)
50 Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too.
55 @EXPORT = qw(&GetLetters &getletter &addalert &getalert &delalert &findrelatedto &SendAlerts);
60 $letters = &getletters($category);
61 returns informations about letters.
62 if needed, $category filters for letters given category
63 Create a letter selector with the following code
67 my $letters = GetLetters($cat);
69 foreach my $thisletter (keys %$letters) {
70 my $selected = 1 if $thisletter eq $letter;
71 my %row =(value => $thisletter,
72 selected => $selected,
73 lettername => $letters->{$thisletter},
75 push @letterloop, \%row;
79 <select name="letter">
80 <option value="">Default</option>
81 <!-- TMPL_LOOP name="letterloop" -->
82 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="lettername" --></option>
89 # returns a reference to a hash of references to ALL letters...
92 my $dbh = C4::Context->dbh;
96 my $query = "SELECT * FROM letter WHERE module = ? ORDER BY name";
97 $sth = $dbh->prepare($query);
100 my $query = " SELECT * FROM letter ORDER BY name";
101 $sth = $dbh->prepare($query);
104 while (my $letter=$sth->fetchrow_hashref){
105 $letters{$letter->{'code'}}=$letter->{'name'};
112 my ($module,$code) = @_;
113 my $dbh = C4::Context->dbh;
114 my $sth = $dbh->prepare("select * from letter where module=? and code=?");
115 $sth->execute($module,$code);
116 my $line = $sth->fetchrow_hashref;
123 - $borrowernumber : the number of the borrower subscribing to the alert
124 - $type : the type of alert.
125 - externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid.
127 create an alert and return the alertid (primary key)
132 my ($borrowernumber,$type,$externalid) = @_;
133 my $dbh=C4::Context->dbh;
134 my $sth = $dbh->prepare("insert into alert (borrowernumber, type, externalid) values (?,?,?)");
135 $sth->execute($borrowernumber,$type,$externalid);
136 # get the alert number newly created and return it
137 my $alertid = $dbh->{'mysql_insertid'};
143 - alertid : the alert id
149 # warn "ALERTID : $alertid";
150 my $dbh = C4::Context->dbh;
151 my $sth = $dbh->prepare("delete from alert where alertid=?");
152 $sth->execute($alertid);
158 - $borrowernumber : the number of the borrower subscribing to the alert
159 - $type : the type of alert.
160 - externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid.
161 all parameters NON mandatory. If a parameter is omitted, the query is done without the corresponding parameter. For example, without $externalid, returns all alerts for a borrower on a topic.
166 my ($borrowernumber,$type,$externalid) = @_;
167 my $dbh=C4::Context->dbh;
168 my $query = "select * from alert where";
170 if ($borrowernumber) {
171 $query .= " borrowernumber=? and";
172 push @bind,$borrowernumber;
175 $query .= " type=? and";
179 $query .= " externalid=? and";
180 push @bind,$externalid;
183 my $sth = $dbh->prepare($query);
184 $sth->execute(@bind);
186 while (my $line = $sth->fetchrow_hashref) {
189 return \@result if $#result >=0; # return only if there is one result.
195 - $type : the type of alert
196 - $externalid : the id of the "object" to query
198 In the table alert, a "id" is stored in the externalid field. This "id" is related to another table, depending on the type of the alert.
199 When type=issue, the id is related to a subscriptionid and this sub returns the name of the biblio.
200 When type=virtual, the id is related to a virtual shelf and this sub returns the name of the sub
204 my ($type,$externalid) = @_;
205 my $dbh=C4::Context->dbh;
207 if ($type eq 'issue') {
208 $sth=$dbh->prepare("select title as result from subscription left join biblio on subscription.biblionumber=biblio.biblionumber where subscriptionid=?");
210 if ($type eq 'borrower') {
211 $sth=$dbh->prepare("select concat(firstname,' ',surname) from borrowers where borrowernumber=?");
213 $sth->execute($externalid);
214 my ($result) = $sth->fetchrow;
221 - $type : the type of alert
222 - $externalid : the id of the "object" to query
223 - $letter : the letter to send.
225 send an alert to all borrowers having put an alert on a given subject.
230 my ($type,$externalid,$letter)=@_;
231 my $dbh=C4::Context->dbh;
232 if ($type eq 'issue') {
233 # warn "sending issues...";
234 my $letter = getletter('serial',$letter);
235 # prepare the letter...
236 # search the biblionumber
237 my $sth=$dbh->prepare("select biblionumber from subscription where subscriptionid=?");
238 $sth->execute($externalid);
239 my ($biblionumber)=$sth->fetchrow;
240 # parsing branch info
241 my $userenv = C4::Context->userenv;
242 parseletter($letter,'branches',$userenv->{branch});
243 # parsing librarian name
244 $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
245 $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
246 $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
247 # parsing biblio information
248 parseletter($letter,'biblio',$biblionumber);
249 parseletter($letter,'biblioitems',$biblionumber);
250 # find the list of borrowers to alert
251 my $alerts = getalert('','issue',$externalid);
253 # and parse borrower ...
254 my $innerletter = $letter;
255 my $borinfo = GetMember('',$_->{'borrowernumber'});
256 parseletter($innerletter,'borrowers',$_->{'borrowernumber'});
258 if ($borinfo->{emailaddress}) {
259 my %mail = ( To => $borinfo->{emailaddress},
260 From => $userenv->{emailaddress},
261 Subject => "".$innerletter->{title},
262 Message => "".$innerletter->{content},
265 # warn "sending to $mail{To} From $mail{From} subj $mail{Subject} Mess $mail{Message}";
269 elsif ($type eq 'claimacquisition') {
270 # warn "sending issues...";
271 my $letter = getletter('claimacquisition',$letter);
272 # prepare the letter...
273 # search the biblionumber
274 my $strsth="select aqorders.*,aqbasket.*,biblio.*,biblioitems.* from aqorders LEFT JOIN aqbasket on aqbasket.basketno=aqorders.basketno LEFT JOIN biblio on aqorders.biblionumber=biblio.biblionumber LEFT JOIN biblioitems on aqorders.biblioitemnumber=biblioitems.biblioitemnumber where aqorders.ordernumber IN (".join(",",@$externalid).")";
275 my $sthorders=$dbh->prepare($strsth);
277 my $dataorders=$sthorders->fetchall_arrayref({});
278 parseletter($letter,'aqbooksellers',$dataorders->[0]->{booksellerid});
279 my $sthbookseller = $dbh->prepare("select * from aqbooksellers where id=?");
280 $sthbookseller->execute($dataorders->[0]->{booksellerid});
281 my $databookseller=$sthbookseller->fetchrow_hashref;
282 # parsing branch info
283 my $userenv = C4::Context->userenv;
284 parseletter($letter,'branches',$userenv->{branch});
285 # parsing librarian name
286 $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
287 $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
288 $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
289 foreach my $data (@$dataorders){
290 my $line=$1 if ($letter->{content}=~m/(<<.*>>)/);
291 foreach my $field (keys %$data){
292 $line =~ s/(<<[^\.]+.$field>>)/$data->{$field}/;
294 $letter->{content}=~ s/(<<.*>>)/$line\n\1/;
296 $letter->{content} =~ s/<<[^>]*>>//g;
297 my $innerletter = $letter;
299 if ($databookseller->{bookselleremail}||$databookseller->{contemail}) {
300 my %mail = ( To => $databookseller->{bookselleremail}.($databookseller->{contemail}?",".$databookseller->{contemail}:""),
301 From => $userenv->{emailaddress},
302 Subject => "".$innerletter->{title},
303 Message => "".$innerletter->{content},
304 'Content-Type' => 'text/plain; charset="utf8"',
307 warn "sending to $mail{To} From $mail{From} subj $mail{Subject} Mess $mail{Message}";
309 if (C4::Context->preference("LetterLog")){
310 logaction($userenv->{number},"ACQUISITION","Send Acquisition claim letter","","order list : ".join(",",@$externalid)."\n$innerletter->{title}\n$innerletter->{content}")
313 elsif ($type eq 'claimissues') {
314 # warn "sending issues...";
315 my $letter = getletter('claimissues',$letter);
316 # prepare the letter...
317 # search the biblionumber
318 my $strsth="select serial.*,subscription.*, biblio.title from serial LEFT JOIN subscription on serial.subscriptionid=subscription.subscriptionid LEFT JOIN biblio on serial.biblionumber=biblio.biblionumber where serial.serialid IN (".join(",",@$externalid).")";
319 my $sthorders=$dbh->prepare($strsth);
321 my $dataorders=$sthorders->fetchall_arrayref({});
322 parseletter($letter,'aqbooksellers',$dataorders->[0]->{aqbooksellerid});
323 my $sthbookseller = $dbh->prepare("select * from aqbooksellers where id=?");
324 $sthbookseller->execute($dataorders->[0]->{aqbooksellerid});
325 my $databookseller=$sthbookseller->fetchrow_hashref;
326 # parsing branch info
327 my $userenv = C4::Context->userenv;
328 parseletter($letter,'branches',$userenv->{branch});
329 # parsing librarian name
330 $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
331 $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
332 $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
333 foreach my $data (@$dataorders){
334 my $line=$1 if ($letter->{content}=~m/(<<.*>>)/);
335 foreach my $field (keys %$data){
336 $line =~ s/(<<[^\.]+.$field>>)/$data->{$field}/;
338 $letter->{content}=~ s/(<<.*>>)/$line\n\1/;
340 $letter->{content} =~ s/<<[^>]*>>//g;
341 my $innerletter = $letter;
343 if ($databookseller->{bookselleremail}||$databookseller->{contemail}) {
344 my %mail = ( To => $databookseller->{bookselleremail}.($databookseller->{contemail}?",".$databookseller->{contemail}:""),
345 From => $userenv->{emailaddress},
346 Subject => "".$innerletter->{title},
347 Message => "".$innerletter->{content},
351 C4::Context->userenv->{'number'},
355 "To=".$databookseller->{contemail}.
356 " Title=".$innerletter->{title}.
357 " Content=".$innerletter->{content}
358 ) if C4::Context->preference("LetterLog");
360 warn "sending to From $userenv->{emailaddress} subj $innerletter->{title} Mess $innerletter->{content}";
367 - $letter : a hash to letter fields (title & content useful)
368 - $table : the Koha table to parse.
369 - $pk : the primary key to query on the $table table
370 parse all fields from a table, and replace values in title & content with the appropriate value
371 (not exported sub, used only internally)
376 my ($letter,$table,$pk) = @_;
377 # warn "Parseletter : ($letter,$table,$pk)";
378 my $dbh=C4::Context->dbh;
380 if ($table eq 'biblio') {
381 $sth = $dbh->prepare("select * from biblio where biblionumber=?");
382 } elsif ($table eq 'biblioitems') {
383 $sth = $dbh->prepare("select * from biblioitems where biblionumber=?");
384 } elsif ($table eq 'borrowers') {
385 $sth = $dbh->prepare("select * from borrowers where borrowernumber=?");
386 } elsif ($table eq 'branches') {
387 $sth = $dbh->prepare("select * from branches where branchcode=?");
388 } elsif ($table eq 'aqbooksellers') {
389 $sth = $dbh->prepare("select * from aqbooksellers where id=?");
392 # store the result in an hash
393 my $values = $sth->fetchrow_hashref;
394 # and get all fields from the table
395 $sth = $dbh->prepare("show columns from $table");
397 while ((my $field) = $sth->fetchrow_array) {
398 my $replacefield="<<$table.$field>>";
399 my $replacedby = $values->{$field};
400 # warn "REPLACE $replacefield by $replacedby";
401 $letter->{title} =~ s/$replacefield/$replacedby/g;
402 $letter->{content} =~ s/$replacefield/$replacedby/g;
406 END { } # module clean-up code here (global destructor)