Lines 24-29
use MIME::Lite;
Link Here
|
24 |
use Mail::Sendmail; |
24 |
use Mail::Sendmail; |
25 |
|
25 |
|
26 |
use C4::Members; |
26 |
use C4::Members; |
|
|
27 |
use C4::Members::Attributes qw(GetBorrowerAttributes); |
27 |
use C4::Branch; |
28 |
use C4::Branch; |
28 |
use C4::Log; |
29 |
use C4::Log; |
29 |
use C4::SMS; |
30 |
use C4::SMS; |
Lines 40-46
BEGIN {
Link Here
|
40 |
$VERSION = 3.01; |
41 |
$VERSION = 3.01; |
41 |
@ISA = qw(Exporter); |
42 |
@ISA = qw(Exporter); |
42 |
@EXPORT = qw( |
43 |
@EXPORT = qw( |
43 |
&GetLetters &getletter &addalert &getalert &delalert &findrelatedto &SendAlerts GetPrintMessages |
44 |
&GetLetters &GetPreparedLetter &GetWrappedLetter &addalert &getalert &delalert &findrelatedto &SendAlerts &GetPrintMessages |
44 |
); |
45 |
); |
45 |
} |
46 |
} |
46 |
|
47 |
|
Lines 115-127
sub GetLetters (;$) {
Link Here
|
115 |
return \%letters; |
116 |
return \%letters; |
116 |
} |
117 |
} |
117 |
|
118 |
|
118 |
sub getletter ($$) { |
119 |
my %letter; |
119 |
my ( $module, $code ) = @_; |
120 |
sub getletter ($$$) { |
|
|
121 |
my ( $module, $code, $branchcode ) = @_; |
122 |
|
123 |
if (C4::Context->preference('IndependantBranches') && $branchcode){ |
124 |
$$branchcode = C4::Context->userenv->{'branch'}; |
125 |
} |
126 |
|
127 |
if ( my $l = $letter{$module}{$code}{$branchcode} ) { |
128 |
return { %$l }; # deep copy |
129 |
} |
130 |
|
120 |
my $dbh = C4::Context->dbh; |
131 |
my $dbh = C4::Context->dbh; |
121 |
my $sth = $dbh->prepare("select * from letter where module=? and code=?"); |
132 |
my $sth = $dbh->prepare("select * from letter where module=? and code=? and (branchcode = ? or branchcode = '') order by branchcode desc limit 1"); |
122 |
$sth->execute( $module, $code ); |
133 |
$sth->execute( $module, $code, $branchcode ); |
123 |
my $line = $sth->fetchrow_hashref; |
134 |
my $line = $sth->fetchrow_hashref |
124 |
return $line; |
135 |
or return; |
|
|
136 |
$line->{'content-type'} = 'text/html; charset="UTF-8"' if $line->{is_html}; |
137 |
$letter{$module}{$code}{$branchcode} = $line; |
138 |
return { %$line }; |
125 |
} |
139 |
} |
126 |
|
140 |
|
127 |
=head2 addalert ($borrowernumber, $type, $externalid) |
141 |
=head2 addalert ($borrowernumber, $type, $externalid) |
Lines 176-182
sub delalert ($) {
Link Here
|
176 |
sub getalert (;$$$) { |
190 |
sub getalert (;$$$) { |
177 |
my ( $borrowernumber, $type, $externalid ) = @_; |
191 |
my ( $borrowernumber, $type, $externalid ) = @_; |
178 |
my $dbh = C4::Context->dbh; |
192 |
my $dbh = C4::Context->dbh; |
179 |
my $query = "SELECT * FROM alert WHERE"; |
193 |
my $query = "SELECT a.*, b.branchcode FROM alert a JOIN borrowers b USING(borrowernumber) WHERE"; |
180 |
my @bind; |
194 |
my @bind; |
181 |
if ($borrowernumber and $borrowernumber =~ /^\d+$/) { |
195 |
if ($borrowernumber and $borrowernumber =~ /^\d+$/) { |
182 |
$query .= " borrowernumber=? AND "; |
196 |
$query .= " borrowernumber=? AND "; |
Lines 232-304
sub findrelatedto ($$) {
Link Here
|
232 |
parameters : |
246 |
parameters : |
233 |
- $type : the type of alert |
247 |
- $type : the type of alert |
234 |
- $externalid : the id of the "object" to query |
248 |
- $externalid : the id of the "object" to query |
235 |
- $letter : the letter to send. |
249 |
- $letter_code : the letter to send. |
236 |
|
250 |
|
237 |
send an alert to all borrowers having put an alert on a given subject. |
251 |
send an alert to all borrowers having put an alert on a given subject. |
238 |
|
252 |
|
239 |
=cut |
253 |
=cut |
240 |
|
254 |
|
241 |
sub SendAlerts { |
255 |
sub SendAlerts { |
242 |
my ( $type, $externalid, $letter ) = @_; |
256 |
my ( $type, $externalid, $letter_code ) = @_; |
243 |
my $dbh = C4::Context->dbh; |
257 |
my $dbh = C4::Context->dbh; |
244 |
my $strsth; |
258 |
my $strsth; |
245 |
if ( $type eq 'issue' ) { |
259 |
if ( $type eq 'issue' ) { |
246 |
|
260 |
|
247 |
# warn "sending issues..."; |
|
|
248 |
my $letter = getletter( 'serial', $letter ); |
249 |
|
250 |
# prepare the letter... |
261 |
# prepare the letter... |
251 |
# search the biblionumber |
262 |
# search the biblionumber |
252 |
my $sth = |
263 |
my $sth = |
253 |
$dbh->prepare( |
264 |
$dbh->prepare( |
254 |
"SELECT biblionumber FROM subscription WHERE subscriptionid=?"); |
265 |
"SELECT biblionumber FROM subscription WHERE subscriptionid=?"); |
255 |
$sth->execute($externalid); |
266 |
$sth->execute($externalid); |
256 |
my ($biblionumber) = $sth->fetchrow; |
267 |
my ($biblionumber) = $sth->fetchrow |
257 |
|
268 |
or warn( "No subscription for '$externalid'" ), |
258 |
# parsing branch info |
269 |
return; |
259 |
my $userenv = C4::Context->userenv; |
|
|
260 |
parseletter( $letter, 'branches', $userenv->{branch} ); |
261 |
|
262 |
# parsing librarian name |
263 |
$letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g; |
264 |
$letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g; |
265 |
$letter->{content} =~ |
266 |
s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g; |
267 |
|
268 |
# parsing biblio information |
269 |
parseletter( $letter, 'biblio', $biblionumber ); |
270 |
parseletter( $letter, 'biblioitems', $biblionumber ); |
271 |
|
270 |
|
|
|
271 |
my %letter; |
272 |
# find the list of borrowers to alert |
272 |
# find the list of borrowers to alert |
273 |
my $alerts = getalert( '', 'issue', $externalid ); |
273 |
my $alerts = getalert( '', 'issue', $externalid ); |
274 |
foreach (@$alerts) { |
274 |
foreach (@$alerts) { |
275 |
|
275 |
|
276 |
# and parse borrower ... |
|
|
277 |
my $innerletter = $letter; |
278 |
my $borinfo = C4::Members::GetMember('borrowernumber' => $_->{'borrowernumber'}); |
276 |
my $borinfo = C4::Members::GetMember('borrowernumber' => $_->{'borrowernumber'}); |
279 |
parseletter( $innerletter, 'borrowers', $_->{'borrowernumber'} ); |
277 |
my $email = $borinfo->{email} or next; |
|
|
278 |
|
279 |
# warn "sending issues..."; |
280 |
my $userenv = C4::Context->userenv; |
281 |
my $letter = GetPreparedLetter ( |
282 |
module => 'serial', |
283 |
letter_code => $letter_code, |
284 |
branchcode => $userenv->{branch}, |
285 |
tables => { |
286 |
'branches' => $_->{branchcode}, |
287 |
'biblio' => $biblionumber, |
288 |
'biblioitems' => $biblionumber, |
289 |
'borrowers' => $borinfo, |
290 |
}, |
291 |
want_librarian => 1, |
292 |
) or return; |
280 |
|
293 |
|
281 |
# ... then send mail |
294 |
# ... then send mail |
282 |
if ( $borinfo->{email} ) { |
295 |
my %mail = ( |
283 |
my %mail = ( |
296 |
To => $email, |
284 |
To => $borinfo->{email}, |
297 |
From => $email, |
285 |
From => $borinfo->{email}, |
298 |
Subject => "" . $letter->{title}, |
286 |
Subject => "" . $innerletter->{title}, |
299 |
Message => "" . $letter->{content}, |
287 |
Message => "" . $innerletter->{content}, |
300 |
'Content-Type' => 'text/plain; charset="utf8"', |
288 |
'Content-Type' => 'text/plain; charset="utf8"', |
301 |
); |
289 |
); |
302 |
sendmail(%mail) or carp $Mail::Sendmail::error; |
290 |
sendmail(%mail) or carp $Mail::Sendmail::error; |
|
|
291 |
|
292 |
} |
293 |
} |
303 |
} |
294 |
} |
304 |
} |
295 |
elsif ( $type eq 'claimacquisition' ) { |
305 |
elsif ( $type eq 'claimacquisition' or $type eq 'claimissues' ) { |
296 |
|
|
|
297 |
$letter = getletter( 'claimacquisition', $letter ); |
298 |
|
306 |
|
299 |
# prepare the letter... |
307 |
# prepare the letter... |
300 |
# search the biblionumber |
308 |
# search the biblionumber |
301 |
$strsth = qq{ |
309 |
$strsth = $type eq 'claimacquisition' |
|
|
310 |
? qq{ |
302 |
SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*,aqbooksellers.* |
311 |
SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*,aqbooksellers.* |
303 |
FROM aqorders |
312 |
FROM aqorders |
304 |
LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno |
313 |
LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno |
Lines 306-419
sub SendAlerts {
Link Here
|
306 |
LEFT JOIN biblioitems ON aqorders.biblioitemnumber=biblioitems.biblioitemnumber |
315 |
LEFT JOIN biblioitems ON aqorders.biblioitemnumber=biblioitems.biblioitemnumber |
307 |
LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id |
316 |
LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id |
308 |
WHERE aqorders.ordernumber IN ( |
317 |
WHERE aqorders.ordernumber IN ( |
309 |
} |
318 |
} |
310 |
. join( ",", @$externalid ) . ")"; |
319 |
: qq{ |
311 |
} |
|
|
312 |
elsif ( $type eq 'claimissues' ) { |
313 |
|
314 |
$letter = getletter( 'claimissues', $letter ); |
315 |
|
316 |
# prepare the letter... |
317 |
# search the biblionumber |
318 |
$strsth = qq{ |
319 |
SELECT serial.*,subscription.*, biblio.*, aqbooksellers.* |
320 |
SELECT serial.*,subscription.*, biblio.*, aqbooksellers.* |
320 |
FROM serial |
321 |
FROM serial |
321 |
LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid |
322 |
LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid |
322 |
LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber |
323 |
LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber |
323 |
LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id |
324 |
LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id |
324 |
WHERE serial.serialid IN ( |
325 |
WHERE serial.serialid IN ( |
325 |
} |
326 |
} |
326 |
. join( ",", @$externalid ) . ")"; |
327 |
. join( ",", @$externalid ) . ")"; |
327 |
} |
|
|
328 |
|
329 |
if ( $type eq 'claimacquisition' or $type eq 'claimissues' ) { |
330 |
my $sthorders = $dbh->prepare($strsth); |
328 |
my $sthorders = $dbh->prepare($strsth); |
331 |
$sthorders->execute; |
329 |
$sthorders->execute; |
332 |
my @fields = map { |
330 |
my $dataorders = $sthorders->fetchall_arrayref( {} ); |
333 |
$sthorders->{mysql_table}[$_] . "." . $sthorders->{NAME}[$_] } |
331 |
|
334 |
(0 .. $#{$sthorders->{NAME}} ) ; |
332 |
my $sthbookseller = |
335 |
|
333 |
$dbh->prepare("select * from aqbooksellers where id=?"); |
336 |
my @orders_infos; |
334 |
$sthbookseller->execute( $dataorders->[0]->{booksellerid} ); |
337 |
while ( my $row = $sthorders->fetchrow_arrayref() ) { |
335 |
my $databookseller = $sthbookseller->fetchrow_hashref; |
338 |
my %rec = (); |
336 |
|
339 |
@rec{@fields} = @$row; |
337 |
my @email; |
340 |
push @orders_infos, \%rec; |
338 |
push @email, $databookseller->{bookselleremail} if $databookseller->{bookselleremail}; |
|
|
339 |
push @email, $databookseller->{contemail} if $databookseller->{contemail}; |
340 |
unless (@email) { |
341 |
warn "Bookseller $dataorders->[0]->{booksellerid} without emails"; |
342 |
return; |
341 |
} |
343 |
} |
342 |
|
344 |
|
343 |
# parsing branch info |
|
|
344 |
my $userenv = C4::Context->userenv; |
345 |
my $userenv = C4::Context->userenv; |
345 |
parseletter( $letter, 'branches', $userenv->{branch} ); |
346 |
my $letter = GetPreparedLetter ( |
346 |
|
347 |
module => $type, |
347 |
# parsing librarian name |
348 |
letter_code => $letter_code, |
348 |
$letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g; |
349 |
branchcode => $userenv->{branch}, |
349 |
$letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g; |
350 |
tables => { |
350 |
$letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g; |
351 |
'branches' => $userenv->{branch}, |
351 |
|
352 |
'aqbooksellers' => $databookseller, |
352 |
# Get Fields remplacement |
353 |
}, |
353 |
my $order_format = $1 if ( $letter->{content} =~ m/(<order>.*<\/order>)/xms ); |
354 |
repeat => $dataorders, |
354 |
|
355 |
want_librarian => 1, |
355 |
# Foreach field to remplace |
356 |
) or return; |
356 |
while ( $letter->{content} =~ m/<<([^>]*)>>/g ) { |
|
|
357 |
my $field = $1; |
358 |
my $value = $orders_infos[0]->{$field} || ""; |
359 |
$value = sprintf("%.2f", $value) if $field =~ /price/; |
360 |
$letter->{content} =~ s/<<$field>>/$value/g; |
361 |
} |
362 |
|
363 |
if ( $order_format ) { |
364 |
# For each order |
365 |
foreach my $infos ( @orders_infos ) { |
366 |
my $order_content = $order_format; |
367 |
# We replace by value |
368 |
while ( $order_content =~ m/<<([^>]*)>>/g ) { |
369 |
my $field = $1; |
370 |
my $value = $infos->{$field} || ""; |
371 |
$value = sprintf("%.2f", $value) if $field =~ /price/; |
372 |
$order_content =~ s/(<<$field>>)/$value/g; |
373 |
} |
374 |
$order_content =~ s/<\/{0,1}?order>//g; |
375 |
$letter->{content} =~ s/<order>.*<\/order>/$order_content\n$order_format/xms; |
376 |
} |
377 |
$letter->{content} =~ s/<order>.*<\/order>//xms; |
378 |
} |
379 |
|
380 |
my $innerletter = $letter; |
381 |
|
357 |
|
382 |
# ... then send mail |
358 |
# ... then send mail |
383 |
if ( $orders_infos[0]->{'aqbooksellers.bookselleremail'} |
359 |
my %mail = ( |
384 |
|| $orders_infos[0]->{'aqbooksellers.contemail'} ) { |
360 |
To => join( ','. @email), |
385 |
my $to = $orders_infos[0]->{'aqbooksellers.bookselleremail'}; |
361 |
From => $userenv->{emailaddress}, |
386 |
$to .= ", " if $to; |
362 |
Subject => "" . $letter->{title}, |
387 |
$to .= $orders_infos[0]->{'aqbooksellers.contemail'} || ""; |
363 |
Message => "" . $letter->{content}, |
388 |
my %mail = ( |
364 |
'Content-Type' => 'text/plain; charset="utf8"', |
389 |
To => $to, |
365 |
); |
390 |
From => $userenv->{emailaddress}, |
366 |
sendmail(%mail) or carp $Mail::Sendmail::error; |
391 |
Subject => Encode::encode( "utf8", "" . $innerletter->{title} ), |
|
|
392 |
Message => Encode::encode( "utf8", "" . $innerletter->{content} ), |
393 |
'Content-Type' => 'text/plain; charset="utf8"', |
394 |
); |
395 |
sendmail(%mail) or carp $Mail::Sendmail::error; |
396 |
warn "sending to $mail{To} From $mail{From} subj $mail{Subject} Mess $mail{Message}" if $debug; |
397 |
if ( C4::Context->preference("LetterLog") ) { |
398 |
logaction( "ACQUISITION", "Send Acquisition claim letter", "", "order list : " . join( ",", @$externalid ) . "\n$innerletter->{title}\n$innerletter->{content}" ) if $type eq 'claimacquisition'; |
399 |
logaction( "ACQUISITION", "CLAIM ISSUE", undef, "To=" . $mail{To} . " Title=" . $innerletter->{title} . " Content=" . $innerletter->{content} ) if $type eq 'claimissues'; |
400 |
} |
401 |
} else { |
402 |
return {error => "no_email" }; |
403 |
} |
404 |
|
405 |
warn "sending to From $userenv->{emailaddress} subj $innerletter->{title} Mess $innerletter->{content}" if $debug; |
406 |
} |
407 |
|
367 |
|
408 |
# send an "account details" notice to a newly created user |
368 |
logaction( |
|
|
369 |
"ACQUISITION", |
370 |
$type eq 'claimissues' ? "CLAIM ISSUE" : "ACQUISITION CLAIM", |
371 |
undef, |
372 |
"To=" |
373 |
. $databookseller->{contemail} |
374 |
. " Title=" |
375 |
. $letter->{title} |
376 |
. " Content=" |
377 |
. $letter->{content} |
378 |
) if C4::Context->preference("LetterLog"); |
379 |
} |
380 |
# send an "account details" notice to a newly created user |
409 |
elsif ( $type eq 'members' ) { |
381 |
elsif ( $type eq 'members' ) { |
410 |
# must parse the password special, before it's hashed. |
|
|
411 |
$letter->{content} =~ s/<<borrowers.password>>/$externalid->{'password'}/g; |
412 |
|
413 |
parseletter( $letter, 'borrowers', $externalid->{'borrowernumber'}); |
414 |
parseletter( $letter, 'branches', $externalid->{'branchcode'} ); |
415 |
|
416 |
my $branchdetails = GetBranchDetail($externalid->{'branchcode'}); |
382 |
my $branchdetails = GetBranchDetail($externalid->{'branchcode'}); |
|
|
383 |
my $letter = GetPreparedLetter ( |
384 |
module => 'members', |
385 |
letter_code => $letter_code, |
386 |
branchcode => $externalid->{'branchcode'}, |
387 |
tables => { |
388 |
'branches' => $branchdetails, |
389 |
'borrowers' => $externalid->{'borrowernumber'}, |
390 |
}, |
391 |
substitute => { 'borrowers.password' => $externalid->{'password'} }, |
392 |
want_librarian => 1, |
393 |
) or return; |
394 |
|
417 |
my %mail = ( |
395 |
my %mail = ( |
418 |
To => $externalid->{'emailaddr'}, |
396 |
To => $externalid->{'emailaddr'}, |
419 |
From => $branchdetails->{'branchemail'} || C4::Context->preference("KohaAdminEmailAddress"), |
397 |
From => $branchdetails->{'branchemail'} || C4::Context->preference("KohaAdminEmailAddress"), |
Lines 425-448
sub SendAlerts {
Link Here
|
425 |
} |
403 |
} |
426 |
} |
404 |
} |
427 |
|
405 |
|
428 |
=head2 parseletter($letter, $table, $pk) |
406 |
=head2 GetPreparedLetter( %params ) |
429 |
|
407 |
|
430 |
parameters : |
408 |
%params hash: |
431 |
- $letter : a hash to letter fields (title & content useful) |
409 |
module => letter module, mandatory |
432 |
- $table : the Koha table to parse. |
410 |
letter_code => letter code, mandatory |
433 |
- $pk : the primary key to query on the $table table |
411 |
branchcode => for letter selection, if missing default system letter taken |
434 |
parse all fields from a table, and replace values in title & content with the appropriate value |
412 |
tables => a hashref with table names as keys. Values are either: |
435 |
(not exported sub, used only internally) |
413 |
- a scalar - primary key value |
|
|
414 |
- an arrayref - primary key values |
415 |
- a hashref - full record |
416 |
substitute => custom substitution key/value pairs |
417 |
repeat => records to be substituted on consecutive lines: |
418 |
- an arrayref - tries to guess what needs substituting by |
419 |
taking remaining << >> tokensr; not recommended |
420 |
- a hashref token => @tables - replaces <token> << >> << >> </token> |
421 |
subtemplate for each @tables row; table is a hashref as above |
422 |
want_librarian => boolean, if set to true triggers librarian details |
423 |
substitution from the userenv |
424 |
Return value: |
425 |
letter fields hashref (title & content useful) |
436 |
|
426 |
|
437 |
=cut |
427 |
=cut |
438 |
|
428 |
|
439 |
our %handles = (); |
429 |
sub GetPreparedLetter { |
440 |
our %columns = (); |
430 |
my %params = @_; |
|
|
431 |
|
432 |
my $module = $params{module} or croak "No module"; |
433 |
my $letter_code = $params{letter_code} or croak "No letter_code"; |
434 |
my $branchcode = $params{branchcode} || ''; |
435 |
|
436 |
my $letter = getletter( $module, $letter_code, $branchcode ) |
437 |
or warn( "No $module $letter_code letter"), |
438 |
return; |
441 |
|
439 |
|
442 |
sub parseletter_sth { |
440 |
my $tables = $params{tables}; |
|
|
441 |
my $substitute = $params{substitute}; |
442 |
my $repeat = $params{repeat}; |
443 |
$tables || $substitute || $repeat |
444 |
or carp( "ERROR: nothing to substitute - both 'tables' and 'substitute' are empty" ), |
445 |
return; |
446 |
my $want_librarian = $params{want_librarian}; |
447 |
|
448 |
if ($substitute) { |
449 |
while ( my ($token, $val) = each %$substitute ) { |
450 |
$letter->{title} =~ s/<<$token>>/$val/g; |
451 |
$letter->{content} =~ s/<<$token>>/$val/g; |
452 |
} |
453 |
} |
454 |
|
455 |
if ($want_librarian) { |
456 |
# parsing librarian name |
457 |
my $userenv = C4::Context->userenv; |
458 |
$letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go; |
459 |
$letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go; |
460 |
$letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go; |
461 |
} |
462 |
|
463 |
my ($repeat_no_enclosing_tags, $repeat_enclosing_tags); |
464 |
|
465 |
if ($repeat) { |
466 |
if (ref ($repeat) eq 'ARRAY' ) { |
467 |
$repeat_no_enclosing_tags = $repeat; |
468 |
} else { |
469 |
$repeat_enclosing_tags = $repeat; |
470 |
} |
471 |
} |
472 |
|
473 |
if ($repeat_enclosing_tags) { |
474 |
while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) { |
475 |
if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) { |
476 |
my $subcontent = $1; |
477 |
my @lines = map { |
478 |
my %subletter = ( title => '', content => $subcontent ); |
479 |
_substitute_tables( \%subletter, $_ ); |
480 |
$subletter{content}; |
481 |
} @$tag_tables; |
482 |
$letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se; |
483 |
} |
484 |
} |
485 |
} |
486 |
|
487 |
if ($tables) { |
488 |
_substitute_tables( $letter, $tables ); |
489 |
} |
490 |
|
491 |
if ($repeat_no_enclosing_tags) { |
492 |
if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) { |
493 |
my $line = $&; |
494 |
my $i = 1; |
495 |
my @lines = map { |
496 |
my $c = $line; |
497 |
$c =~ s/<<count>>/$i/go; |
498 |
foreach my $field ( keys %{$_} ) { |
499 |
$c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/; |
500 |
} |
501 |
$i++; |
502 |
$c; |
503 |
} @$repeat_no_enclosing_tags; |
504 |
|
505 |
my $replaceby = join( "\n", @lines ); |
506 |
$letter->{content} =~ s/\Q$line\E/$replaceby/s; |
507 |
} |
508 |
} |
509 |
|
510 |
$letter->{content} =~ s/<<\S*>>//go; #remove any stragglers |
511 |
# $letter->{content} =~ s/<<[^>]*>>//go; |
512 |
|
513 |
return $letter; |
514 |
} |
515 |
|
516 |
sub _substitute_tables { |
517 |
my ( $letter, $tables ) = @_; |
518 |
while ( my ($table, $param) = each %$tables ) { |
519 |
next unless $param; |
520 |
|
521 |
my $ref = ref $param; |
522 |
|
523 |
my $values; |
524 |
if ($ref && $ref eq 'HASH') { |
525 |
$values = $param; |
526 |
} |
527 |
else { |
528 |
my @pk; |
529 |
my $sth = _parseletter_sth($table); |
530 |
unless ($sth) { |
531 |
warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table."; |
532 |
return; |
533 |
} |
534 |
$sth->execute( $ref ? @$param : $param ); |
535 |
|
536 |
$values = $sth->fetchrow_hashref; |
537 |
} |
538 |
|
539 |
_parseletter ( $letter, $table, $values ); |
540 |
} |
541 |
} |
542 |
|
543 |
my %handles = (); |
544 |
sub _parseletter_sth { |
443 |
my $table = shift; |
545 |
my $table = shift; |
444 |
unless ($table) { |
546 |
unless ($table) { |
445 |
carp "ERROR: parseletter_sth() called without argument (table)"; |
547 |
carp "ERROR: _parseletter_sth() called without argument (table)"; |
446 |
return; |
548 |
return; |
447 |
} |
549 |
} |
448 |
# check cache first |
550 |
# check cache first |
Lines 456-464
sub parseletter_sth {
Link Here
|
456 |
($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" : |
558 |
($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" : |
457 |
($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" : |
559 |
($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" : |
458 |
($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" : |
560 |
($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" : |
459 |
($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" : undef ; |
561 |
($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" : |
|
|
562 |
($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" : |
563 |
($table eq 'opac_news' ) ? "SELECT * FROM $table WHERE idnew = ?" : |
564 |
undef ; |
460 |
unless ($query) { |
565 |
unless ($query) { |
461 |
warn "ERROR: No parseletter_sth query for table '$table'"; |
566 |
warn "ERROR: No _parseletter_sth query for table '$table'"; |
462 |
return; # nothing to get |
567 |
return; # nothing to get |
463 |
} |
568 |
} |
464 |
unless ($handles{$table} = C4::Context->dbh->prepare($query)) { |
569 |
unless ($handles{$table} = C4::Context->dbh->prepare($query)) { |
Lines 468-492
sub parseletter_sth {
Link Here
|
468 |
return $handles{$table}; # now cache is populated for that $table |
573 |
return $handles{$table}; # now cache is populated for that $table |
469 |
} |
574 |
} |
470 |
|
575 |
|
471 |
sub parseletter { |
576 |
=head2 _parseletter($letter, $table, $values) |
472 |
my ( $letter, $table, $pk, $pk2 ) = @_; |
|
|
473 |
unless ($letter) { |
474 |
carp "ERROR: parseletter() 1st argument 'letter' empty"; |
475 |
return; |
476 |
} |
477 |
my $sth = parseletter_sth($table); |
478 |
unless ($sth) { |
479 |
warn "parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table."; |
480 |
return; |
481 |
} |
482 |
if ( $pk2 ) { |
483 |
$sth->execute($pk, $pk2); |
484 |
} else { |
485 |
$sth->execute($pk); |
486 |
} |
487 |
|
577 |
|
488 |
my $values = $sth->fetchrow_hashref; |
578 |
parameters : |
489 |
|
579 |
- $letter : a hash to letter fields (title & content useful) |
|
|
580 |
- $table : the Koha table to parse. |
581 |
- $values : table record hashref |
582 |
parse all fields from a table, and replace values in title & content with the appropriate value |
583 |
(not exported sub, used only internally) |
584 |
|
585 |
=cut |
586 |
|
587 |
my %columns = (); |
588 |
sub _parseletter { |
589 |
my ( $letter, $table, $values ) = @_; |
590 |
|
490 |
# TEMPORARY hack until the expirationdate column is added to reserves |
591 |
# TEMPORARY hack until the expirationdate column is added to reserves |
491 |
if ( $table eq 'reserves' && $values->{'waitingdate'} ) { |
592 |
if ( $table eq 'reserves' && $values->{'waitingdate'} ) { |
492 |
my @waitingdate = split /-/, $values->{'waitingdate'}; |
593 |
my @waitingdate = split /-/, $values->{'waitingdate'}; |
Lines 500-515
sub parseletter {
Link Here
|
500 |
)->output(); |
601 |
)->output(); |
501 |
} |
602 |
} |
502 |
|
603 |
|
|
|
604 |
if ($letter->{content} && $letter->{content} =~ /<<today>>/) { |
605 |
my @da = localtime(); |
606 |
my $todaysdate = "$da[2]:$da[1] " . C4::Dates->today(); |
607 |
$letter->{content} =~ s/<<today>>/$todaysdate/go; |
608 |
} |
503 |
|
609 |
|
504 |
# and get all fields from the table |
610 |
# and get all fields from the table |
505 |
my $columns = C4::Context->dbh->prepare("SHOW COLUMNS FROM $table"); |
611 |
# my $columns = $columns{$table}; |
506 |
$columns->execute; |
612 |
# unless ($columns) { |
507 |
while ( ( my $field ) = $columns->fetchrow_array ) { |
613 |
# $columns = $columns{$table} = C4::Context->dbh->selectcol_arrayref("SHOW COLUMNS FROM $table"); |
508 |
my $replacefield = "<<$table.$field>>"; |
614 |
# } |
509 |
$values->{$field} =~ s/\p{P}(?=$)//g if $values->{$field}; |
615 |
# foreach my $field (@$columns) { |
510 |
my $replacedby = $values->{$field} || ''; |
616 |
|
511 |
($letter->{title} ) and $letter->{title} =~ s/$replacefield/$replacedby/g; |
617 |
while ( my ($field, $val) = each %$values ) { |
512 |
($letter->{content}) and $letter->{content} =~ s/$replacefield/$replacedby/g; |
618 |
my $replacetablefield = "<<$table.$field>>"; |
|
|
619 |
my $replacefield = "<<$field>>"; |
620 |
$val =~ s/\p{P}(?=$)//g if $val; |
621 |
my $replacedby = defined ($val) ? $val : ''; |
622 |
($letter->{title} ) and do { |
623 |
$letter->{title} =~ s/$replacetablefield/$replacedby/g; |
624 |
$letter->{title} =~ s/$replacefield/$replacedby/g; |
625 |
}; |
626 |
($letter->{content}) and do { |
627 |
$letter->{content} =~ s/$replacetablefield/$replacedby/g; |
628 |
$letter->{content} =~ s/$replacefield/$replacedby/g; |
629 |
}; |
630 |
} |
631 |
|
632 |
if ($table eq 'borrowers' && $letter->{content}) { |
633 |
if ( my $attributes = GetBorrowerAttributes($values->{borrowernumber}) ) { |
634 |
my %attr; |
635 |
foreach (@$attributes) { |
636 |
my $code = $_->{code}; |
637 |
my $val = $_->{value_description} || $_->{value}; |
638 |
$val =~ s/\p{P}(?=$)//g if $val; |
639 |
next unless $val gt ''; |
640 |
$attr{$code} ||= []; |
641 |
push @{ $attr{$code} }, $val; |
642 |
} |
643 |
while ( my ($code, $val_ar) = each %attr ) { |
644 |
my $replacefield = "<<borrower-attribute:$code>>"; |
645 |
my $replacedby = join ',', @$val_ar; |
646 |
$letter->{content} =~ s/$replacefield/$replacedby/g; |
647 |
} |
648 |
} |
513 |
} |
649 |
} |
514 |
return $letter; |
650 |
return $letter; |
515 |
} |
651 |
} |
Lines 694-724
returns your letter object, with the content updated.
Link Here
|
694 |
sub _add_attachments { |
830 |
sub _add_attachments { |
695 |
my $params = shift; |
831 |
my $params = shift; |
696 |
|
832 |
|
697 |
return unless 'HASH' eq ref $params; |
833 |
my $letter = $params->{'letter'}; |
698 |
foreach my $required_parameter (qw( letter attachments message )) { |
834 |
my $attachments = $params->{'attachments'}; |
699 |
return unless exists $params->{$required_parameter}; |
835 |
return $letter unless @$attachments; |
700 |
} |
836 |
my $message = $params->{'message'}; |
701 |
return $params->{'letter'} unless @{ $params->{'attachments'} }; |
|
|
702 |
|
837 |
|
703 |
# First, we have to put the body in as the first attachment |
838 |
# First, we have to put the body in as the first attachment |
704 |
$params->{'message'}->attach( |
839 |
$message->attach( |
705 |
Type => 'TEXT', |
840 |
Type => $letter->{'content-type'} || 'TEXT', |
706 |
Data => $params->{'letter'}->{'content'}, |
841 |
Data => $letter->{'is_html'} |
|
|
842 |
? _wrap_html($letter->{'content'}, $letter->{'title'}) |
843 |
: $letter->{'content'}, |
707 |
); |
844 |
); |
708 |
|
845 |
|
709 |
foreach my $attachment ( @{ $params->{'attachments'} } ) { |
846 |
foreach my $attachment ( @$attachments ) { |
710 |
$params->{'message'}->attach( |
847 |
$message->attach( |
711 |
Type => $attachment->{'type'}, |
848 |
Type => $attachment->{'type'}, |
712 |
Data => $attachment->{'content'}, |
849 |
Data => $attachment->{'content'}, |
713 |
Filename => $attachment->{'filename'}, |
850 |
Filename => $attachment->{'filename'}, |
714 |
); |
851 |
); |
715 |
} |
852 |
} |
716 |
# we're forcing list context here to get the header, not the count back from grep. |
853 |
# we're forcing list context here to get the header, not the count back from grep. |
717 |
( $params->{'letter'}->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) ); |
854 |
( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) ); |
718 |
$params->{'letter'}->{'content-type'} =~ s/^Content-Type:\s+//; |
855 |
$letter->{'content-type'} =~ s/^Content-Type:\s+//; |
719 |
$params->{'letter'}->{'content'} = $params->{'message'}->body_as_string; |
856 |
$letter->{'content'} = $message->body_as_string; |
720 |
|
857 |
|
721 |
return $params->{'letter'}; |
858 |
return $letter; |
722 |
|
859 |
|
723 |
} |
860 |
} |
724 |
|
861 |
|
Lines 785-798
sub _send_message_by_email ($;$$$) {
Link Here
|
785 |
|
922 |
|
786 |
my $utf8 = decode('MIME-Header', $message->{'subject'} ); |
923 |
my $utf8 = decode('MIME-Header', $message->{'subject'} ); |
787 |
$message->{subject}= encode('MIME-Header', $utf8); |
924 |
$message->{subject}= encode('MIME-Header', $utf8); |
|
|
925 |
my $subject = encode('utf8', $message->{'subject'}); |
788 |
my $content = encode('utf8', $message->{'content'}); |
926 |
my $content = encode('utf8', $message->{'content'}); |
|
|
927 |
my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"'; |
928 |
my $is_html = $content_type =~ m/html/io; |
789 |
my %sendmail_params = ( |
929 |
my %sendmail_params = ( |
790 |
To => $to_address, |
930 |
To => $to_address, |
791 |
From => $message->{'from_address'} || C4::Context->preference('KohaAdminEmailAddress'), |
931 |
From => $message->{'from_address'} || C4::Context->preference('KohaAdminEmailAddress'), |
792 |
Subject => encode('utf8', $message->{'subject'}), |
932 |
Subject => $subject, |
793 |
charset => 'utf8', |
933 |
charset => 'utf8', |
794 |
Message => $content, |
934 |
Message => $is_html ? _wrap_html($content, $subject) : $content, |
795 |
'content-type' => $message->{'content_type'} || 'text/plain; charset="UTF-8"', |
935 |
'content-type' => $content_type, |
796 |
); |
936 |
); |
797 |
$sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username; |
937 |
$sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username; |
798 |
if ( my $bcc = C4::Context->preference('OverdueNoticeBcc') ) { |
938 |
if ( my $bcc = C4::Context->preference('OverdueNoticeBcc') ) { |
Lines 812-817
sub _send_message_by_email ($;$$$) {
Link Here
|
812 |
} |
952 |
} |
813 |
} |
953 |
} |
814 |
|
954 |
|
|
|
955 |
sub _wrap_html { |
956 |
my ($content, $title) = @_; |
957 |
|
958 |
my $css = C4::Context->preference("NoticeCSS") || ''; |
959 |
$css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css; |
960 |
return <<EOS; |
961 |
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" |
962 |
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> |
963 |
<html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml"> |
964 |
<head> |
965 |
<title>$title</title> |
966 |
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" /> |
967 |
$css |
968 |
</head> |
969 |
<body> |
970 |
$content |
971 |
</body> |
972 |
</html> |
973 |
EOS |
974 |
} |
975 |
|
815 |
sub _send_message_by_sms ($) { |
976 |
sub _send_message_by_sms ($) { |
816 |
my $message = shift or return undef; |
977 |
my $message = shift or return undef; |
817 |
my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} ); |
978 |
my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} ); |