Lines 26-31
use Encode;
Link Here
|
26 |
use Carp; |
26 |
use Carp; |
27 |
|
27 |
|
28 |
use C4::Members; |
28 |
use C4::Members; |
|
|
29 |
use C4::Members::Attributes qw(GetBorrowerAttributes); |
29 |
use C4::Branch; |
30 |
use C4::Branch; |
30 |
use C4::Log; |
31 |
use C4::Log; |
31 |
use C4::SMS; |
32 |
use C4::SMS; |
Lines 42-48
BEGIN {
Link Here
|
42 |
$VERSION = 3.01; |
43 |
$VERSION = 3.01; |
43 |
@ISA = qw(Exporter); |
44 |
@ISA = qw(Exporter); |
44 |
@EXPORT = qw( |
45 |
@EXPORT = qw( |
45 |
&GetLetters &getletter &addalert &getalert &delalert &findrelatedto &SendAlerts GetPrintMessages |
46 |
&GetLetters &GetPreparedLetter &GetWrappedLetter &addalert &getalert &delalert &findrelatedto &SendAlerts &GetPrintMessages |
46 |
); |
47 |
); |
47 |
} |
48 |
} |
48 |
|
49 |
|
Lines 117-129
sub GetLetters (;$) {
Link Here
|
117 |
return \%letters; |
118 |
return \%letters; |
118 |
} |
119 |
} |
119 |
|
120 |
|
120 |
sub getletter ($$) { |
121 |
my %letter; |
121 |
my ( $module, $code ) = @_; |
122 |
sub getletter ($$$) { |
|
|
123 |
my ( $module, $code, $branchcode ) = @_; |
124 |
|
125 |
if (C4::Context->preference('IndependantBranches') && $branchcode){ |
126 |
$$branchcode = C4::Context->userenv->{'branch'}; |
127 |
} |
128 |
|
129 |
if ( my $l = $letter{$module}{$code}{$branchcode} ) { |
130 |
return { %$l }; # deep copy |
131 |
} |
132 |
|
122 |
my $dbh = C4::Context->dbh; |
133 |
my $dbh = C4::Context->dbh; |
123 |
my $sth = $dbh->prepare("select * from letter where module=? and code=?"); |
134 |
my $sth = $dbh->prepare("select * from letter where module=? and code=? and (branchcode = ? or branchcode = '') order by branchcode desc limit 1"); |
124 |
$sth->execute( $module, $code ); |
135 |
$sth->execute( $module, $code, $branchcode ); |
125 |
my $line = $sth->fetchrow_hashref; |
136 |
my $line = $sth->fetchrow_hashref |
126 |
return $line; |
137 |
or return; |
|
|
138 |
$line->{'content-type'} = 'text/html; charset="UTF-8"' if $line->{is_html}; |
139 |
$letter{$module}{$code}{$branchcode} = $line; |
140 |
return { %$line }; |
127 |
} |
141 |
} |
128 |
|
142 |
|
129 |
=head2 addalert ($borrowernumber, $type, $externalid) |
143 |
=head2 addalert ($borrowernumber, $type, $externalid) |
Lines 178-184
sub delalert ($) {
Link Here
|
178 |
sub getalert (;$$$) { |
192 |
sub getalert (;$$$) { |
179 |
my ( $borrowernumber, $type, $externalid ) = @_; |
193 |
my ( $borrowernumber, $type, $externalid ) = @_; |
180 |
my $dbh = C4::Context->dbh; |
194 |
my $dbh = C4::Context->dbh; |
181 |
my $query = "SELECT * FROM alert WHERE"; |
195 |
my $query = "SELECT a.*, b.branchcode FROM alert a JOIN borrowers b USING(borrowernumber) WHERE"; |
182 |
my @bind; |
196 |
my @bind; |
183 |
if ($borrowernumber and $borrowernumber =~ /^\d+$/) { |
197 |
if ($borrowernumber and $borrowernumber =~ /^\d+$/) { |
184 |
$query .= " borrowernumber=? AND "; |
198 |
$query .= " borrowernumber=? AND "; |
Lines 234-303
sub findrelatedto ($$) {
Link Here
|
234 |
parameters : |
248 |
parameters : |
235 |
- $type : the type of alert |
249 |
- $type : the type of alert |
236 |
- $externalid : the id of the "object" to query |
250 |
- $externalid : the id of the "object" to query |
237 |
- $letter : the letter to send. |
251 |
- $letter_code : the letter to send. |
238 |
|
252 |
|
239 |
send an alert to all borrowers having put an alert on a given subject. |
253 |
send an alert to all borrowers having put an alert on a given subject. |
240 |
|
254 |
|
241 |
=cut |
255 |
=cut |
242 |
|
256 |
|
243 |
sub SendAlerts { |
257 |
sub SendAlerts { |
244 |
my ( $type, $externalid, $letter ) = @_; |
258 |
my ( $type, $externalid, $letter_code ) = @_; |
245 |
my $dbh = C4::Context->dbh; |
259 |
my $dbh = C4::Context->dbh; |
246 |
if ( $type eq 'issue' ) { |
260 |
if ( $type eq 'issue' ) { |
247 |
|
261 |
|
248 |
# warn "sending issues..."; |
|
|
249 |
my $letter = getletter( 'serial', $letter ); |
250 |
|
251 |
# prepare the letter... |
262 |
# prepare the letter... |
252 |
# search the biblionumber |
263 |
# search the biblionumber |
253 |
my $sth = |
264 |
my $sth = |
254 |
$dbh->prepare( |
265 |
$dbh->prepare( |
255 |
"SELECT biblionumber FROM subscription WHERE subscriptionid=?"); |
266 |
"SELECT biblionumber FROM subscription WHERE subscriptionid=?"); |
256 |
$sth->execute($externalid); |
267 |
$sth->execute($externalid); |
257 |
my ($biblionumber) = $sth->fetchrow; |
268 |
my ($biblionumber) = $sth->fetchrow |
258 |
|
269 |
or warn( "No subscription for '$externalid'" ), |
259 |
# parsing branch info |
270 |
return; |
260 |
my $userenv = C4::Context->userenv; |
|
|
261 |
parseletter( $letter, 'branches', $userenv->{branch} ); |
262 |
|
263 |
# parsing librarian name |
264 |
$letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g; |
265 |
$letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g; |
266 |
$letter->{content} =~ |
267 |
s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g; |
268 |
|
269 |
# parsing biblio information |
270 |
parseletter( $letter, 'biblio', $biblionumber ); |
271 |
parseletter( $letter, 'biblioitems', $biblionumber ); |
272 |
|
271 |
|
|
|
272 |
my %letter; |
273 |
# find the list of borrowers to alert |
273 |
# find the list of borrowers to alert |
274 |
my $alerts = getalert( '', 'issue', $externalid ); |
274 |
my $alerts = getalert( '', 'issue', $externalid ); |
275 |
foreach (@$alerts) { |
275 |
foreach (@$alerts) { |
276 |
|
276 |
|
277 |
# and parse borrower ... |
|
|
278 |
my $innerletter = $letter; |
279 |
my $borinfo = C4::Members::GetMember('borrowernumber' => $_->{'borrowernumber'}); |
277 |
my $borinfo = C4::Members::GetMember('borrowernumber' => $_->{'borrowernumber'}); |
280 |
parseletter( $innerletter, 'borrowers', $_->{'borrowernumber'} ); |
278 |
my $email = $borinfo->{email} or next; |
|
|
279 |
|
280 |
# warn "sending issues..."; |
281 |
my $userenv = C4::Context->userenv; |
282 |
my $letter = GetPreparedLetter ( |
283 |
module => 'serial', |
284 |
letter_code => $letter_code, |
285 |
branchcode => $userenv->{branch}, |
286 |
tables => { |
287 |
'branches' => $_->{branchcode}, |
288 |
'biblio' => $biblionumber, |
289 |
'biblioitems' => $biblionumber, |
290 |
'borrowers' => $borinfo, |
291 |
}, |
292 |
want_librarian => 1, |
293 |
) or return; |
281 |
|
294 |
|
282 |
# ... then send mail |
295 |
# ... then send mail |
283 |
if ( $borinfo->{email} ) { |
296 |
my %mail = ( |
284 |
my %mail = ( |
297 |
To => $email, |
285 |
To => $borinfo->{email}, |
298 |
From => $email, |
286 |
From => $borinfo->{email}, |
299 |
Subject => "" . $letter->{title}, |
287 |
Subject => "" . $innerletter->{title}, |
300 |
Message => "" . $letter->{content}, |
288 |
Message => "" . $innerletter->{content}, |
301 |
'Content-Type' => 'text/plain; charset="utf8"', |
289 |
'Content-Type' => 'text/plain; charset="utf8"', |
302 |
); |
290 |
); |
303 |
sendmail(%mail) or carp $Mail::Sendmail::error; |
291 |
sendmail(%mail) or carp $Mail::Sendmail::error; |
|
|
292 |
|
293 |
# warn "sending to $mail{To} From $mail{From} subj $mail{Subject} Mess $mail{Message}"; |
304 |
# warn "sending to $mail{To} From $mail{From} subj $mail{Subject} Mess $mail{Message}"; |
294 |
} |
|
|
295 |
} |
305 |
} |
296 |
} |
306 |
} |
297 |
elsif ( $type eq 'claimacquisition' ) { |
307 |
elsif ( $type eq 'claimacquisition' ) { |
298 |
|
308 |
|
299 |
# warn "sending issues..."; |
309 |
# warn "sending issues..."; |
300 |
my $letter = getletter( 'claimacquisition', $letter ); |
|
|
301 |
|
310 |
|
302 |
# prepare the letter... |
311 |
# prepare the letter... |
303 |
# search the biblionumber |
312 |
# search the biblionumber |
Lines 307-358
sub SendAlerts {
Link Here
|
307 |
my $sthorders = $dbh->prepare($strsth); |
316 |
my $sthorders = $dbh->prepare($strsth); |
308 |
$sthorders->execute; |
317 |
$sthorders->execute; |
309 |
my $dataorders = $sthorders->fetchall_arrayref( {} ); |
318 |
my $dataorders = $sthorders->fetchall_arrayref( {} ); |
310 |
parseletter( $letter, 'aqbooksellers', |
319 |
|
311 |
$dataorders->[0]->{booksellerid} ); |
|
|
312 |
my $sthbookseller = |
320 |
my $sthbookseller = |
313 |
$dbh->prepare("select * from aqbooksellers where id=?"); |
321 |
$dbh->prepare("select * from aqbooksellers where id=?"); |
314 |
$sthbookseller->execute( $dataorders->[0]->{booksellerid} ); |
322 |
$sthbookseller->execute( $dataorders->[0]->{booksellerid} ); |
315 |
my $databookseller = $sthbookseller->fetchrow_hashref; |
323 |
my $databookseller = $sthbookseller->fetchrow_hashref; |
316 |
|
324 |
|
317 |
# parsing branch info |
325 |
my @email; |
318 |
my $userenv = C4::Context->userenv; |
326 |
push @email, $databookseller->{bookselleremail} if $databookseller->{bookselleremail}; |
319 |
parseletter( $letter, 'branches', $userenv->{branch} ); |
327 |
push @email, $databookseller->{contemail} if $databookseller->{contemail}; |
320 |
|
328 |
unless (@email) { |
321 |
# parsing librarian name |
329 |
warn "Bookseller $dataorders->[0]->{booksellerid} without emails"; |
322 |
$letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g; |
330 |
return; |
323 |
$letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g; |
|
|
324 |
$letter->{content} =~ |
325 |
s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g; |
326 |
foreach my $data ( @{$dataorders} ) { |
327 |
if ( $letter->{content} =~ m/(<<.*>>)/ ) { |
328 |
my $line = $1; |
329 |
foreach my $field ( keys %{$data} ) { |
330 |
$line =~ s/(<<[^\.]+.$field>>)/$data->{$field}/; |
331 |
} |
332 |
$letter->{content} =~ s/(<<.*>>)/$line\n$1/; |
333 |
} |
334 |
} |
331 |
} |
335 |
$letter->{content} =~ s/<<[^>]*>>//g; |
332 |
|
336 |
my $innerletter = $letter; |
333 |
my $userenv = C4::Context->userenv; |
|
|
334 |
my $letter = GetPreparedLetter ( |
335 |
module => 'claimacquisition', |
336 |
letter_code => $letter_code, |
337 |
branchcode => $userenv->{branch}, |
338 |
tables => { |
339 |
'branches' => $userenv->{branch}, |
340 |
'aqbooksellers' => $databookseller, |
341 |
}, |
342 |
repeat => $dataorders, |
343 |
want_librarian => 1, |
344 |
) or return; |
337 |
|
345 |
|
338 |
# ... then send mail |
346 |
# ... then send mail |
339 |
if ( $databookseller->{bookselleremail} |
347 |
my %mail = ( |
340 |
|| $databookseller->{contemail} ) |
348 |
To => join( ','. @email), |
341 |
{ |
349 |
From => $userenv->{emailaddress}, |
342 |
my %mail = ( |
350 |
Subject => "" . $letter->{title}, |
343 |
To => $databookseller->{bookselleremail} |
351 |
Message => "" . $letter->{content}, |
344 |
. ( |
352 |
'Content-Type' => 'text/plain; charset="utf8"', |
345 |
$databookseller->{contemail} |
353 |
); |
346 |
? "," . $databookseller->{contemail} |
354 |
sendmail(%mail) or carp $Mail::Sendmail::error; |
347 |
: "" |
355 |
|
348 |
), |
|
|
349 |
From => $userenv->{emailaddress}, |
350 |
Subject => "" . $innerletter->{title}, |
351 |
Message => "" . $innerletter->{content}, |
352 |
'Content-Type' => 'text/plain; charset="utf8"', |
353 |
); |
354 |
sendmail(%mail) or carp $Mail::Sendmail::error; |
355 |
} |
356 |
if ( C4::Context->preference("LetterLog") ) { |
356 |
if ( C4::Context->preference("LetterLog") ) { |
357 |
logaction( |
357 |
logaction( |
358 |
"ACQUISITION", |
358 |
"ACQUISITION", |
Lines 360-375
sub SendAlerts {
Link Here
|
360 |
"", |
360 |
"", |
361 |
"order list : " |
361 |
"order list : " |
362 |
. join( ",", @$externalid ) |
362 |
. join( ",", @$externalid ) |
363 |
. "\n$innerletter->{title}\n$innerletter->{content}" |
363 |
. "\n$letter->{title}\n$letter->{content}" |
364 |
); |
364 |
); |
365 |
} |
365 |
} |
366 |
} |
366 |
} |
367 |
elsif ( $type eq 'claimissues' ) { |
367 |
elsif ( $type eq 'claimissues' ) { |
368 |
|
368 |
|
369 |
# warn "sending issues..."; |
369 |
# warn "sending issues..."; |
370 |
my $letter = getletter( 'claimissues', $letter ); |
|
|
371 |
|
372 |
# prepare the letter... |
373 |
# search the biblionumber |
370 |
# search the biblionumber |
374 |
my $strsth = |
371 |
my $strsth = |
375 |
"select serial.*,subscription.*, biblio.* from serial LEFT JOIN subscription on serial.subscriptionid=subscription.subscriptionid LEFT JOIN biblio on serial.biblionumber=biblio.biblionumber where serial.serialid IN (" |
372 |
"select serial.*,subscription.*, biblio.* from serial LEFT JOIN subscription on serial.subscriptionid=subscription.subscriptionid LEFT JOIN biblio on serial.biblionumber=biblio.biblionumber where serial.serialid IN (" |
Lines 377-457
sub SendAlerts {
Link Here
|
377 |
my $sthorders = $dbh->prepare($strsth); |
374 |
my $sthorders = $dbh->prepare($strsth); |
378 |
$sthorders->execute; |
375 |
$sthorders->execute; |
379 |
my $dataorders = $sthorders->fetchall_arrayref( {} ); |
376 |
my $dataorders = $sthorders->fetchall_arrayref( {} ); |
380 |
parseletter( $letter, 'aqbooksellers', |
377 |
|
381 |
$dataorders->[0]->{aqbooksellerid} ); |
|
|
382 |
my $sthbookseller = |
378 |
my $sthbookseller = |
383 |
$dbh->prepare("select * from aqbooksellers where id=?"); |
379 |
$dbh->prepare("select * from aqbooksellers where id=?"); |
384 |
$sthbookseller->execute( $dataorders->[0]->{aqbooksellerid} ); |
380 |
$sthbookseller->execute( $dataorders->[0]->{aqbooksellerid} ); |
385 |
my $databookseller = $sthbookseller->fetchrow_hashref; |
381 |
my $databookseller = $sthbookseller->fetchrow_hashref; |
386 |
|
382 |
|
387 |
# parsing branch info |
383 |
my @email; |
388 |
my $userenv = C4::Context->userenv; |
384 |
push @email, $databookseller->{bookselleremail} if $databookseller->{bookselleremail}; |
389 |
parseletter( $letter, 'branches', $userenv->{branch} ); |
385 |
push @email, $databookseller->{contemail} if $databookseller->{contemail}; |
390 |
|
386 |
unless (@email) { |
391 |
# parsing librarian name |
387 |
warn "Bookseller $dataorders->[0]->{booksellerid} without emails"; |
392 |
$letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g; |
388 |
return; |
393 |
$letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g; |
|
|
394 |
$letter->{content} =~ |
395 |
s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g; |
396 |
foreach my $data ( @{$dataorders} ) { |
397 |
if ( $letter->{content} =~ m/(<<.*>>)/ ) { |
398 |
my $line = $1; |
399 |
foreach my $field ( keys %{$data} ) { |
400 |
$line =~ s/(<<[^\.]+.$field>>)/$data->{$field}/; |
401 |
} |
402 |
$letter->{content} =~ s/(<<.*>>)/$line\n$1/; |
403 |
} |
404 |
} |
389 |
} |
405 |
$letter->{content} =~ s/<<[^>]*>>//g; |
390 |
|
406 |
my $innerletter = $letter; |
391 |
# prepare the letter... |
|
|
392 |
my $userenv = C4::Context->userenv; |
393 |
my $letter = GetPreparedLetter ( |
394 |
module => 'claimissues', |
395 |
letter_code => $letter_code, |
396 |
branchcode => $userenv->{branch}, |
397 |
tables => { |
398 |
'branches' => $userenv->{branch}, |
399 |
'aqbooksellers' => $databookseller, |
400 |
}, |
401 |
repeat => $dataorders, |
402 |
want_librarian => 1, |
403 |
) or return; |
407 |
|
404 |
|
408 |
# ... then send mail |
405 |
# ... then send mail |
409 |
if ( $databookseller->{bookselleremail} |
406 |
my $mail_subj = $letter->{title}; |
410 |
|| $databookseller->{contemail} ) { |
407 |
my $mail_msg = $letter->{content}; |
411 |
my $mail_to = $databookseller->{bookselleremail}; |
408 |
$mail_msg ||= q{}; |
412 |
if ($databookseller->{contemail}) { |
409 |
$mail_subj ||= q{}; |
413 |
if (!$mail_to) { |
|
|
414 |
$mail_to = $databookseller->{contemail}; |
415 |
} else { |
416 |
$mail_to .= q|,|; |
417 |
$mail_to .= $databookseller->{contemail}; |
418 |
} |
419 |
} |
420 |
my $mail_subj = $innerletter->{title}; |
421 |
my $mail_msg = $innerletter->{content}; |
422 |
$mail_msg ||= q{}; |
423 |
$mail_subj ||= q{}; |
424 |
|
410 |
|
425 |
my %mail = ( |
411 |
my %mail = ( |
426 |
To => $mail_to, |
412 |
To => join( ','. @email), |
427 |
From => $userenv->{emailaddress}, |
413 |
From => $userenv->{emailaddress}, |
428 |
Subject => $mail_subj, |
414 |
Subject => $mail_subj, |
429 |
Message => $mail_msg, |
415 |
Message => $mail_msg, |
430 |
'Content-Type' => 'text/plain; charset="utf8"', |
416 |
'Content-Type' => 'text/plain; charset="utf8"', |
431 |
); |
417 |
); |
432 |
sendmail(%mail) or carp $Mail::Sendmail::error; |
418 |
sendmail(%mail) or carp $Mail::Sendmail::error; |
433 |
logaction( |
419 |
|
434 |
"ACQUISITION", |
420 |
logaction( |
435 |
"CLAIM ISSUE", |
421 |
"ACQUISITION", |
436 |
undef, |
422 |
"CLAIM ISSUE", |
437 |
"To=" |
423 |
undef, |
438 |
. $databookseller->{contemail} |
424 |
"To=" |
439 |
. " Title=" |
425 |
. $databookseller->{contemail} |
440 |
. $innerletter->{title} |
426 |
. " Title=" |
441 |
. " Content=" |
427 |
. $letter->{title} |
442 |
. $innerletter->{content} |
428 |
. " Content=" |
443 |
) if C4::Context->preference("LetterLog"); |
429 |
. $letter->{content} |
444 |
} |
430 |
) if C4::Context->preference("LetterLog"); |
445 |
} |
431 |
} |
446 |
# send an "account details" notice to a newly created user |
432 |
# send an "account details" notice to a newly created user |
447 |
elsif ( $type eq 'members' ) { |
433 |
elsif ( $type eq 'members' ) { |
448 |
# must parse the password special, before it's hashed. |
|
|
449 |
$letter->{content} =~ s/<<borrowers.password>>/$externalid->{'password'}/g; |
450 |
|
451 |
parseletter( $letter, 'borrowers', $externalid->{'borrowernumber'}); |
452 |
parseletter( $letter, 'branches', $externalid->{'branchcode'} ); |
453 |
|
454 |
my $branchdetails = GetBranchDetail($externalid->{'branchcode'}); |
434 |
my $branchdetails = GetBranchDetail($externalid->{'branchcode'}); |
|
|
435 |
my $letter = GetPreparedLetter ( |
436 |
module => 'members', |
437 |
letter_code => $letter_code, |
438 |
branchcode => $externalid->{'branchcode'}, |
439 |
tables => { |
440 |
'branches' => $branchdetails, |
441 |
'borrowers' => $externalid->{'borrowernumber'}, |
442 |
}, |
443 |
substitute => { 'borrowers.password' => $externalid->{'password'} }, |
444 |
want_librarian => 1, |
445 |
) or return; |
446 |
|
455 |
my %mail = ( |
447 |
my %mail = ( |
456 |
To => $externalid->{'emailaddr'}, |
448 |
To => $externalid->{'emailaddr'}, |
457 |
From => $branchdetails->{'branchemail'} || C4::Context->preference("KohaAdminEmailAddress"), |
449 |
From => $branchdetails->{'branchemail'} || C4::Context->preference("KohaAdminEmailAddress"), |
Lines 463-486
sub SendAlerts {
Link Here
|
463 |
} |
455 |
} |
464 |
} |
456 |
} |
465 |
|
457 |
|
466 |
=head2 parseletter($letter, $table, $pk) |
458 |
=head2 GetPreparedLetter( %params ) |
467 |
|
459 |
|
468 |
parameters : |
460 |
%params hash: |
469 |
- $letter : a hash to letter fields (title & content useful) |
461 |
module => letter module, mandatory |
470 |
- $table : the Koha table to parse. |
462 |
letter_code => letter code, mandatory |
471 |
- $pk : the primary key to query on the $table table |
463 |
branchcode => for letter selection, if missing default system letter taken |
472 |
parse all fields from a table, and replace values in title & content with the appropriate value |
464 |
tables => a hashref with table names as keys. Values are either: |
473 |
(not exported sub, used only internally) |
465 |
- a scalar - primary key value |
|
|
466 |
- an arrayref - primary key values |
467 |
- a hashref - full record |
468 |
substitute => custom substitution key/value pairs |
469 |
repeat => records to be substituted on consecutive lines: |
470 |
- an arrayref - tries to guess what needs substituting by |
471 |
taking remaining << >> tokensr; not recommended |
472 |
- a hashref token => @tables - replaces <token> << >> << >> </token> |
473 |
subtemplate for each @tables row; table is a hashref as above |
474 |
want_librarian => boolean, if set to true triggers librarian details |
475 |
substitution from the userenv |
476 |
Return value: |
477 |
letter fields hashref (title & content useful) |
474 |
|
478 |
|
475 |
=cut |
479 |
=cut |
476 |
|
480 |
|
477 |
our %handles = (); |
481 |
sub GetPreparedLetter { |
478 |
our %columns = (); |
482 |
my %params = @_; |
|
|
483 |
|
484 |
my $module = $params{module} or croak "No module"; |
485 |
my $letter_code = $params{letter_code} or croak "No letter_code"; |
486 |
my $branchcode = $params{branchcode} || ''; |
487 |
|
488 |
my $letter = getletter( $module, $letter_code, $branchcode ) |
489 |
or warn( "No $module $letter_code letter"), |
490 |
return; |
491 |
|
492 |
my $tables = $params{tables}; |
493 |
my $substitute = $params{substitute}; |
494 |
my $repeat = $params{repeat}; |
495 |
$tables || $substitute || $repeat |
496 |
or carp( "ERROR: nothing to substitute - both 'tables' and 'substitute' are empty" ), |
497 |
return; |
498 |
my $want_librarian = $params{want_librarian}; |
499 |
|
500 |
if ($substitute) { |
501 |
while ( my ($token, $val) = each %$substitute ) { |
502 |
$letter->{title} =~ s/<<$token>>/$val/g; |
503 |
$letter->{content} =~ s/<<$token>>/$val/g; |
504 |
} |
505 |
} |
506 |
|
507 |
if ($want_librarian) { |
508 |
# parsing librarian name |
509 |
my $userenv = C4::Context->userenv; |
510 |
$letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go; |
511 |
$letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go; |
512 |
$letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go; |
513 |
} |
514 |
|
515 |
my ($repeat_no_enclosing_tags, $repeat_enclosing_tags); |
516 |
|
517 |
if ($repeat) { |
518 |
if (ref ($repeat) eq 'ARRAY' ) { |
519 |
$repeat_no_enclosing_tags = $repeat; |
520 |
} else { |
521 |
$repeat_enclosing_tags = $repeat; |
522 |
} |
523 |
} |
524 |
|
525 |
if ($repeat_enclosing_tags) { |
526 |
while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) { |
527 |
if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) { |
528 |
my $subcontent = $1; |
529 |
my @lines = map { |
530 |
my %subletter = ( title => '', content => $subcontent ); |
531 |
_substitute_tables( \%subletter, $_ ); |
532 |
$subletter{content}; |
533 |
} @$tag_tables; |
534 |
$letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se; |
535 |
} |
536 |
} |
537 |
} |
538 |
|
539 |
if ($tables) { |
540 |
_substitute_tables( $letter, $tables ); |
541 |
} |
542 |
|
543 |
if ($repeat_no_enclosing_tags) { |
544 |
if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) { |
545 |
my $line = $&; |
546 |
my $i = 1; |
547 |
my @lines = map { |
548 |
my $c = $line; |
549 |
$c =~ s/<<count>>/$i/go; |
550 |
foreach my $field ( keys %{$_} ) { |
551 |
$c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/; |
552 |
} |
553 |
$i++; |
554 |
$c; |
555 |
} @$repeat_no_enclosing_tags; |
556 |
|
557 |
my $replaceby = join( "\n", @lines ); |
558 |
$letter->{content} =~ s/\Q$line\E/$replaceby/s; |
559 |
} |
560 |
} |
561 |
|
562 |
$letter->{content} =~ s/<<\S*>>//go; #remove any stragglers |
563 |
# $letter->{content} =~ s/<<[^>]*>>//go; |
564 |
|
565 |
return $letter; |
566 |
} |
567 |
|
568 |
sub _substitute_tables { |
569 |
my ( $letter, $tables ) = @_; |
570 |
while ( my ($table, $param) = each %$tables ) { |
571 |
next unless $param; |
572 |
|
573 |
my $ref = ref $param; |
479 |
|
574 |
|
480 |
sub parseletter_sth { |
575 |
my $values; |
|
|
576 |
if ($ref && $ref eq 'HASH') { |
577 |
$values = $param; |
578 |
} |
579 |
else { |
580 |
my @pk; |
581 |
my $sth = _parseletter_sth($table); |
582 |
unless ($sth) { |
583 |
warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table."; |
584 |
return; |
585 |
} |
586 |
$sth->execute( $ref ? @$param : $param ); |
587 |
|
588 |
$values = $sth->fetchrow_hashref; |
589 |
} |
590 |
|
591 |
_parseletter ( $letter, $table, $values ); |
592 |
} |
593 |
} |
594 |
|
595 |
my %handles = (); |
596 |
sub _parseletter_sth { |
481 |
my $table = shift; |
597 |
my $table = shift; |
482 |
unless ($table) { |
598 |
unless ($table) { |
483 |
carp "ERROR: parseletter_sth() called without argument (table)"; |
599 |
carp "ERROR: _parseletter_sth() called without argument (table)"; |
484 |
return; |
600 |
return; |
485 |
} |
601 |
} |
486 |
# check cache first |
602 |
# check cache first |
Lines 494-502
sub parseletter_sth {
Link Here
|
494 |
($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" : |
610 |
($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" : |
495 |
($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" : |
611 |
($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" : |
496 |
($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" : |
612 |
($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" : |
497 |
($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" : undef ; |
613 |
($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" : |
|
|
614 |
($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" : |
615 |
($table eq 'opac_news' ) ? "SELECT * FROM $table WHERE idnew = ?" : |
616 |
undef ; |
498 |
unless ($query) { |
617 |
unless ($query) { |
499 |
warn "ERROR: No parseletter_sth query for table '$table'"; |
618 |
warn "ERROR: No _parseletter_sth query for table '$table'"; |
500 |
return; # nothing to get |
619 |
return; # nothing to get |
501 |
} |
620 |
} |
502 |
unless ($handles{$table} = C4::Context->dbh->prepare($query)) { |
621 |
unless ($handles{$table} = C4::Context->dbh->prepare($query)) { |
Lines 506-530
sub parseletter_sth {
Link Here
|
506 |
return $handles{$table}; # now cache is populated for that $table |
625 |
return $handles{$table}; # now cache is populated for that $table |
507 |
} |
626 |
} |
508 |
|
627 |
|
509 |
sub parseletter { |
628 |
=head2 _parseletter($letter, $table, $values) |
510 |
my ( $letter, $table, $pk, $pk2 ) = @_; |
|
|
511 |
unless ($letter) { |
512 |
carp "ERROR: parseletter() 1st argument 'letter' empty"; |
513 |
return; |
514 |
} |
515 |
my $sth = parseletter_sth($table); |
516 |
unless ($sth) { |
517 |
warn "parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table."; |
518 |
return; |
519 |
} |
520 |
if ( $pk2 ) { |
521 |
$sth->execute($pk, $pk2); |
522 |
} else { |
523 |
$sth->execute($pk); |
524 |
} |
525 |
|
629 |
|
526 |
my $values = $sth->fetchrow_hashref; |
630 |
parameters : |
527 |
|
631 |
- $letter : a hash to letter fields (title & content useful) |
|
|
632 |
- $table : the Koha table to parse. |
633 |
- $values : table record hashref |
634 |
parse all fields from a table, and replace values in title & content with the appropriate value |
635 |
(not exported sub, used only internally) |
636 |
|
637 |
=cut |
638 |
|
639 |
my %columns = (); |
640 |
sub _parseletter { |
641 |
my ( $letter, $table, $values ) = @_; |
642 |
|
528 |
# TEMPORARY hack until the expirationdate column is added to reserves |
643 |
# TEMPORARY hack until the expirationdate column is added to reserves |
529 |
if ( $table eq 'reserves' && $values->{'waitingdate'} ) { |
644 |
if ( $table eq 'reserves' && $values->{'waitingdate'} ) { |
530 |
my @waitingdate = split /-/, $values->{'waitingdate'}; |
645 |
my @waitingdate = split /-/, $values->{'waitingdate'}; |
Lines 538-553
sub parseletter {
Link Here
|
538 |
)->output(); |
653 |
)->output(); |
539 |
} |
654 |
} |
540 |
|
655 |
|
|
|
656 |
if ($letter->{content} && $letter->{content} =~ /<<today>>/) { |
657 |
my @da = localtime(); |
658 |
my $todaysdate = "$da[2]:$da[1] " . C4::Dates->today(); |
659 |
$letter->{content} =~ s/<<today>>/$todaysdate/go; |
660 |
} |
541 |
|
661 |
|
542 |
# and get all fields from the table |
662 |
# and get all fields from the table |
543 |
my $columns = C4::Context->dbh->prepare("SHOW COLUMNS FROM $table"); |
663 |
# my $columns = $columns{$table}; |
544 |
$columns->execute; |
664 |
# unless ($columns) { |
545 |
while ( ( my $field ) = $columns->fetchrow_array ) { |
665 |
# $columns = $columns{$table} = C4::Context->dbh->selectcol_arrayref("SHOW COLUMNS FROM $table"); |
546 |
my $replacefield = "<<$table.$field>>"; |
666 |
# } |
547 |
$values->{$field} =~ s/\p{P}(?=$)//g if $values->{$field}; |
667 |
# foreach my $field (@$columns) { |
548 |
my $replacedby = $values->{$field} || ''; |
668 |
|
549 |
($letter->{title} ) and $letter->{title} =~ s/$replacefield/$replacedby/g; |
669 |
while ( my ($field, $val) = each %$values ) { |
550 |
($letter->{content}) and $letter->{content} =~ s/$replacefield/$replacedby/g; |
670 |
my $replacetablefield = "<<$table.$field>>"; |
|
|
671 |
my $replacefield = "<<$field>>"; |
672 |
$val =~ s/\p{P}(?=$)//g if $val; |
673 |
my $replacedby = defined ($val) ? $val : ''; |
674 |
($letter->{title} ) and do { |
675 |
$letter->{title} =~ s/$replacetablefield/$replacedby/g; |
676 |
$letter->{title} =~ s/$replacefield/$replacedby/g; |
677 |
}; |
678 |
($letter->{content}) and do { |
679 |
$letter->{content} =~ s/$replacetablefield/$replacedby/g; |
680 |
$letter->{content} =~ s/$replacefield/$replacedby/g; |
681 |
}; |
682 |
} |
683 |
|
684 |
if ($table eq 'borrowers' && $letter->{content}) { |
685 |
if ( my $attributes = GetBorrowerAttributes($values->{borrowernumber}) ) { |
686 |
my %attr; |
687 |
foreach (@$attributes) { |
688 |
my $code = $_->{code}; |
689 |
my $val = $_->{value_description} || $_->{value}; |
690 |
$val =~ s/\p{P}(?=$)//g if $val; |
691 |
next unless $val gt ''; |
692 |
$attr{$code} ||= []; |
693 |
push @{ $attr{$code} }, $val; |
694 |
} |
695 |
while ( my ($code, $val_ar) = each %attr ) { |
696 |
my $replacefield = "<<borrower-attribute:$code>>"; |
697 |
my $replacedby = join ',', @$val_ar; |
698 |
$letter->{content} =~ s/$replacefield/$replacedby/g; |
699 |
} |
700 |
} |
551 |
} |
701 |
} |
552 |
return $letter; |
702 |
return $letter; |
553 |
} |
703 |
} |
Lines 732-762
returns your letter object, with the content updated.
Link Here
|
732 |
sub _add_attachments { |
882 |
sub _add_attachments { |
733 |
my $params = shift; |
883 |
my $params = shift; |
734 |
|
884 |
|
735 |
return unless 'HASH' eq ref $params; |
885 |
my $letter = $params->{'letter'}; |
736 |
foreach my $required_parameter (qw( letter attachments message )) { |
886 |
my $attachments = $params->{'attachments'}; |
737 |
return unless exists $params->{$required_parameter}; |
887 |
return $letter unless @$attachments; |
738 |
} |
888 |
my $message = $params->{'message'}; |
739 |
return $params->{'letter'} unless @{ $params->{'attachments'} }; |
|
|
740 |
|
889 |
|
741 |
# First, we have to put the body in as the first attachment |
890 |
# First, we have to put the body in as the first attachment |
742 |
$params->{'message'}->attach( |
891 |
$message->attach( |
743 |
Type => 'TEXT', |
892 |
Type => $letter->{'content-type'} || 'TEXT', |
744 |
Data => $params->{'letter'}->{'content'}, |
893 |
Data => $letter->{'is_html'} |
|
|
894 |
? _wrap_html($letter->{'content'}, $letter->{'title'}) |
895 |
: $letter->{'content'}, |
745 |
); |
896 |
); |
746 |
|
897 |
|
747 |
foreach my $attachment ( @{ $params->{'attachments'} } ) { |
898 |
foreach my $attachment ( @$attachments ) { |
748 |
$params->{'message'}->attach( |
899 |
$message->attach( |
749 |
Type => $attachment->{'type'}, |
900 |
Type => $attachment->{'type'}, |
750 |
Data => $attachment->{'content'}, |
901 |
Data => $attachment->{'content'}, |
751 |
Filename => $attachment->{'filename'}, |
902 |
Filename => $attachment->{'filename'}, |
752 |
); |
903 |
); |
753 |
} |
904 |
} |
754 |
# we're forcing list context here to get the header, not the count back from grep. |
905 |
# we're forcing list context here to get the header, not the count back from grep. |
755 |
( $params->{'letter'}->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) ); |
906 |
( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) ); |
756 |
$params->{'letter'}->{'content-type'} =~ s/^Content-Type:\s+//; |
907 |
$letter->{'content-type'} =~ s/^Content-Type:\s+//; |
757 |
$params->{'letter'}->{'content'} = $params->{'message'}->body_as_string; |
908 |
$letter->{'content'} = $message->body_as_string; |
758 |
|
909 |
|
759 |
return $params->{'letter'}; |
910 |
return $letter; |
760 |
|
911 |
|
761 |
} |
912 |
} |
762 |
|
913 |
|
Lines 823-836
sub _send_message_by_email ($;$$$) {
Link Here
|
823 |
|
974 |
|
824 |
my $utf8 = decode('MIME-Header', $message->{'subject'} ); |
975 |
my $utf8 = decode('MIME-Header', $message->{'subject'} ); |
825 |
$message->{subject}= encode('MIME-Header', $utf8); |
976 |
$message->{subject}= encode('MIME-Header', $utf8); |
|
|
977 |
my $subject = encode('utf8', $message->{'subject'}); |
826 |
my $content = encode('utf8', $message->{'content'}); |
978 |
my $content = encode('utf8', $message->{'content'}); |
|
|
979 |
my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"'; |
980 |
my $is_html = $content_type =~ m/html/io; |
827 |
my %sendmail_params = ( |
981 |
my %sendmail_params = ( |
828 |
To => $to_address, |
982 |
To => $to_address, |
829 |
From => $message->{'from_address'} || C4::Context->preference('KohaAdminEmailAddress'), |
983 |
From => $message->{'from_address'} || C4::Context->preference('KohaAdminEmailAddress'), |
830 |
Subject => encode('utf8', $message->{'subject'}), |
984 |
Subject => $subject, |
831 |
charset => 'utf8', |
985 |
charset => 'utf8', |
832 |
Message => $content, |
986 |
Message => $is_html ? _wrap_html($content, $subject) : $content, |
833 |
'content-type' => $message->{'content_type'} || 'text/plain; charset="UTF-8"', |
987 |
'content-type' => $content_type, |
834 |
); |
988 |
); |
835 |
$sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username; |
989 |
$sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username; |
836 |
if ( my $bcc = C4::Context->preference('OverdueNoticeBcc') ) { |
990 |
if ( my $bcc = C4::Context->preference('OverdueNoticeBcc') ) { |
Lines 850-855
sub _send_message_by_email ($;$$$) {
Link Here
|
850 |
} |
1004 |
} |
851 |
} |
1005 |
} |
852 |
|
1006 |
|
|
|
1007 |
sub _wrap_html { |
1008 |
my ($content, $title) = @_; |
1009 |
|
1010 |
my $css = C4::Context->preference("NoticeCSS") || ''; |
1011 |
$css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css; |
1012 |
return <<EOS; |
1013 |
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" |
1014 |
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> |
1015 |
<html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml"> |
1016 |
<head> |
1017 |
<title>$title</title> |
1018 |
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" /> |
1019 |
$css |
1020 |
</head> |
1021 |
<body> |
1022 |
$content |
1023 |
</body> |
1024 |
</html> |
1025 |
EOS |
1026 |
} |
1027 |
|
853 |
sub _send_message_by_sms ($) { |
1028 |
sub _send_message_by_sms ($) { |
854 |
my $message = shift or return undef; |
1029 |
my $message = shift or return undef; |
855 |
my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} ); |
1030 |
my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} ); |