Lines 37-49
use Carp;
Link Here
|
37 |
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
37 |
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
38 |
|
38 |
|
39 |
BEGIN { |
39 |
BEGIN { |
40 |
require Exporter; |
40 |
require Exporter; |
41 |
# set the version for version checking |
41 |
|
|
|
42 |
# set the version for version checking |
42 |
$VERSION = 3.07.00.049; |
43 |
$VERSION = 3.07.00.049; |
43 |
@ISA = qw(Exporter); |
44 |
@ISA = qw(Exporter); |
44 |
@EXPORT = qw( |
45 |
@EXPORT = qw( |
45 |
&GetLetters &GetPreparedLetter &GetWrappedLetter &addalert &getalert &delalert &findrelatedto &SendAlerts &GetPrintMessages |
46 |
&GetLetters &GetPreparedLetter &GetWrappedLetter &addalert &getalert &delalert &findrelatedto &SendAlerts &GetPrintMessages |
46 |
); |
47 |
); |
47 |
} |
48 |
} |
48 |
|
49 |
|
49 |
=head1 NAME |
50 |
=head1 NAME |
Lines 101-107
sub GetLetters {
Link Here
|
101 |
my %letters; |
102 |
my %letters; |
102 |
my $dbh = C4::Context->dbh; |
103 |
my $dbh = C4::Context->dbh; |
103 |
my $sth; |
104 |
my $sth; |
104 |
if (defined $cat) { |
105 |
if ( defined $cat ) { |
105 |
my $query = "SELECT * FROM letter WHERE module = ? ORDER BY name"; |
106 |
my $query = "SELECT * FROM letter WHERE module = ? ORDER BY name"; |
106 |
$sth = $dbh->prepare($query); |
107 |
$sth = $dbh->prepare($query); |
107 |
$sth->execute($cat); |
108 |
$sth->execute($cat); |
Lines 118-147
sub GetLetters {
Link Here
|
118 |
} |
119 |
} |
119 |
|
120 |
|
120 |
my %letter; |
121 |
my %letter; |
|
|
122 |
|
121 |
sub getletter { |
123 |
sub getletter { |
122 |
my ( $module, $code, $branchcode ) = @_; |
124 |
my ( $module, $code, $branchcode ) = @_; |
123 |
|
125 |
|
124 |
$branchcode ||= ''; |
126 |
$branchcode ||= ''; |
125 |
|
127 |
|
126 |
if ( C4::Context->preference('IndependantBranches') |
128 |
if ( C4::Context->preference('IndependantBranches') |
127 |
and $branchcode |
129 |
and $branchcode |
128 |
and C4::Context->userenv ) { |
130 |
and C4::Context->userenv ) |
|
|
131 |
{ |
129 |
|
132 |
|
130 |
$branchcode = C4::Context->userenv->{'branch'}; |
133 |
$branchcode = C4::Context->userenv->{'branch'}; |
131 |
} |
134 |
} |
132 |
|
135 |
|
133 |
if ( my $l = $letter{$module}{$code}{$branchcode} ) { |
136 |
if ( my $l = $letter{$module}{$code}{$branchcode} ) { |
134 |
return { %$l }; # deep copy |
137 |
return {%$l}; # deep copy |
135 |
} |
138 |
} |
136 |
|
139 |
|
137 |
my $dbh = C4::Context->dbh; |
140 |
my $dbh = C4::Context->dbh; |
138 |
my $sth = $dbh->prepare("select * from letter where module=? and code=? and (branchcode = ? or branchcode = '') order by branchcode desc limit 1"); |
141 |
my $sth = $dbh->prepare( |
|
|
142 |
"select * from letter where module=? and code=? and (branchcode = ? or branchcode = '') order by branchcode desc limit 1" |
143 |
); |
139 |
$sth->execute( $module, $code, $branchcode ); |
144 |
$sth->execute( $module, $code, $branchcode ); |
140 |
my $line = $sth->fetchrow_hashref |
145 |
my $line = $sth->fetchrow_hashref |
141 |
or return; |
146 |
or return; |
142 |
$line->{'content-type'} = 'text/html; charset="UTF-8"' if $line->{is_html}; |
147 |
$line->{'content-type'} = 'text/html; charset="UTF-8"' if $line->{is_html}; |
143 |
$letter{$module}{$code}{$branchcode} = $line; |
148 |
$letter{$module}{$code}{$branchcode} = $line; |
144 |
return { %$line }; |
149 |
return {%$line}; |
145 |
} |
150 |
} |
146 |
|
151 |
|
147 |
=head2 addalert ($borrowernumber, $type, $externalid) |
152 |
=head2 addalert ($borrowernumber, $type, $externalid) |
Lines 158-165
sub getletter {
Link Here
|
158 |
sub addalert { |
163 |
sub addalert { |
159 |
my ( $borrowernumber, $type, $externalid ) = @_; |
164 |
my ( $borrowernumber, $type, $externalid ) = @_; |
160 |
my $dbh = C4::Context->dbh; |
165 |
my $dbh = C4::Context->dbh; |
161 |
my $sth = |
166 |
my $sth = $dbh->prepare( |
162 |
$dbh->prepare( |
|
|
163 |
"insert into alert (borrowernumber, type, externalid) values (?,?,?)"); |
167 |
"insert into alert (borrowernumber, type, externalid) values (?,?,?)"); |
164 |
$sth->execute( $borrowernumber, $type, $externalid ); |
168 |
$sth->execute( $borrowernumber, $type, $externalid ); |
165 |
|
169 |
|
Lines 177-183
sub addalert {
Link Here
|
177 |
=cut |
181 |
=cut |
178 |
|
182 |
|
179 |
sub delalert { |
183 |
sub delalert { |
180 |
my $alertid = shift or die "delalert() called without valid argument (alertid)"; # it's gonna die anyway. |
184 |
my $alertid = shift |
|
|
185 |
or die "delalert() called without valid argument (alertid)" |
186 |
; # it's gonna die anyway. |
181 |
$debug and warn "delalert: deleting alertid $alertid"; |
187 |
$debug and warn "delalert: deleting alertid $alertid"; |
182 |
my $sth = C4::Context->dbh->prepare("delete from alert where alertid=?"); |
188 |
my $sth = C4::Context->dbh->prepare("delete from alert where alertid=?"); |
183 |
$sth->execute($alertid); |
189 |
$sth->execute($alertid); |
Lines 195-204
sub delalert {
Link Here
|
195 |
|
201 |
|
196 |
sub getalert { |
202 |
sub getalert { |
197 |
my ( $borrowernumber, $type, $externalid ) = @_; |
203 |
my ( $borrowernumber, $type, $externalid ) = @_; |
198 |
my $dbh = C4::Context->dbh; |
204 |
my $dbh = C4::Context->dbh; |
199 |
my $query = "SELECT a.*, b.branchcode FROM alert a JOIN borrowers b USING(borrowernumber) WHERE"; |
205 |
my $query = |
|
|
206 |
"SELECT a.*, b.branchcode FROM alert a JOIN borrowers b USING(borrowernumber) WHERE"; |
200 |
my @bind; |
207 |
my @bind; |
201 |
if ($borrowernumber and $borrowernumber =~ /^\d+$/) { |
208 |
if ( $borrowernumber and $borrowernumber =~ /^\d+$/ ) { |
202 |
$query .= " borrowernumber=? AND "; |
209 |
$query .= " borrowernumber=? AND "; |
203 |
push @bind, $borrowernumber; |
210 |
push @bind, $borrowernumber; |
204 |
} |
211 |
} |
Lines 213-219
sub getalert {
Link Here
|
213 |
$query =~ s/ AND $//; |
220 |
$query =~ s/ AND $//; |
214 |
my $sth = $dbh->prepare($query); |
221 |
my $sth = $dbh->prepare($query); |
215 |
$sth->execute(@bind); |
222 |
$sth->execute(@bind); |
216 |
return $sth->fetchall_arrayref({}); |
223 |
return $sth->fetchall_arrayref( {} ); |
217 |
} |
224 |
} |
218 |
|
225 |
|
219 |
=head2 findrelatedto($type, $externalid) |
226 |
=head2 findrelatedto($type, $externalid) |
Lines 226-242
sub getalert {
Link Here
|
226 |
When type=issue, the id is related to a subscriptionid and this sub returns the name of the biblio. |
233 |
When type=issue, the id is related to a subscriptionid and this sub returns the name of the biblio. |
227 |
|
234 |
|
228 |
=cut |
235 |
=cut |
229 |
|
236 |
|
230 |
# outmoded POD: |
237 |
# outmoded POD: |
231 |
# When type=virtual, the id is related to a virtual shelf and this sub returns the name of the sub |
238 |
# When type=virtual, the id is related to a virtual shelf and this sub returns the name of the sub |
232 |
|
239 |
|
233 |
sub findrelatedto { |
240 |
sub findrelatedto { |
234 |
my $type = shift or return; |
241 |
my $type = shift or return; |
235 |
my $externalid = shift or return; |
242 |
my $externalid = shift or return; |
236 |
my $q = ($type eq 'issue' ) ? |
243 |
my $q = |
237 |
"select title as result from subscription left join biblio on subscription.biblionumber=biblio.biblionumber where subscriptionid=?" : |
244 |
( $type eq 'issue' ) |
238 |
($type eq 'borrower') ? |
245 |
? "select title as result from subscription left join biblio on subscription.biblionumber=biblio.biblionumber where subscriptionid=?" |
239 |
"select concat(firstname,' ',surname) from borrowers where borrowernumber=?" : undef; |
246 |
: ( $type eq 'borrower' ) |
|
|
247 |
? "select concat(firstname,' ',surname) from borrowers where borrowernumber=?" |
248 |
: undef; |
240 |
unless ($q) { |
249 |
unless ($q) { |
241 |
warn "findrelatedto(): Illegal type '$type'"; |
250 |
warn "findrelatedto(): Illegal type '$type'"; |
242 |
return; |
251 |
return; |
Lines 265-293
sub SendAlerts {
Link Here
|
265 |
|
274 |
|
266 |
# prepare the letter... |
275 |
# prepare the letter... |
267 |
# search the biblionumber |
276 |
# search the biblionumber |
268 |
my $sth = |
277 |
my $sth = $dbh->prepare( |
269 |
$dbh->prepare( |
|
|
270 |
"SELECT biblionumber FROM subscription WHERE subscriptionid=?"); |
278 |
"SELECT biblionumber FROM subscription WHERE subscriptionid=?"); |
271 |
$sth->execute($externalid); |
279 |
$sth->execute($externalid); |
272 |
my ($biblionumber) = $sth->fetchrow |
280 |
my ($biblionumber) = $sth->fetchrow |
273 |
or warn( "No subscription for '$externalid'" ), |
281 |
or warn("No subscription for '$externalid'"), |
274 |
return; |
282 |
return; |
275 |
|
283 |
|
276 |
my %letter; |
284 |
my %letter; |
|
|
285 |
|
277 |
# find the list of borrowers to alert |
286 |
# find the list of borrowers to alert |
278 |
my $alerts = getalert( '', 'issue', $externalid ); |
287 |
my $alerts = getalert( '', 'issue', $externalid ); |
279 |
foreach (@$alerts) { |
288 |
foreach (@$alerts) { |
280 |
|
289 |
|
281 |
my $borinfo = C4::Members::GetMember('borrowernumber' => $_->{'borrowernumber'}); |
290 |
my $borinfo = C4::Members::GetMember( |
|
|
291 |
'borrowernumber' => $_->{'borrowernumber'} ); |
282 |
my $email = $borinfo->{email} or next; |
292 |
my $email = $borinfo->{email} or next; |
283 |
|
293 |
|
284 |
# warn "sending issues..."; |
294 |
# warn "sending issues..."; |
285 |
my $userenv = C4::Context->userenv; |
295 |
my $userenv = C4::Context->userenv; |
286 |
my $letter = GetPreparedLetter ( |
296 |
my $letter = GetPreparedLetter( |
287 |
module => 'serial', |
297 |
module => 'serial', |
288 |
letter_code => $letter_code, |
298 |
letter_code => $letter_code, |
289 |
branchcode => $userenv->{branch}, |
299 |
branchcode => $userenv->{branch}, |
290 |
tables => { |
300 |
tables => { |
291 |
'branches' => $_->{branchcode}, |
301 |
'branches' => $_->{branchcode}, |
292 |
'biblio' => $biblionumber, |
302 |
'biblio' => $biblionumber, |
293 |
'biblioitems' => $biblionumber, |
303 |
'biblioitems' => $biblionumber, |
Lines 303-309
sub SendAlerts {
Link Here
|
303 |
Subject => Encode::encode( "utf8", "" . $letter->{title} ), |
313 |
Subject => Encode::encode( "utf8", "" . $letter->{title} ), |
304 |
Message => Encode::encode( "utf8", "" . $letter->{content} ), |
314 |
Message => Encode::encode( "utf8", "" . $letter->{content} ), |
305 |
'Content-Type' => 'text/plain; charset="utf8"', |
315 |
'Content-Type' => 'text/plain; charset="utf8"', |
306 |
); |
316 |
); |
307 |
sendmail(%mail) or carp $Mail::Sendmail::error; |
317 |
sendmail(%mail) or carp $Mail::Sendmail::error; |
308 |
} |
318 |
} |
309 |
} |
319 |
} |
Lines 311-318
sub SendAlerts {
Link Here
|
311 |
|
321 |
|
312 |
# prepare the letter... |
322 |
# prepare the letter... |
313 |
# search the biblionumber |
323 |
# search the biblionumber |
314 |
my $strsth = $type eq 'claimacquisition' |
324 |
my $strsth = $type eq 'claimacquisition' |
315 |
? qq{ |
325 |
? qq{ |
316 |
SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*,aqbooksellers.*, |
326 |
SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*,aqbooksellers.*, |
317 |
aqbooksellers.id AS booksellerid |
327 |
aqbooksellers.id AS booksellerid |
318 |
FROM aqorders |
328 |
FROM aqorders |
Lines 322-328
sub SendAlerts {
Link Here
|
322 |
LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id |
332 |
LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id |
323 |
WHERE aqorders.ordernumber IN ( |
333 |
WHERE aqorders.ordernumber IN ( |
324 |
} |
334 |
} |
325 |
: qq{ |
335 |
: qq{ |
326 |
SELECT serial.*,subscription.*, biblio.*, aqbooksellers.*, |
336 |
SELECT serial.*,subscription.*, biblio.*, aqbooksellers.*, |
327 |
aqbooksellers.id AS booksellerid |
337 |
aqbooksellers.id AS booksellerid |
328 |
FROM serial |
338 |
FROM serial |
Lines 342-373
sub SendAlerts {
Link Here
|
342 |
my $databookseller = $sthbookseller->fetchrow_hashref; |
352 |
my $databookseller = $sthbookseller->fetchrow_hashref; |
343 |
|
353 |
|
344 |
my @email; |
354 |
my @email; |
345 |
push @email, $databookseller->{bookselleremail} if $databookseller->{bookselleremail}; |
355 |
push @email, $databookseller->{bookselleremail} |
346 |
push @email, $databookseller->{contemail} if $databookseller->{contemail}; |
356 |
if $databookseller->{bookselleremail}; |
|
|
357 |
push @email, $databookseller->{contemail} |
358 |
if $databookseller->{contemail}; |
347 |
unless (@email) { |
359 |
unless (@email) { |
348 |
warn "Bookseller $dataorders->[0]->{booksellerid} without emails"; |
360 |
warn "Bookseller $dataorders->[0]->{booksellerid} without emails"; |
349 |
return { error => "no_email" }; |
361 |
return { error => "no_email" }; |
350 |
} |
362 |
} |
351 |
|
363 |
|
352 |
my $userenv = C4::Context->userenv; |
364 |
my $userenv = C4::Context->userenv; |
353 |
my $letter = GetPreparedLetter ( |
365 |
my $letter = GetPreparedLetter( |
354 |
module => $type, |
366 |
module => $type, |
355 |
letter_code => $letter_code, |
367 |
letter_code => $letter_code, |
356 |
branchcode => $userenv->{branch}, |
368 |
branchcode => $userenv->{branch}, |
357 |
tables => { |
369 |
tables => { |
358 |
'branches' => $userenv->{branch}, |
370 |
'branches' => $userenv->{branch}, |
359 |
'aqbooksellers' => $databookseller, |
371 |
'aqbooksellers' => $databookseller, |
360 |
}, |
372 |
}, |
361 |
repeat => $dataorders, |
373 |
repeat => $dataorders, |
362 |
want_librarian => 1, |
374 |
want_librarian => 1, |
363 |
) or return; |
375 |
) or return; |
364 |
|
376 |
|
365 |
# ... then send mail |
377 |
# ... then send mail |
366 |
my %mail = ( |
378 |
my %mail = ( |
367 |
To => join( ',', @email), |
379 |
To => join( ',', @email ), |
368 |
From => $userenv->{emailaddress}, |
380 |
From => $userenv->{emailaddress}, |
369 |
Subject => Encode::encode( "utf8", "" . $letter->{title} ), |
381 |
Subject => Encode::encode( "utf8", "" . $letter->{title} ), |
370 |
Message => Encode::encode( "utf8", "" . $letter->{content} ), |
382 |
Message => Encode::encode( "utf8", "" . $letter->{content} ), |
371 |
'Content-Type' => 'text/plain; charset="utf8"', |
383 |
'Content-Type' => 'text/plain; charset="utf8"', |
372 |
); |
384 |
); |
373 |
sendmail(%mail) or carp $Mail::Sendmail::error; |
385 |
sendmail(%mail) or carp $Mail::Sendmail::error; |
Lines 377-398
sub SendAlerts {
Link Here
|
377 |
$type eq 'claimissues' ? "CLAIM ISSUE" : "ACQUISITION CLAIM", |
389 |
$type eq 'claimissues' ? "CLAIM ISSUE" : "ACQUISITION CLAIM", |
378 |
undef, |
390 |
undef, |
379 |
"To=" |
391 |
"To=" |
380 |
. $databookseller->{contemail} |
392 |
. $databookseller->{contemail} |
381 |
. " Title=" |
393 |
. " Title=" |
382 |
. $letter->{title} |
394 |
. $letter->{title} |
383 |
. " Content=" |
395 |
. " Content=" |
384 |
. $letter->{content} |
396 |
. $letter->{content} |
385 |
) if C4::Context->preference("LetterLog"); |
397 |
) if C4::Context->preference("LetterLog"); |
386 |
} |
398 |
} |
387 |
# send an "account details" notice to a newly created user |
399 |
|
|
|
400 |
# send an "account details" notice to a newly created user |
388 |
elsif ( $type eq 'members' ) { |
401 |
elsif ( $type eq 'members' ) { |
389 |
my $branchdetails = GetBranchDetail($externalid->{'branchcode'}); |
402 |
my $branchdetails = GetBranchDetail( $externalid->{'branchcode'} ); |
390 |
my $letter = GetPreparedLetter ( |
403 |
my $letter = GetPreparedLetter( |
391 |
module => 'members', |
404 |
module => 'members', |
392 |
letter_code => $letter_code, |
405 |
letter_code => $letter_code, |
393 |
branchcode => $externalid->{'branchcode'}, |
406 |
branchcode => $externalid->{'branchcode'}, |
394 |
tables => { |
407 |
tables => { |
395 |
'branches' => $branchdetails, |
408 |
'branches' => $branchdetails, |
396 |
'borrowers' => $externalid->{'borrowernumber'}, |
409 |
'borrowers' => $externalid->{'borrowernumber'}, |
397 |
}, |
410 |
}, |
398 |
substitute => { 'borrowers.password' => $externalid->{'password'} }, |
411 |
substitute => { 'borrowers.password' => $externalid->{'password'} }, |
Lines 401-411
sub SendAlerts {
Link Here
|
401 |
|
414 |
|
402 |
return { error => "no_email" } unless $externalid->{'emailaddr'}; |
415 |
return { error => "no_email" } unless $externalid->{'emailaddr'}; |
403 |
my %mail = ( |
416 |
my %mail = ( |
404 |
To => $externalid->{'emailaddr'}, |
417 |
To => $externalid->{'emailaddr'}, |
405 |
From => $branchdetails->{'branchemail'} || C4::Context->preference("KohaAdminEmailAddress"), |
418 |
From => $branchdetails->{'branchemail'} |
406 |
Subject => Encode::encode( "utf8", $letter->{'title'} ), |
419 |
|| C4::Context->preference("KohaAdminEmailAddress"), |
407 |
Message => Encode::encode( "utf8", $letter->{'content'} ), |
420 |
Subject => Encode::encode( "utf8", $letter->{'title'} ), |
408 |
'Content-Type' => 'text/plain; charset="utf8"', |
421 |
Message => Encode::encode( "utf8", $letter->{'content'} ), |
|
|
422 |
'Content-Type' => 'text/plain; charset="utf8"', |
409 |
); |
423 |
); |
410 |
sendmail(%mail) or carp $Mail::Sendmail::error; |
424 |
sendmail(%mail) or carp $Mail::Sendmail::error; |
411 |
} |
425 |
} |
Lines 437-491
sub SendAlerts {
Link Here
|
437 |
sub GetPreparedLetter { |
451 |
sub GetPreparedLetter { |
438 |
my %params = @_; |
452 |
my %params = @_; |
439 |
|
453 |
|
440 |
my $module = $params{module} or croak "No module"; |
454 |
my $module = $params{module} or croak "No module"; |
441 |
my $letter_code = $params{letter_code} or croak "No letter_code"; |
455 |
my $letter_code = $params{letter_code} or croak "No letter_code"; |
442 |
my $branchcode = $params{branchcode} || ''; |
456 |
my $branchcode = $params{branchcode} || ''; |
443 |
|
457 |
|
444 |
my $letter = getletter( $module, $letter_code, $branchcode ) |
458 |
my $letter = getletter( $module, $letter_code, $branchcode ) |
445 |
or warn( "No $module $letter_code letter"), |
459 |
or warn("No $module $letter_code letter"), |
446 |
return; |
460 |
return; |
447 |
|
461 |
|
448 |
my $tables = $params{tables}; |
462 |
my $tables = $params{tables}; |
449 |
my $substitute = $params{substitute}; |
463 |
my $substitute = $params{substitute}; |
450 |
my $repeat = $params{repeat}; |
464 |
my $repeat = $params{repeat}; |
451 |
$tables || $substitute || $repeat |
465 |
$tables || $substitute || $repeat |
452 |
or carp( "ERROR: nothing to substitute - both 'tables' and 'substitute' are empty" ), |
466 |
or carp( |
453 |
return; |
467 |
"ERROR: nothing to substitute - both 'tables' and 'substitute' are empty" |
|
|
468 |
), |
469 |
return; |
454 |
my $want_librarian = $params{want_librarian}; |
470 |
my $want_librarian = $params{want_librarian}; |
455 |
|
471 |
|
456 |
if ($substitute) { |
472 |
if ($substitute) { |
457 |
while ( my ($token, $val) = each %$substitute ) { |
473 |
while ( my ( $token, $val ) = each %$substitute ) { |
458 |
$letter->{title} =~ s/<<$token>>/$val/g; |
474 |
$letter->{title} =~ s/<<$token>>/$val/g; |
459 |
$letter->{content} =~ s/<<$token>>/$val/g; |
475 |
$letter->{content} =~ s/<<$token>>/$val/g; |
460 |
} |
476 |
} |
461 |
} |
477 |
} |
462 |
|
478 |
|
463 |
my $OPACBaseURL = C4::Context->preference('OPACBaseURL'); |
479 |
my $OPACBaseURL = C4::Context->preference('OPACBaseURL'); |
464 |
$letter->{content} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go; |
480 |
$letter->{content} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go; |
465 |
|
481 |
|
466 |
if ($want_librarian) { |
482 |
if ($want_librarian) { |
|
|
483 |
|
467 |
# parsing librarian name |
484 |
# parsing librarian name |
468 |
my $userenv = C4::Context->userenv; |
485 |
my $userenv = C4::Context->userenv; |
469 |
$letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go; |
486 |
$letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go; |
470 |
$letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go; |
487 |
$letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go; |
471 |
$letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go; |
488 |
$letter->{content} =~ |
|
|
489 |
s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go; |
472 |
} |
490 |
} |
473 |
|
491 |
|
474 |
my ($repeat_no_enclosing_tags, $repeat_enclosing_tags); |
492 |
my ( $repeat_no_enclosing_tags, $repeat_enclosing_tags ); |
475 |
|
493 |
|
476 |
if ($repeat) { |
494 |
if ($repeat) { |
477 |
if (ref ($repeat) eq 'ARRAY' ) { |
495 |
if ( ref($repeat) eq 'ARRAY' ) { |
478 |
$repeat_no_enclosing_tags = $repeat; |
496 |
$repeat_no_enclosing_tags = $repeat; |
479 |
} else { |
497 |
} |
|
|
498 |
else { |
480 |
$repeat_enclosing_tags = $repeat; |
499 |
$repeat_enclosing_tags = $repeat; |
481 |
} |
500 |
} |
482 |
} |
501 |
} |
483 |
|
502 |
|
484 |
if ($repeat_enclosing_tags) { |
503 |
if ($repeat_enclosing_tags) { |
485 |
while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) { |
504 |
while ( my ( $tag, $tag_tables ) = each %$repeat_enclosing_tags ) { |
486 |
if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) { |
505 |
if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) { |
487 |
my $subcontent = $1; |
506 |
my $subcontent = $1; |
488 |
my @lines = map { |
507 |
my @lines = map { |
489 |
my %subletter = ( title => '', content => $subcontent ); |
508 |
my %subletter = ( title => '', content => $subcontent ); |
490 |
_substitute_tables( \%subletter, $_ ); |
509 |
_substitute_tables( \%subletter, $_ ); |
491 |
$subletter{content}; |
510 |
$subletter{content}; |
Lines 501-508
sub GetPreparedLetter {
Link Here
|
501 |
|
520 |
|
502 |
if ($repeat_no_enclosing_tags) { |
521 |
if ($repeat_no_enclosing_tags) { |
503 |
if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) { |
522 |
if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) { |
504 |
my $line = $&; |
523 |
my $line = $&; |
505 |
my $i = 1; |
524 |
my $i = 1; |
506 |
my @lines = map { |
525 |
my @lines = map { |
507 |
my $c = $line; |
526 |
my $c = $line; |
508 |
$c =~ s/<<count>>/$i/go; |
527 |
$c =~ s/<<count>>/$i/go; |
Lines 518-545
sub GetPreparedLetter {
Link Here
|
518 |
} |
537 |
} |
519 |
} |
538 |
} |
520 |
|
539 |
|
521 |
$letter->{content} =~ s/<<\S*>>//go; #remove any stragglers |
540 |
$letter->{content} =~ s/<<\S*>>//go; #remove any stragglers |
522 |
# $letter->{content} =~ s/<<[^>]*>>//go; |
541 |
|
|
|
542 |
# $letter->{content} =~ s/<<[^>]*>>//go; |
523 |
|
543 |
|
524 |
return $letter; |
544 |
return $letter; |
525 |
} |
545 |
} |
526 |
|
546 |
|
527 |
sub _substitute_tables { |
547 |
sub _substitute_tables { |
528 |
my ( $letter, $tables ) = @_; |
548 |
my ( $letter, $tables ) = @_; |
529 |
while ( my ($table, $param) = each %$tables ) { |
549 |
while ( my ( $table, $param ) = each %$tables ) { |
530 |
next unless $param; |
550 |
next unless $param; |
531 |
|
551 |
|
532 |
my $ref = ref $param; |
552 |
my $ref = ref $param; |
533 |
|
553 |
|
534 |
my $values; |
554 |
my $values; |
535 |
if ($ref && $ref eq 'HASH') { |
555 |
if ( $ref && $ref eq 'HASH' ) { |
536 |
$values = $param; |
556 |
$values = $param; |
537 |
} |
557 |
} |
538 |
else { |
558 |
else { |
539 |
my @pk; |
559 |
my @pk; |
540 |
my $sth = _parseletter_sth($table); |
560 |
my $sth = _parseletter_sth($table); |
541 |
unless ($sth) { |
561 |
unless ($sth) { |
542 |
warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table."; |
562 |
warn |
|
|
563 |
"_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table."; |
543 |
return; |
564 |
return; |
544 |
} |
565 |
} |
545 |
$sth->execute( $ref ? @$param : $param ); |
566 |
$sth->execute( $ref ? @$param : $param ); |
Lines 547-585
sub _substitute_tables {
Link Here
|
547 |
$values = $sth->fetchrow_hashref; |
568 |
$values = $sth->fetchrow_hashref; |
548 |
} |
569 |
} |
549 |
|
570 |
|
550 |
_parseletter ( $letter, $table, $values ); |
571 |
_parseletter( $letter, $table, $values ); |
551 |
} |
572 |
} |
552 |
} |
573 |
} |
553 |
|
574 |
|
554 |
my %handles = (); |
575 |
my %handles = (); |
|
|
576 |
|
555 |
sub _parseletter_sth { |
577 |
sub _parseletter_sth { |
556 |
my $table = shift; |
578 |
my $table = shift; |
557 |
unless ($table) { |
579 |
unless ($table) { |
558 |
carp "ERROR: _parseletter_sth() called without argument (table)"; |
580 |
carp "ERROR: _parseletter_sth() called without argument (table)"; |
559 |
return; |
581 |
return; |
560 |
} |
582 |
} |
|
|
583 |
|
561 |
# check cache first |
584 |
# check cache first |
562 |
(defined $handles{$table}) and return $handles{$table}; |
585 |
( defined $handles{$table} ) and return $handles{$table}; |
563 |
my $query = |
586 |
my $query = |
564 |
($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" : |
587 |
( $table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" |
565 |
($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" : |
588 |
: ( $table eq 'biblioitems' ) |
566 |
($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" : |
589 |
? "SELECT * FROM $table WHERE biblionumber = ?" |
567 |
($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" : |
590 |
: ( $table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" |
568 |
($table eq 'old_issues' ) ? "SELECT * FROM $table WHERE itemnumber = ? ORDER BY timestamp DESC LIMIT 1" : |
591 |
: ( $table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" |
569 |
($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" : |
592 |
: ( $table eq 'old_issues' ) |
570 |
($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" : |
593 |
? "SELECT * FROM $table WHERE itemnumber = ? ORDER BY timestamp DESC LIMIT 1" |
571 |
($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" : |
594 |
: ( $table eq 'reserves' ) |
572 |
($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" : |
595 |
? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" |
573 |
($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" : |
596 |
: ( $table eq 'borrowers' ) |
574 |
($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" : |
597 |
? "SELECT * FROM $table WHERE borrowernumber = ?" |
575 |
($table eq 'opac_news' ) ? "SELECT * FROM $table WHERE idnew = ?" : |
598 |
: ( $table eq 'branches' ) |
576 |
($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE borrowernumber = ? OR verification_token =?": |
599 |
? "SELECT * FROM $table WHERE branchcode = ?" |
577 |
undef ; |
600 |
: ( $table eq 'suggestions' ) |
|
|
601 |
? "SELECT * FROM $table WHERE suggestionid = ?" |
602 |
: ( $table eq 'aqbooksellers' ) |
603 |
? "SELECT * FROM $table WHERE id = ?" |
604 |
: ( $table eq 'aqorders' ) |
605 |
? "SELECT * FROM $table WHERE ordernumber = ?" |
606 |
: ( $table eq 'opac_news' ) |
607 |
? "SELECT * FROM $table WHERE idnew = ?" |
608 |
: ( $table eq 'borrower_modifications' ) |
609 |
? "SELECT * FROM $table WHERE borrowernumber = ? OR verification_token =?" |
610 |
: undef; |
578 |
unless ($query) { |
611 |
unless ($query) { |
579 |
warn "ERROR: No _parseletter_sth query for table '$table'"; |
612 |
warn "ERROR: No _parseletter_sth query for table '$table'"; |
580 |
return; # nothing to get |
613 |
return; # nothing to get |
581 |
} |
614 |
} |
582 |
unless ($handles{$table} = C4::Context->dbh->prepare($query)) { |
615 |
unless ( $handles{$table} = C4::Context->dbh->prepare($query) ) { |
583 |
warn "ERROR: Failed to prepare query: '$query'"; |
616 |
warn "ERROR: Failed to prepare query: '$query'"; |
584 |
return; |
617 |
return; |
585 |
} |
618 |
} |
Lines 598-603
sub _parseletter_sth {
Link Here
|
598 |
=cut |
631 |
=cut |
599 |
|
632 |
|
600 |
my %columns = (); |
633 |
my %columns = (); |
|
|
634 |
|
601 |
sub _parseletter { |
635 |
sub _parseletter { |
602 |
my ( $letter, $table, $values ) = @_; |
636 |
my ( $letter, $table, $values ) = @_; |
603 |
|
637 |
|
Lines 608-655
sub _parseletter {
Link Here
|
608 |
$dt->add( days => C4::Context->preference('ReservesMaxPickUpDelay') ); |
642 |
$dt->add( days => C4::Context->preference('ReservesMaxPickUpDelay') ); |
609 |
$values->{'expirationdate'} = output_pref( $dt, undef, 1 ); |
643 |
$values->{'expirationdate'} = output_pref( $dt, undef, 1 ); |
610 |
|
644 |
|
611 |
$values->{'waitingdate'} = output_pref( dt_from_string( $values->{'waitingdate'} ), undef, 1 ); |
645 |
$values->{'waitingdate'} = |
|
|
646 |
output_pref( dt_from_string( $values->{'waitingdate'} ), undef, 1 ); |
612 |
|
647 |
|
613 |
} |
648 |
} |
614 |
|
649 |
|
615 |
if ($letter->{content} && $letter->{content} =~ /<<today>>/) { |
650 |
if ( $letter->{content} && $letter->{content} =~ /<<today>>/ ) { |
616 |
my $todaysdate = output_pref( DateTime->now() ); |
651 |
my $todaysdate = output_pref( DateTime->now() ); |
617 |
$letter->{content} =~ s/<<today>>/$todaysdate/go; |
652 |
$letter->{content} =~ s/<<today>>/$todaysdate/go; |
618 |
} |
653 |
} |
619 |
|
654 |
|
620 |
while ( my ($field, $val) = each %$values ) { |
655 |
my @dates = qq| |
|
|
656 |
issues.date_due issues.returndate issues.issuedate issues.lastreneweddate |
657 |
old_issues.date_due old_issues.returndate old_issues.issuedate old_issues.lastreneweddate |
658 |
|; |
659 |
|
660 |
while ( my ( $field, $val ) = each %$values ) { |
661 |
|
662 |
# Bug 9084 - Dates in notices should be formatted |
663 |
# according to dateformat system preference |
664 |
my $match = "$table.$field"; |
665 |
if ( grep /$match/, @dates ) { |
666 |
|
667 |
# display syspref formatted date, and strip time |
668 |
my $dateonly = 1; |
669 |
$val = output_pref( dt_from_string($val), undef, undef, $dateonly ); |
670 |
} |
671 |
|
621 |
my $replacetablefield = "<<$table.$field>>"; |
672 |
my $replacetablefield = "<<$table.$field>>"; |
622 |
my $replacefield = "<<$field>>"; |
673 |
my $replacefield = "<<$field>>"; |
623 |
$val =~ s/\p{P}$// if $val && $table=~/biblio/; |
674 |
$val =~ s/\p{P}$// if $val && $table =~ /biblio/; |
624 |
#BZ 9886: Assuming that we want to eliminate ISBD punctuation here |
675 |
|
625 |
#Therefore adding the test on biblio. This includes biblioitems, |
676 |
#BZ 9886: Assuming that we want to eliminate ISBD punctuation here |
626 |
#but excludes items. Removed unneeded global and lookahead. |
677 |
#Therefore adding the test on biblio. This includes biblioitems, |
627 |
|
678 |
#but excludes items. Removed unneeded global and lookahead. |
628 |
my $replacedby = defined ($val) ? $val : ''; |
679 |
|
629 |
($letter->{title} ) and do { |
680 |
my $replacedby = defined($val) ? $val : ''; |
630 |
$letter->{title} =~ s/$replacetablefield/$replacedby/g; |
681 |
( $letter->{title} ) and do { |
631 |
$letter->{title} =~ s/$replacefield/$replacedby/g; |
682 |
$letter->{title} =~ s/$replacetablefield/$replacedby/g; |
|
|
683 |
$letter->{title} =~ s/$replacefield/$replacedby/g; |
632 |
}; |
684 |
}; |
633 |
($letter->{content}) and do { |
685 |
( $letter->{content} ) and do { |
634 |
$letter->{content} =~ s/$replacetablefield/$replacedby/g; |
686 |
$letter->{content} =~ s/$replacetablefield/$replacedby/g; |
635 |
$letter->{content} =~ s/$replacefield/$replacedby/g; |
687 |
$letter->{content} =~ s/$replacefield/$replacedby/g; |
636 |
}; |
688 |
}; |
637 |
} |
689 |
} |
638 |
|
690 |
|
639 |
if ($table eq 'borrowers' && $letter->{content}) { |
691 |
if ( $table eq 'borrowers' && $letter->{content} ) { |
640 |
if ( my $attributes = GetBorrowerAttributes($values->{borrowernumber}) ) { |
692 |
if ( my $attributes = |
|
|
693 |
GetBorrowerAttributes( $values->{borrowernumber} ) ) |
694 |
{ |
641 |
my %attr; |
695 |
my %attr; |
642 |
foreach (@$attributes) { |
696 |
foreach (@$attributes) { |
643 |
my $code = $_->{code}; |
697 |
my $code = $_->{code}; |
644 |
my $val = $_->{value_description} || $_->{value}; |
698 |
my $val = $_->{value_description} || $_->{value}; |
645 |
$val =~ s/\p{P}(?=$)//g if $val; |
699 |
$val =~ s/\p{P}(?=$)//g if $val; |
646 |
next unless $val gt ''; |
700 |
next unless $val gt ''; |
647 |
$attr{$code} ||= []; |
701 |
$attr{$code} ||= []; |
648 |
push @{ $attr{$code} }, $val; |
702 |
push @{ $attr{$code} }, $val; |
649 |
} |
703 |
} |
650 |
while ( my ($code, $val_ar) = each %attr ) { |
704 |
while ( my ( $code, $val_ar ) = each %attr ) { |
651 |
my $replacefield = "<<borrower-attribute:$code>>"; |
705 |
my $replacefield = "<<borrower-attribute:$code>>"; |
652 |
my $replacedby = join ',', @$val_ar; |
706 |
my $replacedby = join ',', @$val_ar; |
653 |
$letter->{content} =~ s/$replacefield/$replacedby/g; |
707 |
$letter->{content} =~ s/$replacefield/$replacedby/g; |
654 |
} |
708 |
} |
655 |
} |
709 |
} |
Lines 674-684
sub EnqueueLetter {
Link Here
|
674 |
my $params = shift or return; |
728 |
my $params = shift or return; |
675 |
|
729 |
|
676 |
return unless exists $params->{'letter'}; |
730 |
return unless exists $params->{'letter'}; |
677 |
# return unless exists $params->{'borrowernumber'}; |
731 |
|
|
|
732 |
# return unless exists $params->{'borrowernumber'}; |
678 |
return unless exists $params->{'message_transport_type'}; |
733 |
return unless exists $params->{'message_transport_type'}; |
679 |
|
734 |
|
680 |
my $content = $params->{letter}->{content}; |
735 |
my $content = $params->{letter}->{content}; |
681 |
$content =~ s/\s+//g if(defined $content); |
736 |
$content =~ s/\s+//g if ( defined $content ); |
682 |
if ( not defined $content or $content eq '' ) { |
737 |
if ( not defined $content or $content eq '' ) { |
683 |
warn "Trying to add an empty message to the message queue" if $debug; |
738 |
warn "Trying to add an empty message to the message queue" if $debug; |
684 |
return; |
739 |
return; |
Lines 687-693
sub EnqueueLetter {
Link Here
|
687 |
# If we have any attachments we should encode then into the body. |
742 |
# If we have any attachments we should encode then into the body. |
688 |
if ( $params->{'attachments'} ) { |
743 |
if ( $params->{'attachments'} ) { |
689 |
$params->{'letter'} = _add_attachments( |
744 |
$params->{'letter'} = _add_attachments( |
690 |
{ letter => $params->{'letter'}, |
745 |
{ |
|
|
746 |
letter => $params->{'letter'}, |
691 |
attachments => $params->{'attachments'}, |
747 |
attachments => $params->{'attachments'}, |
692 |
message => MIME::Lite->new( Type => 'multipart/mixed' ), |
748 |
message => MIME::Lite->new( Type => 'multipart/mixed' ), |
693 |
} |
749 |
} |
Lines 704-721
ENDSQL
Link Here
|
704 |
|
760 |
|
705 |
my $sth = $dbh->prepare($statement); |
761 |
my $sth = $dbh->prepare($statement); |
706 |
my $result = $sth->execute( |
762 |
my $result = $sth->execute( |
707 |
$params->{'borrowernumber'}, # borrowernumber |
763 |
$params->{'borrowernumber'}, # borrowernumber |
708 |
$params->{'letter'}->{'title'}, # subject |
764 |
$params->{'letter'}->{'title'}, # subject |
709 |
$params->{'letter'}->{'content'}, # content |
765 |
$params->{'letter'}->{'content'}, # content |
710 |
$params->{'letter'}->{'metadata'} || '', # metadata |
766 |
$params->{'letter'}->{'metadata'} || '', # metadata |
711 |
$params->{'letter'}->{'code'} || '', # letter_code |
767 |
$params->{'letter'}->{'code'} || '', # letter_code |
712 |
$params->{'message_transport_type'}, # message_transport_type |
768 |
$params->{'message_transport_type'}, # message_transport_type |
713 |
'pending', # status |
769 |
'pending', # status |
714 |
$params->{'to_address'}, # to_address |
770 |
$params->{'to_address'}, # to_address |
715 |
$params->{'from_address'}, # from_address |
771 |
$params->{'from_address'}, # from_address |
716 |
$params->{'letter'}->{'content-type'}, # content_type |
772 |
$params->{'letter'}->{'content-type'}, # content_type |
717 |
); |
773 |
); |
718 |
return $dbh->last_insert_id(undef,undef,'message_queue', undef); |
774 |
return $dbh->last_insert_id( undef, undef, 'message_queue', undef ); |
719 |
} |
775 |
} |
720 |
|
776 |
|
721 |
=head2 SendQueuedMessages ([$hashref]) |
777 |
=head2 SendQueuedMessages ([$hashref]) |
Lines 732-753
sub SendQueuedMessages {
Link Here
|
732 |
my $params = shift; |
788 |
my $params = shift; |
733 |
|
789 |
|
734 |
my $unsent_messages = _get_unsent_messages(); |
790 |
my $unsent_messages = _get_unsent_messages(); |
735 |
MESSAGE: foreach my $message ( @$unsent_messages ) { |
791 |
MESSAGE: foreach my $message (@$unsent_messages) { |
|
|
792 |
|
736 |
# warn Data::Dumper->Dump( [ $message ], [ 'message' ] ); |
793 |
# warn Data::Dumper->Dump( [ $message ], [ 'message' ] ); |
737 |
warn sprintf( 'sending %s message to patron: %s', |
794 |
warn sprintf( |
738 |
$message->{'message_transport_type'}, |
795 |
'sending %s message to patron: %s', |
739 |
$message->{'borrowernumber'} || 'Admin' ) |
796 |
$message->{'message_transport_type'}, |
740 |
if $params->{'verbose'} or $debug; |
797 |
$message->{'borrowernumber'} || 'Admin' |
|
|
798 |
) |
799 |
if $params->{'verbose'} |
800 |
or $debug; |
801 |
|
741 |
# This is just begging for subclassing |
802 |
# This is just begging for subclassing |
742 |
next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' ); |
803 |
next MESSAGE if ( lc( $message->{'message_transport_type'} ) eq 'rss' ); |
743 |
if ( lc( $message->{'message_transport_type'} ) eq 'email' ) { |
804 |
if ( lc( $message->{'message_transport_type'} ) eq 'email' ) { |
744 |
_send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} ); |
805 |
_send_message_by_email( $message, $params->{'username'}, |
|
|
806 |
$params->{'password'}, $params->{'method'} ); |
745 |
} |
807 |
} |
746 |
elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) { |
808 |
elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) { |
747 |
_send_message_by_sms( $message ); |
809 |
_send_message_by_sms($message); |
748 |
} |
810 |
} |
749 |
} |
811 |
} |
750 |
return scalar( @$unsent_messages ); |
812 |
return scalar(@$unsent_messages); |
751 |
} |
813 |
} |
752 |
|
814 |
|
753 |
=head2 GetRSSMessages |
815 |
=head2 GetRSSMessages |
Lines 764-773
sub GetRSSMessages {
Link Here
|
764 |
return unless $params; |
826 |
return unless $params; |
765 |
return unless ref $params; |
827 |
return unless ref $params; |
766 |
return unless $params->{'borrowernumber'}; |
828 |
return unless $params->{'borrowernumber'}; |
767 |
|
829 |
|
768 |
return _get_unsent_messages( { message_transport_type => 'rss', |
830 |
return _get_unsent_messages( |
769 |
limit => $params->{'limit'}, |
831 |
{ |
770 |
borrowernumber => $params->{'borrowernumber'}, } ); |
832 |
message_transport_type => 'rss', |
|
|
833 |
limit => $params->{'limit'}, |
834 |
borrowernumber => $params->{'borrowernumber'}, |
835 |
} |
836 |
); |
771 |
} |
837 |
} |
772 |
|
838 |
|
773 |
=head2 GetPrintMessages |
839 |
=head2 GetPrintMessages |
Lines 781-790
person).
Link Here
|
781 |
|
847 |
|
782 |
sub GetPrintMessages { |
848 |
sub GetPrintMessages { |
783 |
my $params = shift || {}; |
849 |
my $params = shift || {}; |
784 |
|
850 |
|
785 |
return _get_unsent_messages( { message_transport_type => 'print', |
851 |
return _get_unsent_messages( |
786 |
borrowernumber => $params->{'borrowernumber'}, |
852 |
{ |
787 |
} ); |
853 |
message_transport_type => 'print', |
|
|
854 |
borrowernumber => $params->{'borrowernumber'}, |
855 |
} |
856 |
); |
788 |
} |
857 |
} |
789 |
|
858 |
|
790 |
=head2 GetQueuedMessages ([$hashref]) |
859 |
=head2 GetQueuedMessages ([$hashref]) |
Lines 801-807
list of hashes, each has represents a message in the message queue.
Link Here
|
801 |
sub GetQueuedMessages { |
870 |
sub GetQueuedMessages { |
802 |
my $params = shift; |
871 |
my $params = shift; |
803 |
|
872 |
|
804 |
my $dbh = C4::Context->dbh(); |
873 |
my $dbh = C4::Context->dbh(); |
805 |
my $statement = << 'ENDSQL'; |
874 |
my $statement = << 'ENDSQL'; |
806 |
SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued |
875 |
SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued |
807 |
FROM message_queue |
876 |
FROM message_queue |
Lines 814-820
ENDSQL
Link Here
|
814 |
push @query_params, $params->{'borrowernumber'}; |
883 |
push @query_params, $params->{'borrowernumber'}; |
815 |
} |
884 |
} |
816 |
|
885 |
|
817 |
if ( @whereclauses ) { |
886 |
if (@whereclauses) { |
818 |
$statement .= ' WHERE ' . join( 'AND', @whereclauses ); |
887 |
$statement .= ' WHERE ' . join( 'AND', @whereclauses ); |
819 |
} |
888 |
} |
820 |
|
889 |
|
Lines 823-831
ENDSQL
Link Here
|
823 |
push @query_params, $params->{'limit'}; |
892 |
push @query_params, $params->{'limit'}; |
824 |
} |
893 |
} |
825 |
|
894 |
|
826 |
my $sth = $dbh->prepare( $statement ); |
895 |
my $sth = $dbh->prepare($statement); |
827 |
my $result = $sth->execute( @query_params ); |
896 |
my $result = $sth->execute(@query_params); |
828 |
return $sth->fetchall_arrayref({}); |
897 |
return $sth->fetchall_arrayref( {} ); |
829 |
} |
898 |
} |
830 |
|
899 |
|
831 |
=head2 _add_attachements |
900 |
=head2 _add_attachements |
Lines 845-851
returns your letter object, with the content updated.
Link Here
|
845 |
sub _add_attachments { |
914 |
sub _add_attachments { |
846 |
my $params = shift; |
915 |
my $params = shift; |
847 |
|
916 |
|
848 |
my $letter = $params->{'letter'}; |
917 |
my $letter = $params->{'letter'}; |
849 |
my $attachments = $params->{'attachments'}; |
918 |
my $attachments = $params->{'attachments'}; |
850 |
return $letter unless @$attachments; |
919 |
return $letter unless @$attachments; |
851 |
my $message = $params->{'message'}; |
920 |
my $message = $params->{'message'}; |
Lines 854-872
sub _add_attachments {
Link Here
|
854 |
$message->attach( |
923 |
$message->attach( |
855 |
Type => $letter->{'content-type'} || 'TEXT', |
924 |
Type => $letter->{'content-type'} || 'TEXT', |
856 |
Data => $letter->{'is_html'} |
925 |
Data => $letter->{'is_html'} |
857 |
? _wrap_html($letter->{'content'}, $letter->{'title'}) |
926 |
? _wrap_html( $letter->{'content'}, $letter->{'title'} ) |
858 |
: $letter->{'content'}, |
927 |
: $letter->{'content'}, |
859 |
); |
928 |
); |
860 |
|
929 |
|
861 |
foreach my $attachment ( @$attachments ) { |
930 |
foreach my $attachment (@$attachments) { |
862 |
$message->attach( |
931 |
$message->attach( |
863 |
Type => $attachment->{'type'}, |
932 |
Type => $attachment->{'type'}, |
864 |
Data => $attachment->{'content'}, |
933 |
Data => $attachment->{'content'}, |
865 |
Filename => $attachment->{'filename'}, |
934 |
Filename => $attachment->{'filename'}, |
866 |
); |
935 |
); |
867 |
} |
936 |
} |
868 |
# we're forcing list context here to get the header, not the count back from grep. |
937 |
|
869 |
( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) ); |
938 |
# we're forcing list context here to get the header, not the count back from grep. |
|
|
939 |
( $letter->{'content-type'} ) = grep( /^Content-Type:/, |
940 |
split( /\n/, $params->{'message'}->header_as_string ) ); |
870 |
$letter->{'content-type'} =~ s/^Content-Type:\s+//; |
941 |
$letter->{'content-type'} =~ s/^Content-Type:\s+//; |
871 |
$letter->{'content'} = $message->body_as_string; |
942 |
$letter->{'content'} = $message->body_as_string; |
872 |
|
943 |
|
Lines 877-883
sub _add_attachments {
Link Here
|
877 |
sub _get_unsent_messages { |
948 |
sub _get_unsent_messages { |
878 |
my $params = shift; |
949 |
my $params = shift; |
879 |
|
950 |
|
880 |
my $dbh = C4::Context->dbh(); |
951 |
my $dbh = C4::Context->dbh(); |
881 |
my $statement = << 'ENDSQL'; |
952 |
my $statement = << 'ENDSQL'; |
882 |
SELECT mq.message_id, mq.borrowernumber, mq.subject, mq.content, mq.message_transport_type, mq.status, mq.time_queued, mq.from_address, mq.to_address, mq.content_type, b.branchcode |
953 |
SELECT mq.message_id, mq.borrowernumber, mq.subject, mq.content, mq.message_transport_type, mq.status, mq.time_queued, mq.from_address, mq.to_address, mq.content_type, b.branchcode |
883 |
FROM message_queue mq |
954 |
FROM message_queue mq |
Lines 902-970
ENDSQL
Link Here
|
902 |
} |
973 |
} |
903 |
|
974 |
|
904 |
$debug and warn "_get_unsent_messages SQL: $statement"; |
975 |
$debug and warn "_get_unsent_messages SQL: $statement"; |
905 |
$debug and warn "_get_unsent_messages params: " . join(',',@query_params); |
976 |
$debug |
906 |
my $sth = $dbh->prepare( $statement ); |
977 |
and warn "_get_unsent_messages params: " . join( ',', @query_params ); |
907 |
my $result = $sth->execute( @query_params ); |
978 |
my $sth = $dbh->prepare($statement); |
908 |
return $sth->fetchall_arrayref({}); |
979 |
my $result = $sth->execute(@query_params); |
|
|
980 |
return $sth->fetchall_arrayref( {} ); |
909 |
} |
981 |
} |
910 |
|
982 |
|
911 |
sub _send_message_by_email { |
983 |
sub _send_message_by_email { |
912 |
my $message = shift or return; |
984 |
my $message = shift or return; |
913 |
my ($username, $password, $method) = @_; |
985 |
my ( $username, $password, $method ) = @_; |
914 |
|
986 |
|
915 |
my $to_address = $message->{to_address}; |
987 |
my $to_address = $message->{to_address}; |
916 |
unless ($to_address) { |
988 |
unless ($to_address) { |
917 |
my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} ); |
989 |
my $member = C4::Members::GetMember( |
|
|
990 |
'borrowernumber' => $message->{'borrowernumber'} ); |
918 |
unless ($member) { |
991 |
unless ($member) { |
919 |
warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})"; |
992 |
warn |
920 |
_set_message_status( { message_id => $message->{'message_id'}, |
993 |
"FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})"; |
921 |
status => 'failed' } ); |
994 |
_set_message_status( |
|
|
995 |
{ |
996 |
message_id => $message->{'message_id'}, |
997 |
status => 'failed' |
998 |
} |
999 |
); |
922 |
return; |
1000 |
return; |
923 |
} |
1001 |
} |
924 |
$to_address = C4::Members::GetNoticeEmailAddress( $message->{'borrowernumber'} ); |
1002 |
$to_address = |
925 |
unless ($to_address) { |
1003 |
C4::Members::GetNoticeEmailAddress( $message->{'borrowernumber'} ); |
926 |
# warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})"; |
1004 |
unless ($to_address) { |
927 |
# warning too verbose for this more common case? |
1005 |
|
928 |
_set_message_status( { message_id => $message->{'message_id'}, |
1006 |
# warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})"; |
929 |
status => 'failed' } ); |
1007 |
# warning too verbose for this more common case? |
|
|
1008 |
_set_message_status( |
1009 |
{ |
1010 |
message_id => $message->{'message_id'}, |
1011 |
status => 'failed' |
1012 |
} |
1013 |
); |
930 |
return; |
1014 |
return; |
931 |
} |
1015 |
} |
932 |
} |
1016 |
} |
933 |
|
1017 |
|
934 |
my $utf8 = decode('MIME-Header', $message->{'subject'} ); |
1018 |
my $utf8 = decode( 'MIME-Header', $message->{'subject'} ); |
935 |
$message->{subject}= encode('MIME-Header', $utf8); |
1019 |
$message->{subject} = encode( 'MIME-Header', $utf8 ); |
936 |
my $subject = encode('utf8', $message->{'subject'}); |
1020 |
my $subject = encode( 'utf8', $message->{'subject'} ); |
937 |
my $content = encode('utf8', $message->{'content'}); |
1021 |
my $content = encode( 'utf8', $message->{'content'} ); |
938 |
my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"'; |
1022 |
my $content_type = $message->{'content_type'} |
|
|
1023 |
|| 'text/plain; charset="UTF-8"'; |
939 |
my $is_html = $content_type =~ m/html/io; |
1024 |
my $is_html = $content_type =~ m/html/io; |
940 |
my %sendmail_params = ( |
1025 |
my %sendmail_params = ( |
941 |
To => $to_address, |
1026 |
To => $to_address, |
942 |
From => $message->{'from_address'} || C4::Context->preference('KohaAdminEmailAddress'), |
1027 |
From => $message->{'from_address'} |
|
|
1028 |
|| C4::Context->preference('KohaAdminEmailAddress'), |
943 |
Subject => $subject, |
1029 |
Subject => $subject, |
944 |
charset => 'utf8', |
1030 |
charset => 'utf8', |
945 |
Message => $is_html ? _wrap_html($content, $subject) : $content, |
1031 |
Message => $is_html ? _wrap_html( $content, $subject ) : $content, |
946 |
'content-type' => $content_type, |
1032 |
'content-type' => $content_type, |
947 |
); |
1033 |
); |
948 |
$sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username; |
1034 |
$sendmail_params{'Auth'} = |
|
|
1035 |
{ user => $username, pass => $password, method => $method } |
1036 |
if $username; |
1037 |
|
949 |
if ( my $bcc = C4::Context->preference('OverdueNoticeBcc') ) { |
1038 |
if ( my $bcc = C4::Context->preference('OverdueNoticeBcc') ) { |
950 |
$sendmail_params{ Bcc } = $bcc; |
1039 |
$sendmail_params{Bcc} = $bcc; |
951 |
} |
1040 |
} |
952 |
|
1041 |
|
953 |
_update_message_to_address($message->{'message_id'},$to_address) unless $message->{to_address}; #if initial message address was empty, coming here means that a to address was found and queue should be updated |
1042 |
_update_message_to_address( $message->{'message_id'}, $to_address ) |
954 |
if ( sendmail( %sendmail_params ) ) { |
1043 |
unless $message |
955 |
_set_message_status( { message_id => $message->{'message_id'}, |
1044 |
->{to_address}; #if initial message address was empty, coming here means that a to address was found and queue should be updated |
956 |
status => 'sent' } ); |
1045 |
if ( sendmail(%sendmail_params) ) { |
|
|
1046 |
_set_message_status( |
1047 |
{ |
1048 |
message_id => $message->{'message_id'}, |
1049 |
status => 'sent' |
1050 |
} |
1051 |
); |
957 |
return 1; |
1052 |
return 1; |
958 |
} else { |
1053 |
} |
959 |
_set_message_status( { message_id => $message->{'message_id'}, |
1054 |
else { |
960 |
status => 'failed' } ); |
1055 |
_set_message_status( |
|
|
1056 |
{ |
1057 |
message_id => $message->{'message_id'}, |
1058 |
status => 'failed' |
1059 |
} |
1060 |
); |
961 |
carp $Mail::Sendmail::error; |
1061 |
carp $Mail::Sendmail::error; |
962 |
return; |
1062 |
return; |
963 |
} |
1063 |
} |
964 |
} |
1064 |
} |
965 |
|
1065 |
|
966 |
sub _wrap_html { |
1066 |
sub _wrap_html { |
967 |
my ($content, $title) = @_; |
1067 |
my ( $content, $title ) = @_; |
968 |
|
1068 |
|
969 |
my $css = C4::Context->preference("NoticeCSS") || ''; |
1069 |
my $css = C4::Context->preference("NoticeCSS") || ''; |
970 |
$css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css; |
1070 |
$css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css; |
Lines 986-1023
EOS
Link Here
|
986 |
|
1086 |
|
987 |
sub _send_message_by_sms { |
1087 |
sub _send_message_by_sms { |
988 |
my $message = shift or return; |
1088 |
my $message = shift or return; |
989 |
my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} ); |
1089 |
my $member = C4::Members::GetMember( |
|
|
1090 |
'borrowernumber' => $message->{'borrowernumber'} ); |
990 |
return unless $member->{'smsalertnumber'}; |
1091 |
return unless $member->{'smsalertnumber'}; |
991 |
|
1092 |
|
992 |
my $success = C4::SMS->send_sms( { destination => $member->{'smsalertnumber'}, |
1093 |
my $success = C4::SMS->send_sms( |
993 |
message => $message->{'content'}, |
1094 |
{ |
994 |
} ); |
1095 |
destination => $member->{'smsalertnumber'}, |
995 |
_set_message_status( { message_id => $message->{'message_id'}, |
1096 |
message => $message->{'content'}, |
996 |
status => ($success ? 'sent' : 'failed') } ); |
1097 |
} |
|
|
1098 |
); |
1099 |
_set_message_status( |
1100 |
{ |
1101 |
message_id => $message->{'message_id'}, |
1102 |
status => ( $success ? 'sent' : 'failed' ) |
1103 |
} |
1104 |
); |
997 |
return $success; |
1105 |
return $success; |
998 |
} |
1106 |
} |
999 |
|
1107 |
|
1000 |
sub _update_message_to_address { |
1108 |
sub _update_message_to_address { |
1001 |
my ($id, $to)= @_; |
1109 |
my ( $id, $to ) = @_; |
1002 |
my $dbh = C4::Context->dbh(); |
1110 |
my $dbh = C4::Context->dbh(); |
1003 |
$dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id)); |
1111 |
$dbh->do( 'UPDATE message_queue SET to_address=? WHERE message_id=?', |
|
|
1112 |
undef, ( $to, $id ) ); |
1004 |
} |
1113 |
} |
1005 |
|
1114 |
|
1006 |
sub _set_message_status { |
1115 |
sub _set_message_status { |
1007 |
my $params = shift or return; |
1116 |
my $params = shift or return; |
1008 |
|
1117 |
|
1009 |
foreach my $required_parameter ( qw( message_id status ) ) { |
1118 |
foreach my $required_parameter (qw( message_id status )) { |
1010 |
return unless exists $params->{ $required_parameter }; |
1119 |
return unless exists $params->{$required_parameter}; |
1011 |
} |
1120 |
} |
1012 |
|
1121 |
|
1013 |
my $dbh = C4::Context->dbh(); |
1122 |
my $dbh = C4::Context->dbh(); |
1014 |
my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?'; |
1123 |
my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?'; |
1015 |
my $sth = $dbh->prepare( $statement ); |
1124 |
my $sth = $dbh->prepare($statement); |
1016 |
my $result = $sth->execute( $params->{'status'}, |
1125 |
my $result = $sth->execute( $params->{'status'}, $params->{'message_id'} ); |
1017 |
$params->{'message_id'} ); |
|
|
1018 |
return $result; |
1126 |
return $result; |
1019 |
} |
1127 |
} |
1020 |
|
1128 |
|
1021 |
|
|
|
1022 |
1; |
1129 |
1; |
1023 |
__END__ |
1130 |
__END__ |
1024 |
- |
|
|