File: | C4/Letters.pm |
Coverage: | 8.5% |
line | stmt | bran | cond | sub | time | code |
---|---|---|---|---|---|---|
1 | package C4::Letters; | |||||
2 | ||||||
3 | # Copyright 2000-2002 Katipo Communications | |||||
4 | # | |||||
5 | # This file is part of Koha. | |||||
6 | # | |||||
7 | # Koha is free software; you can redistribute it and/or modify it under the | |||||
8 | # terms of the GNU General Public License as published by the Free Software | |||||
9 | # Foundation; either version 2 of the License, or (at your option) any later | |||||
10 | # version. | |||||
11 | # | |||||
12 | # Koha is distributed in the hope that it will be useful, but WITHOUT ANY | |||||
13 | # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR | |||||
14 | # A PARTICULAR PURPOSE. See the GNU General Public License for more details. | |||||
15 | # | |||||
16 | # You should have received a copy of the GNU General Public License along | |||||
17 | # with Koha; if not, write to the Free Software Foundation, Inc., | |||||
18 | # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | |||||
19 | ||||||
20 | 14 14 14 | 505 51 1189 | use strict; | |||
21 | 14 14 14 | 92 404 640 | use warnings; | |||
22 | ||||||
23 | 14 14 14 | 37856 446594 602 | use MIME::Lite; | |||
24 | 14 14 14 | 3956 243180 2415 | use Mail::Sendmail; | |||
25 | ||||||
26 | 14 14 14 | 768 257 1580 | use C4::Members; | |||
27 | 14 14 14 | 2410 110 1434 | use C4::Members::Attributes qw(GetBorrowerAttributes); | |||
28 | 14 14 14 | 4275 134 8809 | use C4::Branch; | |||
29 | 14 14 14 | 272 790 1553 | use C4::Log; | |||
30 | 14 14 14 | 2975 68 377 | use C4::SMS; | |||
31 | 14 14 14 | 114 72 1756 | use C4::Debug; | |||
32 | 14 14 14 | 152 64 857 | use Date::Calc qw( Add_Delta_Days ); | |||
33 | 14 14 14 | 103 57 1570 | use Encode; | |||
34 | 14 14 14 | 99 49 864 | use Carp; | |||
35 | ||||||
36 | 14 14 14 | 142 50 1689 | use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); | |||
37 | ||||||
38 | BEGIN { | |||||
39 | 14 | 127 | require Exporter; | |||
40 | # set the version for version checking | |||||
41 | 14 | 45 | $VERSION = 3.01; | |||
42 | 14 | 270 | @ISA = qw(Exporter); | |||
43 | 14 | 90823 | @EXPORT = qw( | |||
44 | &GetLetters &GetPreparedLetter &GetWrappedLetter &addalert &getalert &delalert &findrelatedto &SendAlerts &GetPrintMessages | |||||
45 | ); | |||||
46 | } | |||||
47 | ||||||
48 - 94 | =head1 NAME C4::Letters - Give functions for Letters management =head1 SYNOPSIS use C4::Letters; =head1 DESCRIPTION "Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like late issues, as well as other tasks like sending a mail to users that have subscribed to a "serial issue alert" (= being warned every time a new issue has arrived at the library) Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too. =head2 GetLetters([$category]) $letters = &GetLetters($category); returns informations about letters. if needed, $category filters for letters given category Create a letter selector with the following code =head3 in PERL SCRIPT my $letters = GetLetters($cat); my @letterloop; foreach my $thisletter (keys %$letters) { my $selected = 1 if $thisletter eq $letter; my %row =( value => $thisletter, selected => $selected, lettername => $letters->{$thisletter}, ); push @letterloop, \%row; } $template->param(LETTERLOOP => \@letterloop); =head3 in TEMPLATE <select name="letter"> <option value="">Default</option> <!-- TMPL_LOOP name="LETTERLOOP" --> <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="lettername" --></option> <!-- /TMPL_LOOP --> </select> =cut | |||||
95 | ||||||
96 | sub GetLetters (;$) { | |||||
97 | ||||||
98 | # returns a reference to a hash of references to ALL letters... | |||||
99 | 0 | my $cat = shift; | ||||
100 | 0 | my %letters; | ||||
101 | 0 | my $dbh = C4::Context->dbh; | ||||
102 | 0 | my $sth; | ||||
103 | 0 | if (defined $cat) { | ||||
104 | 0 | my $query = "SELECT * FROM letter WHERE module = ? ORDER BY name"; | ||||
105 | 0 | $sth = $dbh->prepare($query); | ||||
106 | 0 | $sth->execute($cat); | ||||
107 | } | |||||
108 | else { | |||||
109 | 0 | my $query = "SELECT * FROM letter ORDER BY name"; | ||||
110 | 0 | $sth = $dbh->prepare($query); | ||||
111 | 0 | $sth->execute; | ||||
112 | } | |||||
113 | 0 | while ( my $letter = $sth->fetchrow_hashref ) { | ||||
114 | 0 | $letters{ $letter->{'code'} } = $letter->{'name'}; | ||||
115 | } | |||||
116 | 0 | return \%letters; | ||||
117 | } | |||||
118 | ||||||
119 | my %letter; | |||||
120 | sub getletter ($$$) { | |||||
121 | 0 | my ( $module, $code, $branchcode ) = @_; | ||||
122 | ||||||
123 | 0 | if (C4::Context->preference('IndependantBranches') && $branchcode){ | ||||
124 | 0 | $branchcode = C4::Context->userenv->{'branch'}; | ||||
125 | } | |||||
126 | ||||||
127 | 0 | if ( my $l = $letter{$module}{$code}{$branchcode} ) { | ||||
128 | 0 | return { %$l }; # deep copy | ||||
129 | } | |||||
130 | ||||||
131 | 0 | my $dbh = C4::Context->dbh; | ||||
132 | 0 | my $sth = $dbh->prepare("select * from letter where module=? and code=? and (branchcode = ? or branchcode = '') order by branchcode desc limit 1"); | ||||
133 | 0 | $sth->execute( $module, $code, $branchcode ); | ||||
134 | 0 | my $line = $sth->fetchrow_hashref | ||||
135 | or return; | |||||
136 | 0 | $line->{'content-type'} = 'text/html; charset="UTF-8"' if $line->{is_html}; | ||||
137 | 0 | $letter{$module}{$code}{$branchcode} = $line; | ||||
138 | 0 | return { %$line }; | ||||
139 | } | |||||
140 | ||||||
141 - 150 | =head2 addalert ($borrowernumber, $type, $externalid) parameters : - $borrowernumber : the number of the borrower subscribing to the alert - $type : the type of alert. - $externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid. create an alert and return the alertid (primary key) =cut | |||||
151 | ||||||
152 | sub addalert ($$$) { | |||||
153 | 0 | my ( $borrowernumber, $type, $externalid ) = @_; | ||||
154 | 0 | my $dbh = C4::Context->dbh; | ||||
155 | 0 | my $sth = | ||||
156 | $dbh->prepare( | |||||
157 | "insert into alert (borrowernumber, type, externalid) values (?,?,?)"); | |||||
158 | 0 | $sth->execute( $borrowernumber, $type, $externalid ); | ||||
159 | ||||||
160 | # get the alert number newly created and return it | |||||
161 | 0 | my $alertid = $dbh->{'mysql_insertid'}; | ||||
162 | 0 | return $alertid; | ||||
163 | } | |||||
164 | ||||||
165 - 171 | =head2 delalert ($alertid) parameters : - alertid : the alert id deletes the alert =cut | |||||
172 | ||||||
173 | sub delalert ($) { | |||||
174 | 0 | my $alertid = shift or die "delalert() called without valid argument (alertid)"; # it's gonna die anyway. | ||||
175 | 0 | $debug and warn "delalert: deleting alertid $alertid"; | ||||
176 | 0 | my $sth = C4::Context->dbh->prepare("delete from alert where alertid=?"); | ||||
177 | 0 | $sth->execute($alertid); | ||||
178 | } | |||||
179 | ||||||
180 - 188 | =head2 getalert ([$borrowernumber], [$type], [$externalid]) parameters : - $borrowernumber : the number of the borrower subscribing to the alert - $type : the type of alert. - $externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid. all parameters NON mandatory. If a parameter is omitted, the query is done without the corresponding parameter. For example, without $externalid, returns all alerts for a borrower on a topic. =cut | |||||
189 | ||||||
190 | sub getalert (;$$$) { | |||||
191 | 0 | my ( $borrowernumber, $type, $externalid ) = @_; | ||||
192 | 0 | my $dbh = C4::Context->dbh; | ||||
193 | 0 | my $query = "SELECT a.*, b.branchcode FROM alert a JOIN borrowers b USING(borrowernumber) WHERE"; | ||||
194 | 0 | my @bind; | ||||
195 | 0 | if ($borrowernumber and $borrowernumber =~ /^\d+$/) { | ||||
196 | 0 | $query .= " borrowernumber=? AND "; | ||||
197 | 0 | push @bind, $borrowernumber; | ||||
198 | } | |||||
199 | 0 | if ($type) { | ||||
200 | 0 | $query .= " type=? AND "; | ||||
201 | 0 | push @bind, $type; | ||||
202 | } | |||||
203 | 0 | if ($externalid) { | ||||
204 | 0 | $query .= " externalid=? AND "; | ||||
205 | 0 | push @bind, $externalid; | ||||
206 | } | |||||
207 | 0 | $query =~ s/ AND $//; | ||||
208 | 0 | my $sth = $dbh->prepare($query); | ||||
209 | 0 | $sth->execute(@bind); | ||||
210 | 0 | return $sth->fetchall_arrayref({}); | ||||
211 | } | |||||
212 | ||||||
213 - 222 | =head2 findrelatedto($type, $externalid) parameters : - $type : the type of alert - $externalid : the id of the "object" to query In the table alert, a "id" is stored in the externalid field. This "id" is related to another table, depending on the type of the alert. When type=issue, the id is related to a subscriptionid and this sub returns the name of the biblio. =cut | |||||
223 | ||||||
224 | # outmoded POD: | |||||
225 | # When type=virtual, the id is related to a virtual shelf and this sub returns the name of the sub | |||||
226 | ||||||
227 | sub findrelatedto ($$) { | |||||
228 | 0 | my $type = shift or return undef; | ||||
229 | 0 | my $externalid = shift or return undef; | ||||
230 | 0 | my $q = ($type eq 'issue' ) ? | ||||
231 | "select title as result from subscription left join biblio on subscription.biblionumber=biblio.biblionumber where subscriptionid=?" : | |||||
232 | ($type eq 'borrower') ? | |||||
233 | "select concat(firstname,' ',surname) from borrowers where borrowernumber=?" : undef; | |||||
234 | 0 | unless ($q) { | ||||
235 | 0 | warn "findrelatedto(): Illegal type '$type'"; | ||||
236 | 0 | return undef; | ||||
237 | } | |||||
238 | 0 | my $sth = C4::Context->dbh->prepare($q); | ||||
239 | 0 | $sth->execute($externalid); | ||||
240 | 0 | my ($result) = $sth->fetchrow; | ||||
241 | 0 | return $result; | ||||
242 | } | |||||
243 | ||||||
244 - 253 | =head2 SendAlerts parameters : - $type : the type of alert - $externalid : the id of the "object" to query - $letter_code : the letter to send. send an alert to all borrowers having put an alert on a given subject. =cut | |||||
254 | ||||||
255 | sub SendAlerts { | |||||
256 | 0 | my ( $type, $externalid, $letter_code ) = @_; | ||||
257 | 0 | my $dbh = C4::Context->dbh; | ||||
258 | 0 | if ( $type eq 'issue' ) { | ||||
259 | ||||||
260 | # prepare the letter... | |||||
261 | # search the biblionumber | |||||
262 | 0 | my $sth = | ||||
263 | $dbh->prepare( | |||||
264 | "SELECT biblionumber FROM subscription WHERE subscriptionid=?"); | |||||
265 | 0 | $sth->execute($externalid); | ||||
266 | 0 | my ($biblionumber) = $sth->fetchrow | ||||
267 | or warn( "No subscription for '$externalid'" ), | |||||
268 | return; | |||||
269 | ||||||
270 | 0 | my %letter; | ||||
271 | # find the list of borrowers to alert | |||||
272 | 0 | my $alerts = getalert( '', 'issue', $externalid ); | ||||
273 | 0 | foreach (@$alerts) { | ||||
274 | ||||||
275 | 0 | my $borinfo = C4::Members::GetMember('borrowernumber' => $_->{'borrowernumber'}); | ||||
276 | 0 | my $email = $borinfo->{email} or next; | ||||
277 | ||||||
278 | # warn "sending issues..."; | |||||
279 | 0 | my $userenv = C4::Context->userenv; | ||||
280 | 0 | my $letter = GetPreparedLetter ( | ||||
281 | module => 'serial', | |||||
282 | letter_code => $letter_code, | |||||
283 | branchcode => $userenv->{branch}, | |||||
284 | tables => { | |||||
285 | 'branches' => $_->{branchcode}, | |||||
286 | 'biblio' => $biblionumber, | |||||
287 | 'biblioitems' => $biblionumber, | |||||
288 | 'borrowers' => $borinfo, | |||||
289 | }, | |||||
290 | want_librarian => 1, | |||||
291 | ) or return; | |||||
292 | ||||||
293 | # ... then send mail | |||||
294 | 0 | my %mail = ( | ||||
295 | To => $email, | |||||
296 | From => $email, | |||||
297 | Subject => Encode::encode( "utf8", "" . $letter->{title} ), | |||||
298 | Message => Encode::encode( "utf8", "" . $letter->{content} ), | |||||
299 | 'Content-Type' => 'text/plain; charset="utf8"', | |||||
300 | ); | |||||
301 | 0 | sendmail(%mail) or carp $Mail::Sendmail::error; | ||||
302 | } | |||||
303 | } | |||||
304 | elsif ( $type eq 'claimacquisition' or $type eq 'claimissues' ) { | |||||
305 | ||||||
306 | # prepare the letter... | |||||
307 | # search the biblionumber | |||||
308 | 0 | my $strsth = $type eq 'claimacquisition' | ||||
309 | ? qq{ | |||||
310 | SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*,aqbooksellers.* | |||||
311 | FROM aqorders | |||||
312 | LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno | |||||
313 | LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber | |||||
314 | LEFT JOIN biblioitems ON aqorders.biblioitemnumber=biblioitems.biblioitemnumber | |||||
315 | LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id | |||||
316 | WHERE aqorders.ordernumber IN ( | |||||
317 | } | |||||
318 | : qq{ | |||||
319 | SELECT serial.*,subscription.*, biblio.*, aqbooksellers.* | |||||
320 | FROM serial | |||||
321 | LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid | |||||
322 | LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber | |||||
323 | LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id | |||||
324 | WHERE serial.serialid IN ( | |||||
325 | }; | |||||
326 | 0 | $strsth .= join( ",", @$externalid ) . ")"; | ||||
327 | 0 | my $sthorders = $dbh->prepare($strsth); | ||||
328 | 0 | $sthorders->execute; | ||||
329 | 0 | my $dataorders = $sthorders->fetchall_arrayref( {} ); | ||||
330 | ||||||
331 | 0 | my $sthbookseller = | ||||
332 | $dbh->prepare("select * from aqbooksellers where id=?"); | |||||
333 | 0 | $sthbookseller->execute( $dataorders->[0]->{booksellerid} ); | ||||
334 | 0 | my $databookseller = $sthbookseller->fetchrow_hashref; | ||||
335 | ||||||
336 | 0 | my @email; | ||||
337 | 0 | push @email, $databookseller->{bookselleremail} if $databookseller->{bookselleremail}; | ||||
338 | 0 | push @email, $databookseller->{contemail} if $databookseller->{contemail}; | ||||
339 | 0 | unless (@email) { | ||||
340 | 0 | warn "Bookseller $dataorders->[0]->{booksellerid} without emails"; | ||||
341 | 0 | return { error => "no_email" }; | ||||
342 | } | |||||
343 | ||||||
344 | 0 | my $userenv = C4::Context->userenv; | ||||
345 | 0 | my $letter = GetPreparedLetter ( | ||||
346 | module => $type, | |||||
347 | letter_code => $letter_code, | |||||
348 | branchcode => $userenv->{branch}, | |||||
349 | tables => { | |||||
350 | 'branches' => $userenv->{branch}, | |||||
351 | 'aqbooksellers' => $databookseller, | |||||
352 | }, | |||||
353 | repeat => $dataorders, | |||||
354 | want_librarian => 1, | |||||
355 | ) or return; | |||||
356 | ||||||
357 | # ... then send mail | |||||
358 | 0 | my %mail = ( | ||||
359 | To => join( ','. @email), | |||||
360 | From => $userenv->{emailaddress}, | |||||
361 | Subject => Encode::encode( "utf8", "" . $letter->{title} ), | |||||
362 | Message => Encode::encode( "utf8", "" . $letter->{content} ), | |||||
363 | 'Content-Type' => 'text/plain; charset="utf8"', | |||||
364 | ); | |||||
365 | 0 | sendmail(%mail) or carp $Mail::Sendmail::error; | ||||
366 | ||||||
367 | 0 | logaction( | ||||
368 | "ACQUISITION", | |||||
369 | $type eq 'claimissues' ? "CLAIM ISSUE" : "ACQUISITION CLAIM", | |||||
370 | undef, | |||||
371 | "To=" | |||||
372 | . $databookseller->{contemail} | |||||
373 | . " Title=" | |||||
374 | . $letter->{title} | |||||
375 | . " Content=" | |||||
376 | . $letter->{content} | |||||
377 | ) if C4::Context->preference("LetterLog"); | |||||
378 | } | |||||
379 | # send an "account details" notice to a newly created user | |||||
380 | elsif ( $type eq 'members' ) { | |||||
381 | 0 | my $branchdetails = GetBranchDetail($externalid->{'branchcode'}); | ||||
382 | 0 | my $letter = GetPreparedLetter ( | ||||
383 | module => 'members', | |||||
384 | letter_code => $letter_code, | |||||
385 | branchcode => $externalid->{'branchcode'}, | |||||
386 | tables => { | |||||
387 | 'branches' => $branchdetails, | |||||
388 | 'borrowers' => $externalid->{'borrowernumber'}, | |||||
389 | }, | |||||
390 | substitute => { 'borrowers.password' => $externalid->{'password'} }, | |||||
391 | want_librarian => 1, | |||||
392 | ) or return; | |||||
393 | ||||||
394 | 0 | return { error => "no_email" } unless $externalid->{'emailaddr'}; | ||||
395 | 0 | my %mail = ( | ||||
396 | To => $externalid->{'emailaddr'}, | |||||
397 | From => $branchdetails->{'branchemail'} || C4::Context->preference("KohaAdminEmailAddress"), | |||||
398 | Subject => Encode::encode( "utf8", $letter->{'title'} ), | |||||
399 | Message => Encode::encode( "utf8", $letter->{'content'} ), | |||||
400 | 'Content-Type' => 'text/plain; charset="utf8"', | |||||
401 | ); | |||||
402 | 0 | sendmail(%mail) or carp $Mail::Sendmail::error; | ||||
403 | } | |||||
404 | } | |||||
405 | ||||||
406 - 427 | =head2 GetPreparedLetter( %params ) %params hash: module => letter module, mandatory letter_code => letter code, mandatory branchcode => for letter selection, if missing default system letter taken tables => a hashref with table names as keys. Values are either: - a scalar - primary key value - an arrayref - primary key values - a hashref - full record substitute => custom substitution key/value pairs repeat => records to be substituted on consecutive lines: - an arrayref - tries to guess what needs substituting by taking remaining << >> tokensr; not recommended - a hashref token => @tables - replaces <token> << >> << >> </token> subtemplate for each @tables row; table is a hashref as above want_librarian => boolean, if set to true triggers librarian details substitution from the userenv Return value: letter fields hashref (title & content useful) =cut | |||||
428 | ||||||
429 | sub GetPreparedLetter { | |||||
430 | 0 | my %params = @_; | ||||
431 | ||||||
432 | 0 | my $module = $params{module} or croak "No module"; | ||||
433 | 0 | my $letter_code = $params{letter_code} or croak "No letter_code"; | ||||
434 | 0 | my $branchcode = $params{branchcode} || ''; | ||||
435 | ||||||
436 | 0 | my $letter = getletter( $module, $letter_code, $branchcode ) | ||||
437 | or warn( "No $module $letter_code letter"), | |||||
438 | return; | |||||
439 | ||||||
440 | 0 | my $tables = $params{tables}; | ||||
441 | 0 | my $substitute = $params{substitute}; | ||||
442 | 0 | my $repeat = $params{repeat}; | ||||
443 | 0 | $tables || $substitute || $repeat | ||||
444 | or carp( "ERROR: nothing to substitute - both 'tables' and 'substitute' are empty" ), | |||||
445 | return; | |||||
446 | 0 | my $want_librarian = $params{want_librarian}; | ||||
447 | ||||||
448 | 0 | if ($substitute) { | ||||
449 | 0 | while ( my ($token, $val) = each %$substitute ) { | ||||
450 | 0 | $letter->{title} =~ s/<<$token>>/$val/g; | ||||
451 | 0 | $letter->{content} =~ s/<<$token>>/$val/g; | ||||
452 | } | |||||
453 | } | |||||
454 | ||||||
455 | 0 | if ($want_librarian) { | ||||
456 | # parsing librarian name | |||||
457 | 0 | my $userenv = C4::Context->userenv; | ||||
458 | 0 | $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go; | ||||
459 | 0 | $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go; | ||||
460 | 0 | $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go; | ||||
461 | } | |||||
462 | ||||||
463 | 0 | my ($repeat_no_enclosing_tags, $repeat_enclosing_tags); | ||||
464 | ||||||
465 | 0 | if ($repeat) { | ||||
466 | 0 | if (ref ($repeat) eq 'ARRAY' ) { | ||||
467 | 0 | $repeat_no_enclosing_tags = $repeat; | ||||
468 | } else { | |||||
469 | 0 | $repeat_enclosing_tags = $repeat; | ||||
470 | } | |||||
471 | } | |||||
472 | ||||||
473 | 0 | if ($repeat_enclosing_tags) { | ||||
474 | 0 | while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) { | ||||
475 | 0 | if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) { | ||||
476 | 0 | my $subcontent = $1; | ||||
477 | 0 | my @lines = map { | ||||
478 | 0 | my %subletter = ( title => '', content => $subcontent ); | ||||
479 | 0 | _substitute_tables( \%subletter, $_ ); | ||||
480 | 0 | $subletter{content}; | ||||
481 | } @$tag_tables; | |||||
482 | 0 0 | $letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se; | ||||
483 | } | |||||
484 | } | |||||
485 | } | |||||
486 | ||||||
487 | 0 | if ($tables) { | ||||
488 | 0 | _substitute_tables( $letter, $tables ); | ||||
489 | } | |||||
490 | ||||||
491 | 0 | if ($repeat_no_enclosing_tags) { | ||||
492 | 0 | if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) { | ||||
493 | 0 | my $line = $&; | ||||
494 | 0 | my $i = 1; | ||||
495 | 0 | my @lines = map { | ||||
496 | 0 | my $c = $line; | ||||
497 | 0 | $c =~ s/<<count>>/$i/go; | ||||
498 | 0 0 | foreach my $field ( keys %{$_} ) { | ||||
499 | 0 | $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/; | ||||
500 | } | |||||
501 | 0 | $i++; | ||||
502 | 0 | $c; | ||||
503 | } @$repeat_no_enclosing_tags; | |||||
504 | ||||||
505 | 0 | my $replaceby = join( "\n", @lines ); | ||||
506 | 0 | $letter->{content} =~ s/\Q$line\E/$replaceby/s; | ||||
507 | } | |||||
508 | } | |||||
509 | ||||||
510 | 0 | $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers | ||||
511 | # $letter->{content} =~ s/<<[^>]*>>//go; | |||||
512 | ||||||
513 | 0 | return $letter; | ||||
514 | } | |||||
515 | ||||||
516 | sub _substitute_tables { | |||||
517 | 0 | my ( $letter, $tables ) = @_; | ||||
518 | 0 | while ( my ($table, $param) = each %$tables ) { | ||||
519 | 0 | next unless $param; | ||||
520 | ||||||
521 | 0 | my $ref = ref $param; | ||||
522 | ||||||
523 | 0 | my $values; | ||||
524 | 0 | if ($ref && $ref eq 'HASH') { | ||||
525 | 0 | $values = $param; | ||||
526 | } | |||||
527 | else { | |||||
528 | 0 | my @pk; | ||||
529 | 0 | my $sth = _parseletter_sth($table); | ||||
530 | 0 | unless ($sth) { | ||||
531 | 0 | warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table."; | ||||
532 | 0 | return; | ||||
533 | } | |||||
534 | 0 | $sth->execute( $ref ? @$param : $param ); | ||||
535 | ||||||
536 | 0 | $values = $sth->fetchrow_hashref; | ||||
537 | } | |||||
538 | ||||||
539 | 0 | _parseletter ( $letter, $table, $values ); | ||||
540 | } | |||||
541 | } | |||||
542 | ||||||
543 | my %handles = (); | |||||
544 | sub _parseletter_sth { | |||||
545 | 0 | my $table = shift; | ||||
546 | 0 | unless ($table) { | ||||
547 | 0 | carp "ERROR: _parseletter_sth() called without argument (table)"; | ||||
548 | 0 | return; | ||||
549 | } | |||||
550 | # check cache first | |||||
551 | 0 | (defined $handles{$table}) and return $handles{$table}; | ||||
552 | 0 | my $query = | ||||
553 | ($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" : | |||||
554 | ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" : | |||||
555 | ($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" : | |||||
556 | ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" : | |||||
557 | ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" : | |||||
558 | ($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" : | |||||
559 | ($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" : | |||||
560 | ($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" : | |||||
561 | ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" : | |||||
562 | ($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" : | |||||
563 | ($table eq 'opac_news' ) ? "SELECT * FROM $table WHERE idnew = ?" : | |||||
564 | undef ; | |||||
565 | 0 | unless ($query) { | ||||
566 | 0 | warn "ERROR: No _parseletter_sth query for table '$table'"; | ||||
567 | 0 | return; # nothing to get | ||||
568 | } | |||||
569 | 0 | unless ($handles{$table} = C4::Context->dbh->prepare($query)) { | ||||
570 | 0 | warn "ERROR: Failed to prepare query: '$query'"; | ||||
571 | 0 | return; | ||||
572 | } | |||||
573 | 0 | return $handles{$table}; # now cache is populated for that $table | ||||
574 | } | |||||
575 | ||||||
576 - 585 | =head2 _parseletter($letter, $table, $values) parameters : - $letter : a hash to letter fields (title & content useful) - $table : the Koha table to parse. - $values : table record hashref parse all fields from a table, and replace values in title & content with the appropriate value (not exported sub, used only internally) =cut | |||||
586 | ||||||
587 | my %columns = (); | |||||
588 | sub _parseletter { | |||||
589 | 0 | my ( $letter, $table, $values ) = @_; | ||||
590 | ||||||
591 | # TEMPORARY hack until the expirationdate column is added to reserves | |||||
592 | 0 | if ( $table eq 'reserves' && $values->{'waitingdate'} ) { | ||||
593 | 0 | my @waitingdate = split /-/, $values->{'waitingdate'}; | ||||
594 | ||||||
595 | 0 | $values->{'expirationdate'} = C4::Dates->new( | ||||
596 | sprintf( | |||||
597 | '%04d-%02d-%02d', | |||||
598 | Add_Delta_Days( @waitingdate, C4::Context->preference( 'ReservesMaxPickUpDelay' ) ) | |||||
599 | ), | |||||
600 | 'iso' | |||||
601 | )->output(); | |||||
602 | } | |||||
603 | ||||||
604 | 0 | if ($letter->{content} && $letter->{content} =~ /<<today>>/) { | ||||
605 | 0 | my @da = localtime(); | ||||
606 | 0 | my $todaysdate = "$da[2]:$da[1] " . C4::Dates->today(); | ||||
607 | 0 | $letter->{content} =~ s/<<today>>/$todaysdate/go; | ||||
608 | } | |||||
609 | ||||||
610 | # and get all fields from the table | |||||
611 | # my $columns = $columns{$table}; | |||||
612 | # unless ($columns) { | |||||
613 | # $columns = $columns{$table} = C4::Context->dbh->selectcol_arrayref("SHOW COLUMNS FROM $table"); | |||||
614 | # } | |||||
615 | # foreach my $field (@$columns) { | |||||
616 | ||||||
617 | 0 | while ( my ($field, $val) = each %$values ) { | ||||
618 | 0 | my $replacetablefield = "<<$table.$field>>"; | ||||
619 | 0 | my $replacefield = "<<$field>>"; | ||||
620 | 0 | $val =~ s/\p{P}(?=$)//g if $val; | ||||
621 | 0 | my $replacedby = defined ($val) ? $val : ''; | ||||
622 | 0 | ($letter->{title} ) and do { | ||||
623 | 0 | $letter->{title} =~ s/$replacetablefield/$replacedby/g; | ||||
624 | 0 | $letter->{title} =~ s/$replacefield/$replacedby/g; | ||||
625 | }; | |||||
626 | 0 | ($letter->{content}) and do { | ||||
627 | 0 | $letter->{content} =~ s/$replacetablefield/$replacedby/g; | ||||
628 | 0 | $letter->{content} =~ s/$replacefield/$replacedby/g; | ||||
629 | }; | |||||
630 | } | |||||
631 | ||||||
632 | 0 | if ($table eq 'borrowers' && $letter->{content}) { | ||||
633 | 0 | if ( my $attributes = GetBorrowerAttributes($values->{borrowernumber}) ) { | ||||
634 | 0 | my %attr; | ||||
635 | 0 | foreach (@$attributes) { | ||||
636 | 0 | my $code = $_->{code}; | ||||
637 | 0 | my $val = $_->{value_description} || $_->{value}; | ||||
638 | 0 | $val =~ s/\p{P}(?=$)//g if $val; | ||||
639 | 0 | next unless $val gt ''; | ||||
640 | 0 | $attr{$code} ||= []; | ||||
641 | 0 0 | push @{ $attr{$code} }, $val; | ||||
642 | } | |||||
643 | 0 | while ( my ($code, $val_ar) = each %attr ) { | ||||
644 | 0 | my $replacefield = "<<borrower-attribute:$code>>"; | ||||
645 | 0 | my $replacedby = join ',', @$val_ar; | ||||
646 | 0 | $letter->{content} =~ s/$replacefield/$replacedby/g; | ||||
647 | } | |||||
648 | } | |||||
649 | } | |||||
650 | 0 | return $letter; | ||||
651 | } | |||||
652 | ||||||
653 - 664 | =head2 EnqueueLetter my $success = EnqueueLetter( { letter => $letter, borrowernumber => '12', message_transport_type => 'email' } ) places a letter in the message_queue database table, which will eventually get processed (sent) by the process_message_queue.pl cronjob when it calls SendQueuedMessages. return true on success =cut | |||||
665 | ||||||
666 | sub EnqueueLetter ($) { | |||||
667 | 0 | my $params = shift or return undef; | ||||
668 | ||||||
669 | 0 | return unless exists $params->{'letter'}; | ||||
670 | 0 | return unless exists $params->{'borrowernumber'}; | ||||
671 | 0 | return unless exists $params->{'message_transport_type'}; | ||||
672 | ||||||
673 | # If we have any attachments we should encode then into the body. | |||||
674 | 0 | if ( $params->{'attachments'} ) { | ||||
675 | 0 | $params->{'letter'} = _add_attachments( | ||||
676 | { letter => $params->{'letter'}, | |||||
677 | attachments => $params->{'attachments'}, | |||||
678 | message => MIME::Lite->new( Type => 'multipart/mixed' ), | |||||
679 | } | |||||
680 | ); | |||||
681 | } | |||||
682 | ||||||
683 | 0 | my $dbh = C4::Context->dbh(); | ||||
684 | 0 | my $statement = << 'ENDSQL'; | ||||
685 | INSERT INTO message_queue | |||||
686 | ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type ) | |||||
687 | VALUES | |||||
688 | ( ?, ?, ?, ?, ?, ?, ?, NOW(), ?, ?, ? ) | |||||
689 | ENDSQL | |||||
690 | ||||||
691 | 0 | my $sth = $dbh->prepare($statement); | ||||
692 | 0 | my $result = $sth->execute( | ||||
693 | $params->{'borrowernumber'}, # borrowernumber | |||||
694 | $params->{'letter'}->{'title'}, # subject | |||||
695 | $params->{'letter'}->{'content'}, # content | |||||
696 | $params->{'letter'}->{'metadata'} || '', # metadata | |||||
697 | $params->{'letter'}->{'code'} || '', # letter_code | |||||
698 | $params->{'message_transport_type'}, # message_transport_type | |||||
699 | 'pending', # status | |||||
700 | $params->{'to_address'}, # to_address | |||||
701 | $params->{'from_address'}, # from_address | |||||
702 | $params->{'letter'}->{'content-type'}, # content_type | |||||
703 | ); | |||||
704 | 0 | return $result; | ||||
705 | } | |||||
706 | ||||||
707 - 715 | =head2 SendQueuedMessages ([$hashref]) my $sent = SendQueuedMessages( { verbose => 1 } ); sends all of the 'pending' items in the message queue. returns number of messages sent. =cut | |||||
716 | ||||||
717 | sub SendQueuedMessages (;$) { | |||||
718 | 0 | my $params = shift; | ||||
719 | ||||||
720 | 0 | my $unsent_messages = _get_unsent_messages(); | ||||
721 | 0 | MESSAGE: foreach my $message ( @$unsent_messages ) { | ||||
722 | # warn Data::Dumper->Dump( [ $message ], [ 'message' ] ); | |||||
723 | 0 | warn sprintf( 'sending %s message to patron: %s', | ||||
724 | $message->{'message_transport_type'}, | |||||
725 | $message->{'borrowernumber'} || 'Admin' ) | |||||
726 | if $params->{'verbose'} or $debug; | |||||
727 | # This is just begging for subclassing | |||||
728 | 0 | next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' ); | ||||
729 | 0 | if ( lc( $message->{'message_transport_type'} ) eq 'email' ) { | ||||
730 | 0 | _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} ); | ||||
731 | } | |||||
732 | elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) { | |||||
733 | 0 | _send_message_by_sms( $message ); | ||||
734 | } | |||||
735 | } | |||||
736 | 0 | return scalar( @$unsent_messages ); | ||||
737 | } | |||||
738 | ||||||
739 - 745 | =head2 GetRSSMessages my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } ) returns a listref of all queued RSS messages for a particular person. =cut | |||||
746 | ||||||
747 | sub GetRSSMessages { | |||||
748 | 0 | my $params = shift; | ||||
749 | ||||||
750 | 0 | return unless $params; | ||||
751 | 0 | return unless ref $params; | ||||
752 | 0 | return unless $params->{'borrowernumber'}; | ||||
753 | ||||||
754 | 0 | return _get_unsent_messages( { message_transport_type => 'rss', | ||||
755 | limit => $params->{'limit'}, | |||||
756 | borrowernumber => $params->{'borrowernumber'}, } ); | |||||
757 | } | |||||
758 | ||||||
759 - 766 | =head2 GetPrintMessages my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } ) Returns a arrayref of all queued print messages (optionally, for a particular person). =cut | |||||
767 | ||||||
768 | sub GetPrintMessages { | |||||
769 | 0 | my $params = shift || {}; | ||||
770 | ||||||
771 | 0 | return _get_unsent_messages( { message_transport_type => 'print', | ||||
772 | borrowernumber => $params->{'borrowernumber'}, } ); | |||||
773 | } | |||||
774 | ||||||
775 - 784 | =head2 GetQueuedMessages ([$hashref]) my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } ); fetches messages out of the message queue. returns: list of hashes, each has represents a message in the message queue. =cut | |||||
785 | ||||||
786 | sub GetQueuedMessages { | |||||
787 | 0 | my $params = shift; | ||||
788 | ||||||
789 | 0 | my $dbh = C4::Context->dbh(); | ||||
790 | 0 | my $statement = << 'ENDSQL'; | ||||
791 | SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued | |||||
792 | FROM message_queue | |||||
793 | ENDSQL | |||||
794 | ||||||
795 | 0 | my @query_params; | ||||
796 | 0 | my @whereclauses; | ||||
797 | 0 | if ( exists $params->{'borrowernumber'} ) { | ||||
798 | 0 | push @whereclauses, ' borrowernumber = ? '; | ||||
799 | 0 | push @query_params, $params->{'borrowernumber'}; | ||||
800 | } | |||||
801 | ||||||
802 | 0 | if ( @whereclauses ) { | ||||
803 | 0 | $statement .= ' WHERE ' . join( 'AND', @whereclauses ); | ||||
804 | } | |||||
805 | ||||||
806 | 0 | if ( defined $params->{'limit'} ) { | ||||
807 | 0 | $statement .= ' LIMIT ? '; | ||||
808 | 0 | push @query_params, $params->{'limit'}; | ||||
809 | } | |||||
810 | ||||||
811 | 0 | my $sth = $dbh->prepare( $statement ); | ||||
812 | 0 | my $result = $sth->execute( @query_params ); | ||||
813 | 0 | return $sth->fetchall_arrayref({}); | ||||
814 | } | |||||
815 | ||||||
816 - 828 | =head2 _add_attachements named parameters: letter - the standard letter hashref attachments - listref of attachments. each attachment is a hashref of: type - the mime type, like 'text/plain' content - the actual attachment filename - the name of the attachment. message - a MIME::Lite object to attach these to. returns your letter object, with the content updated. =cut | |||||
829 | ||||||
830 | sub _add_attachments { | |||||
831 | 0 | my $params = shift; | ||||
832 | ||||||
833 | 0 | my $letter = $params->{'letter'}; | ||||
834 | 0 | my $attachments = $params->{'attachments'}; | ||||
835 | 0 | return $letter unless @$attachments; | ||||
836 | 0 | my $message = $params->{'message'}; | ||||
837 | ||||||
838 | # First, we have to put the body in as the first attachment | |||||
839 | 0 | $message->attach( | ||||
840 | Type => $letter->{'content-type'} || 'TEXT', | |||||
841 | Data => $letter->{'is_html'} | |||||
842 | ? _wrap_html($letter->{'content'}, $letter->{'title'}) | |||||
843 | : $letter->{'content'}, | |||||
844 | ); | |||||
845 | ||||||
846 | 0 | foreach my $attachment ( @$attachments ) { | ||||
847 | 0 | $message->attach( | ||||
848 | Type => $attachment->{'type'}, | |||||
849 | Data => $attachment->{'content'}, | |||||
850 | Filename => $attachment->{'filename'}, | |||||
851 | ); | |||||
852 | } | |||||
853 | # we're forcing list context here to get the header, not the count back from grep. | |||||
854 | 0 | ( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) ); | ||||
855 | 0 | $letter->{'content-type'} =~ s/^Content-Type:\s+//; | ||||
856 | 0 | $letter->{'content'} = $message->body_as_string; | ||||
857 | ||||||
858 | 0 | return $letter; | ||||
859 | ||||||
860 | } | |||||
861 | ||||||
862 | sub _get_unsent_messages (;$) { | |||||
863 | 0 | my $params = shift; | ||||
864 | ||||||
865 | 0 | my $dbh = C4::Context->dbh(); | ||||
866 | 0 | my $statement = << 'ENDSQL'; | ||||
867 | SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, from_address, to_address, content_type | |||||
868 | FROM message_queue | |||||
869 | WHERE status = ? | |||||
870 | ENDSQL | |||||
871 | ||||||
872 | 0 | my @query_params = ('pending'); | ||||
873 | 0 | if ( ref $params ) { | ||||
874 | 0 | if ( $params->{'message_transport_type'} ) { | ||||
875 | 0 | $statement .= ' AND message_transport_type = ? '; | ||||
876 | 0 | push @query_params, $params->{'message_transport_type'}; | ||||
877 | } | |||||
878 | 0 | if ( $params->{'borrowernumber'} ) { | ||||
879 | 0 | $statement .= ' AND borrowernumber = ? '; | ||||
880 | 0 | push @query_params, $params->{'borrowernumber'}; | ||||
881 | } | |||||
882 | 0 | if ( $params->{'limit'} ) { | ||||
883 | 0 | $statement .= ' limit ? '; | ||||
884 | 0 | push @query_params, $params->{'limit'}; | ||||
885 | } | |||||
886 | } | |||||
887 | 0 | $debug and warn "_get_unsent_messages SQL: $statement"; | ||||
888 | 0 | $debug and warn "_get_unsent_messages params: " . join(',',@query_params); | ||||
889 | 0 | my $sth = $dbh->prepare( $statement ); | ||||
890 | 0 | my $result = $sth->execute( @query_params ); | ||||
891 | 0 | return $sth->fetchall_arrayref({}); | ||||
892 | } | |||||
893 | ||||||
894 | sub _send_message_by_email ($;$$$) { | |||||
895 | 0 | my $message = shift or return; | ||||
896 | 0 | my ($username, $password, $method) = @_; | ||||
897 | ||||||
898 | 0 | my $to_address = $message->{to_address}; | ||||
899 | 0 | unless ($to_address) { | ||||
900 | 0 | my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} ); | ||||
901 | 0 | unless ($member) { | ||||
902 | 0 | warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})"; | ||||
903 | 0 | _set_message_status( { message_id => $message->{'message_id'}, | ||||
904 | status => 'failed' } ); | |||||
905 | 0 | return; | ||||
906 | } | |||||
907 | 0 | my $which_address = C4::Context->preference('AutoEmailPrimaryAddress'); | ||||
908 | # If the system preference is set to 'first valid' (value == OFF), look up email address | |||||
909 | 0 | if ($which_address eq 'OFF') { | ||||
910 | 0 | $to_address = GetFirstValidEmailAddress( $message->{'borrowernumber'} ); | ||||
911 | } else { | |||||
912 | 0 | $to_address = $member->{$which_address}; | ||||
913 | } | |||||
914 | 0 | unless ($to_address) { | ||||
915 | # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})"; | |||||
916 | # warning too verbose for this more common case? | |||||
917 | 0 | _set_message_status( { message_id => $message->{'message_id'}, | ||||
918 | status => 'failed' } ); | |||||
919 | 0 | return; | ||||
920 | } | |||||
921 | } | |||||
922 | ||||||
923 | 0 | my $utf8 = decode('MIME-Header', $message->{'subject'} ); | ||||
924 | 0 | $message->{subject}= encode('MIME-Header', $utf8); | ||||
925 | 0 | my $subject = encode('utf8', $message->{'subject'}); | ||||
926 | 0 | my $content = encode('utf8', $message->{'content'}); | ||||
927 | 0 | my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"'; | ||||
928 | 0 | my $is_html = $content_type =~ m/html/io; | ||||
929 | 0 | my %sendmail_params = ( | ||||
930 | To => $to_address, | |||||
931 | From => $message->{'from_address'} || C4::Context->preference('KohaAdminEmailAddress'), | |||||
932 | Subject => $subject, | |||||
933 | charset => 'utf8', | |||||
934 | Message => $is_html ? _wrap_html($content, $subject) : $content, | |||||
935 | 'content-type' => $content_type, | |||||
936 | ); | |||||
937 | 0 | $sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username; | ||||
938 | 0 | if ( my $bcc = C4::Context->preference('OverdueNoticeBcc') ) { | ||||
939 | 0 | $sendmail_params{ Bcc } = $bcc; | ||||
940 | } | |||||
941 | ||||||
942 | 0 | _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 | ||||
943 | 0 | if ( sendmail( %sendmail_params ) ) { | ||||
944 | 0 | _set_message_status( { message_id => $message->{'message_id'}, | ||||
945 | status => 'sent' } ); | |||||
946 | 0 | return 1; | ||||
947 | } else { | |||||
948 | 0 | _set_message_status( { message_id => $message->{'message_id'}, | ||||
949 | status => 'failed' } ); | |||||
950 | 0 | carp $Mail::Sendmail::error; | ||||
951 | 0 | return; | ||||
952 | } | |||||
953 | } | |||||
954 | ||||||
955 | sub _wrap_html { | |||||
956 | 0 | my ($content, $title) = @_; | ||||
957 | ||||||
958 | 0 | my $css = C4::Context->preference("NoticeCSS") || ''; | ||||
959 | 0 | $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css; | ||||
960 | 0 | return <<EOS; | ||||
961 | <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" | |||||
962 | "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> | |||||
963 | <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml"> | |||||
964 | <head> | |||||
965 | <title>$title</title> | |||||
966 | <meta http-equiv="Content-Type" content="text/html; charset=utf-8" /> | |||||
967 | $css | |||||
968 | </head> | |||||
969 | <body> | |||||
970 | $content | |||||
971 | </body> | |||||
972 | </html> | |||||
973 | EOS | |||||
974 | } | |||||
975 | ||||||
976 | sub _send_message_by_sms ($) { | |||||
977 | 0 | my $message = shift or return undef; | ||||
978 | 0 | my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} ); | ||||
979 | 0 | return unless $member->{'smsalertnumber'}; | ||||
980 | ||||||
981 | 0 | my $success = C4::SMS->send_sms( { destination => $member->{'smsalertnumber'}, | ||||
982 | message => $message->{'content'}, | |||||
983 | } ); | |||||
984 | 0 | _set_message_status( { message_id => $message->{'message_id'}, | ||||
985 | status => ($success ? 'sent' : 'failed') } ); | |||||
986 | 0 | return $success; | ||||
987 | } | |||||
988 | ||||||
989 | sub _update_message_to_address { | |||||
990 | 0 | my ($id, $to)= @_; | ||||
991 | 0 | my $dbh = C4::Context->dbh(); | ||||
992 | 0 | $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id)); | ||||
993 | } | |||||
994 | ||||||
995 | sub _set_message_status ($) { | |||||
996 | 0 | my $params = shift or return undef; | ||||
997 | ||||||
998 | 0 | foreach my $required_parameter ( qw( message_id status ) ) { | ||||
999 | 0 | return undef unless exists $params->{ $required_parameter }; | ||||
1000 | } | |||||
1001 | ||||||
1002 | 0 | my $dbh = C4::Context->dbh(); | ||||
1003 | 0 | my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?'; | ||||
1004 | 0 | my $sth = $dbh->prepare( $statement ); | ||||
1005 | 0 | my $result = $sth->execute( $params->{'status'}, | ||||
1006 | $params->{'message_id'} ); | |||||
1007 | 0 | return $result; | ||||
1008 | } | |||||
1009 | ||||||
1010 | ||||||
1011 | 1; |