|
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'} ); |