|
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 |
- |
|
|