| File: | C4/Letters.pm |
| Coverage: | 9.7% |
| 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 | 13 13 13 | 19235 46 380 | use strict; | |||
| 21 | 13 13 13 | 99 89 1263 | use warnings; | |||
| 22 | ||||||
| 23 | 13 13 13 | 59878 404137 648 | use MIME::Lite; | |||
| 24 | 13 13 13 | 4915 328671 1717 | use Mail::Sendmail; | |||
| 25 | ||||||
| 26 | 13 13 13 | 836 153 4103 | use C4::Members; | |||
| 27 | 13 13 13 | 2186 115 3560 | use C4::Branch; | |||
| 28 | 13 13 13 | 141 95 1565 | use C4::Log; | |||
| 29 | 13 13 13 | 2630 47 454 | use C4::SMS; | |||
| 30 | 13 13 13 | 112 41 1286 | use C4::Debug; | |||
| 31 | 13 13 13 | 81 34 741 | use Date::Calc qw( Add_Delta_Days ); | |||
| 32 | 13 13 13 | 71 28 1306 | use Encode; | |||
| 33 | 13 13 13 | 91 29 958 | use Carp; | |||
| 34 | ||||||
| 35 | 13 13 13 | 80 44 1568 | use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); | |||
| 36 | ||||||
| 37 | BEGIN { | |||||
| 38 | 13 | 76 | require Exporter; | |||
| 39 | # set the version for version checking | |||||
| 40 | 13 | 63 | $VERSION = 3.01; | |||
| 41 | 13 | 1041 | @ISA = qw(Exporter); | |||
| 42 | 13 | 78833 | @EXPORT = qw( | |||
| 43 | &GetLetters &getletter &addalert &getalert &delalert &findrelatedto &SendAlerts GetPrintMessages | |||||
| 44 | ); | |||||
| 45 | } | |||||
| 46 | ||||||
| 47 - 93 | =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 | |||||
| 94 | ||||||
| 95 | sub GetLetters (;$) { | |||||
| 96 | ||||||
| 97 | # returns a reference to a hash of references to ALL letters... | |||||
| 98 | 0 | my $cat = shift; | ||||
| 99 | 0 | my %letters; | ||||
| 100 | 0 | my $dbh = C4::Context->dbh; | ||||
| 101 | 0 | my $sth; | ||||
| 102 | 0 | if (defined $cat) { | ||||
| 103 | 0 | my $query = "SELECT * FROM letter WHERE module = ? ORDER BY name"; | ||||
| 104 | 0 | $sth = $dbh->prepare($query); | ||||
| 105 | 0 | $sth->execute($cat); | ||||
| 106 | } | |||||
| 107 | else { | |||||
| 108 | 0 | my $query = "SELECT * FROM letter ORDER BY name"; | ||||
| 109 | 0 | $sth = $dbh->prepare($query); | ||||
| 110 | 0 | $sth->execute; | ||||
| 111 | } | |||||
| 112 | 0 | while ( my $letter = $sth->fetchrow_hashref ) { | ||||
| 113 | 0 | $letters{ $letter->{'code'} } = $letter->{'name'}; | ||||
| 114 | } | |||||
| 115 | 0 | return \%letters; | ||||
| 116 | } | |||||
| 117 | ||||||
| 118 | sub getletter ($$) { | |||||
| 119 | 0 | my ( $module, $code ) = @_; | ||||
| 120 | 0 | my $dbh = C4::Context->dbh; | ||||
| 121 | 0 | my $sth = $dbh->prepare("select * from letter where module=? and code=?"); | ||||
| 122 | 0 | $sth->execute( $module, $code ); | ||||
| 123 | 0 | my $line = $sth->fetchrow_hashref; | ||||
| 124 | 0 | return $line; | ||||
| 125 | } | |||||
| 126 | ||||||
| 127 - 136 | =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 | |||||
| 137 | ||||||
| 138 | sub addalert ($$$) { | |||||
| 139 | 0 | my ( $borrowernumber, $type, $externalid ) = @_; | ||||
| 140 | 0 | my $dbh = C4::Context->dbh; | ||||
| 141 | 0 | my $sth = | ||||
| 142 | $dbh->prepare( | |||||
| 143 | "insert into alert (borrowernumber, type, externalid) values (?,?,?)"); | |||||
| 144 | 0 | $sth->execute( $borrowernumber, $type, $externalid ); | ||||
| 145 | ||||||
| 146 | # get the alert number newly created and return it | |||||
| 147 | 0 | my $alertid = $dbh->{'mysql_insertid'}; | ||||
| 148 | 0 | return $alertid; | ||||
| 149 | } | |||||
| 150 | ||||||
| 151 - 157 | =head2 delalert ($alertid)
parameters :
- alertid : the alert id
deletes the alert
=cut | |||||
| 158 | ||||||
| 159 | sub delalert ($) { | |||||
| 160 | 0 | my $alertid = shift or die "delalert() called without valid argument (alertid)"; # it's gonna die anyway. | ||||
| 161 | 0 | $debug and warn "delalert: deleting alertid $alertid"; | ||||
| 162 | 0 | my $sth = C4::Context->dbh->prepare("delete from alert where alertid=?"); | ||||
| 163 | 0 | $sth->execute($alertid); | ||||
| 164 | } | |||||
| 165 | ||||||
| 166 - 174 | =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 | |||||
| 175 | ||||||
| 176 | sub getalert (;$$$) { | |||||
| 177 | 0 | my ( $borrowernumber, $type, $externalid ) = @_; | ||||
| 178 | 0 | my $dbh = C4::Context->dbh; | ||||
| 179 | 0 | my $query = "SELECT * FROM alert WHERE"; | ||||
| 180 | 0 | my @bind; | ||||
| 181 | 0 | if ($borrowernumber and $borrowernumber =~ /^\d+$/) { | ||||
| 182 | 0 | $query .= " borrowernumber=? AND "; | ||||
| 183 | 0 | push @bind, $borrowernumber; | ||||
| 184 | } | |||||
| 185 | 0 | if ($type) { | ||||
| 186 | 0 | $query .= " type=? AND "; | ||||
| 187 | 0 | push @bind, $type; | ||||
| 188 | } | |||||
| 189 | 0 | if ($externalid) { | ||||
| 190 | 0 | $query .= " externalid=? AND "; | ||||
| 191 | 0 | push @bind, $externalid; | ||||
| 192 | } | |||||
| 193 | 0 | $query =~ s/ AND $//; | ||||
| 194 | 0 | my $sth = $dbh->prepare($query); | ||||
| 195 | 0 | $sth->execute(@bind); | ||||
| 196 | 0 | return $sth->fetchall_arrayref({}); | ||||
| 197 | } | |||||
| 198 | ||||||
| 199 - 208 | =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 | |||||
| 209 | ||||||
| 210 | # outmoded POD: | |||||
| 211 | # When type=virtual, the id is related to a virtual shelf and this sub returns the name of the sub | |||||
| 212 | ||||||
| 213 | sub findrelatedto ($$) { | |||||
| 214 | 0 | my $type = shift or return undef; | ||||
| 215 | 0 | my $externalid = shift or return undef; | ||||
| 216 | 0 | my $q = ($type eq 'issue' ) ? | ||||
| 217 | "select title as result from subscription left join biblio on subscription.biblionumber=biblio.biblionumber where subscriptionid=?" : | |||||
| 218 | ($type eq 'borrower') ? | |||||
| 219 | "select concat(firstname,' ',surname) from borrowers where borrowernumber=?" : undef; | |||||
| 220 | 0 | unless ($q) { | ||||
| 221 | 0 | warn "findrelatedto(): Illegal type '$type'"; | ||||
| 222 | 0 | return undef; | ||||
| 223 | } | |||||
| 224 | 0 | my $sth = C4::Context->dbh->prepare($q); | ||||
| 225 | 0 | $sth->execute($externalid); | ||||
| 226 | 0 | my ($result) = $sth->fetchrow; | ||||
| 227 | 0 | return $result; | ||||
| 228 | } | |||||
| 229 | ||||||
| 230 - 239 | =head2 SendAlerts
parameters :
- $type : the type of alert
- $externalid : the id of the "object" to query
- $letter : the letter to send.
send an alert to all borrowers having put an alert on a given subject.
=cut | |||||
| 240 | ||||||
| 241 | sub SendAlerts { | |||||
| 242 | 0 | my ( $type, $externalid, $letter ) = @_; | ||||
| 243 | 0 | my $dbh = C4::Context->dbh; | ||||
| 244 | 0 | my $strsth; | ||||
| 245 | 0 | if ( $type eq 'issue' ) { | ||||
| 246 | ||||||
| 247 | # warn "sending issues..."; | |||||
| 248 | 0 | my $letter = getletter( 'serial', $letter ); | ||||
| 249 | ||||||
| 250 | # prepare the letter... | |||||
| 251 | # search the biblionumber | |||||
| 252 | 0 | my $sth = | ||||
| 253 | $dbh->prepare( | |||||
| 254 | "SELECT biblionumber FROM subscription WHERE subscriptionid=?"); | |||||
| 255 | 0 | $sth->execute($externalid); | ||||
| 256 | 0 | my ($biblionumber) = $sth->fetchrow; | ||||
| 257 | ||||||
| 258 | # parsing branch info | |||||
| 259 | 0 | my $userenv = C4::Context->userenv; | ||||
| 260 | 0 | parseletter( $letter, 'branches', $userenv->{branch} ); | ||||
| 261 | ||||||
| 262 | # parsing librarian name | |||||
| 263 | 0 | $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g; | ||||
| 264 | 0 | $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g; | ||||
| 265 | 0 | $letter->{content} =~ | ||||
| 266 | s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g; | |||||
| 267 | ||||||
| 268 | # parsing biblio information | |||||
| 269 | 0 | parseletter( $letter, 'biblio', $biblionumber ); | ||||
| 270 | 0 | parseletter( $letter, 'biblioitems', $biblionumber ); | ||||
| 271 | ||||||
| 272 | # find the list of borrowers to alert | |||||
| 273 | 0 | my $alerts = getalert( '', 'issue', $externalid ); | ||||
| 274 | 0 | foreach (@$alerts) { | ||||
| 275 | ||||||
| 276 | # and parse borrower ... | |||||
| 277 | 0 | my $innerletter = $letter; | ||||
| 278 | 0 | my $borinfo = C4::Members::GetMember('borrowernumber' => $_->{'borrowernumber'}); | ||||
| 279 | 0 | parseletter( $innerletter, 'borrowers', $_->{'borrowernumber'} ); | ||||
| 280 | ||||||
| 281 | # ... then send mail | |||||
| 282 | 0 | if ( $borinfo->{email} ) { | ||||
| 283 | 0 | my %mail = ( | ||||
| 284 | To => $borinfo->{email}, | |||||
| 285 | From => $borinfo->{email}, | |||||
| 286 | Subject => "" . $innerletter->{title}, | |||||
| 287 | Message => "" . $innerletter->{content}, | |||||
| 288 | 'Content-Type' => 'text/plain; charset="utf8"', | |||||
| 289 | ); | |||||
| 290 | 0 | sendmail(%mail) or carp $Mail::Sendmail::error; | ||||
| 291 | ||||||
| 292 | } | |||||
| 293 | } | |||||
| 294 | } | |||||
| 295 | elsif ( $type eq 'claimacquisition' ) { | |||||
| 296 | ||||||
| 297 | 0 | $letter = getletter( 'claimacquisition', $letter ); | ||||
| 298 | ||||||
| 299 | # prepare the letter... | |||||
| 300 | # search the biblionumber | |||||
| 301 | 0 | $strsth = qq{ | ||||
| 302 | SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*,aqbooksellers.* | |||||
| 303 | FROM aqorders | |||||
| 304 | LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno | |||||
| 305 | LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber | |||||
| 306 | LEFT JOIN biblioitems ON aqorders.biblioitemnumber=biblioitems.biblioitemnumber | |||||
| 307 | LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id | |||||
| 308 | WHERE aqorders.ordernumber IN ( | |||||
| 309 | } | |||||
| 310 | . join( ",", @$externalid ) . ")"; | |||||
| 311 | } | |||||
| 312 | elsif ( $type eq 'claimissues' ) { | |||||
| 313 | ||||||
| 314 | 0 | $letter = getletter( 'claimissues', $letter ); | ||||
| 315 | ||||||
| 316 | # prepare the letter... | |||||
| 317 | # search the biblionumber | |||||
| 318 | 0 | $strsth = 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 | . join( ",", @$externalid ) . ")"; | |||||
| 327 | } | |||||
| 328 | ||||||
| 329 | 0 | if ( $type eq 'claimacquisition' or $type eq 'claimissues' ) { | ||||
| 330 | 0 | my $sthorders = $dbh->prepare($strsth); | ||||
| 331 | 0 | $sthorders->execute; | ||||
| 332 | 0 | my @fields = map { | ||||
| 333 | 0 | $sthorders->{mysql_table}[$_] . "." . $sthorders->{NAME}[$_] } | ||||
| 334 | 0 | (0 .. $#{$sthorders->{NAME}} ) ; | ||||
| 335 | ||||||
| 336 | 0 | my @orders_infos; | ||||
| 337 | 0 | while ( my $row = $sthorders->fetchrow_arrayref() ) { | ||||
| 338 | 0 | my %rec = (); | ||||
| 339 | 0 | @rec{@fields} = @$row; | ||||
| 340 | 0 | push @orders_infos, \%rec; | ||||
| 341 | } | |||||
| 342 | ||||||
| 343 | # parsing branch info | |||||
| 344 | 0 | my $userenv = C4::Context->userenv; | ||||
| 345 | 0 | parseletter( $letter, 'branches', $userenv->{branch} ); | ||||
| 346 | ||||||
| 347 | # parsing librarian name | |||||
| 348 | 0 | $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g; | ||||
| 349 | 0 | $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g; | ||||
| 350 | 0 | $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g; | ||||
| 351 | ||||||
| 352 | # Get Fields remplacement | |||||
| 353 | 0 | my $order_format = $1 if ( $letter->{content} =~ m/(<order>.*<\/order>)/xms ); | ||||
| 354 | ||||||
| 355 | # Foreach field to remplace | |||||
| 356 | 0 | while ( $letter->{content} =~ m/<<([^>]*)>>/g ) { | ||||
| 357 | 0 | my $field = $1; | ||||
| 358 | 0 | my $value = $orders_infos[0]->{$field} || ""; | ||||
| 359 | 0 | $value = sprintf("%.2f", $value) if $field =~ /price/; | ||||
| 360 | 0 | $letter->{content} =~ s/<<$field>>/$value/g; | ||||
| 361 | } | |||||
| 362 | ||||||
| 363 | 0 | if ( $order_format ) { | ||||
| 364 | # For each order | |||||
| 365 | 0 | foreach my $infos ( @orders_infos ) { | ||||
| 366 | 0 | my $order_content = $order_format; | ||||
| 367 | # We replace by value | |||||
| 368 | 0 | while ( $order_content =~ m/<<([^>]*)>>/g ) { | ||||
| 369 | 0 | my $field = $1; | ||||
| 370 | 0 | my $value = $infos->{$field} || ""; | ||||
| 371 | 0 | $value = sprintf("%.2f", $value) if $field =~ /price/; | ||||
| 372 | 0 | $order_content =~ s/(<<$field>>)/$value/g; | ||||
| 373 | } | |||||
| 374 | 0 | $order_content =~ s/<\/{0,1}?order>//g; | ||||
| 375 | 0 | $letter->{content} =~ s/<order>.*<\/order>/$order_content\n$order_format/xms; | ||||
| 376 | } | |||||
| 377 | 0 | $letter->{content} =~ s/<order>.*<\/order>//xms; | ||||
| 378 | } | |||||
| 379 | ||||||
| 380 | 0 | my $innerletter = $letter; | ||||
| 381 | ||||||
| 382 | # ... then send mail | |||||
| 383 | 0 | if ( $orders_infos[0]->{'aqbooksellers.bookselleremail'} | ||||
| 384 | || $orders_infos[0]->{'aqbooksellers.contemail'} ) { | |||||
| 385 | 0 | my $to = $orders_infos[0]->{'aqbooksellers.bookselleremail'}; | ||||
| 386 | 0 | $to .= ", " if $to; | ||||
| 387 | 0 | $to .= $orders_infos[0]->{'aqbooksellers.contemail'} || ""; | ||||
| 388 | 0 | my %mail = ( | ||||
| 389 | To => $to, | |||||
| 390 | From => $userenv->{emailaddress}, | |||||
| 391 | Subject => Encode::encode( "utf8", "" . $innerletter->{title} ), | |||||
| 392 | Message => Encode::encode( "utf8", "" . $innerletter->{content} ), | |||||
| 393 | 'Content-Type' => 'text/plain; charset="utf8"', | |||||
| 394 | ); | |||||
| 395 | 0 | sendmail(%mail) or carp $Mail::Sendmail::error; | ||||
| 396 | 0 | warn "sending to $mail{To} From $mail{From} subj $mail{Subject} Mess $mail{Message}" if $debug; | ||||
| 397 | 0 | if ( C4::Context->preference("LetterLog") ) { | ||||
| 398 | 0 | logaction( "ACQUISITION", "Send Acquisition claim letter", "", "order list : " . join( ",", @$externalid ) . "\n$innerletter->{title}\n$innerletter->{content}" ) if $type eq 'claimacquisition'; | ||||
| 399 | 0 | logaction( "ACQUISITION", "CLAIM ISSUE", undef, "To=" . $mail{To} . " Title=" . $innerletter->{title} . " Content=" . $innerletter->{content} ) if $type eq 'claimissues'; | ||||
| 400 | } | |||||
| 401 | } else { | |||||
| 402 | 0 | return {error => "no_email" }; | ||||
| 403 | } | |||||
| 404 | ||||||
| 405 | 0 | warn "sending to From $userenv->{emailaddress} subj $innerletter->{title} Mess $innerletter->{content}" if $debug; | ||||
| 406 | } | |||||
| 407 | ||||||
| 408 | # send an "account details" notice to a newly created user | |||||
| 409 | elsif ( $type eq 'members' ) { | |||||
| 410 | # must parse the password special, before it's hashed. | |||||
| 411 | 0 | $letter->{content} =~ s/<<borrowers.password>>/$externalid->{'password'}/g; | ||||
| 412 | ||||||
| 413 | 0 | parseletter( $letter, 'borrowers', $externalid->{'borrowernumber'}); | ||||
| 414 | 0 | parseletter( $letter, 'branches', $externalid->{'branchcode'} ); | ||||
| 415 | ||||||
| 416 | 0 | my $branchdetails = GetBranchDetail($externalid->{'branchcode'}); | ||||
| 417 | 0 | my %mail = ( | ||||
| 418 | To => $externalid->{'emailaddr'}, | |||||
| 419 | From => $branchdetails->{'branchemail'} || C4::Context->preference("KohaAdminEmailAddress"), | |||||
| 420 | Subject => $letter->{'title'}, | |||||
| 421 | Message => $letter->{'content'}, | |||||
| 422 | 'Content-Type' => 'text/plain; charset="utf8"', | |||||
| 423 | ); | |||||
| 424 | 0 | sendmail(%mail) or carp $Mail::Sendmail::error; | ||||
| 425 | } | |||||
| 426 | } | |||||
| 427 | ||||||
| 428 - 437 | =head2 parseletter($letter, $table, $pk)
parameters :
- $letter : a hash to letter fields (title & content useful)
- $table : the Koha table to parse.
- $pk : the primary key to query on the $table table
parse all fields from a table, and replace values in title & content with the appropriate value
(not exported sub, used only internally)
=cut | |||||
| 438 | ||||||
| 439 | our %handles = (); | |||||
| 440 | our %columns = (); | |||||
| 441 | ||||||
| 442 | sub parseletter_sth { | |||||
| 443 | 0 | my $table = shift; | ||||
| 444 | 0 | unless ($table) { | ||||
| 445 | 0 | carp "ERROR: parseletter_sth() called without argument (table)"; | ||||
| 446 | 0 | return; | ||||
| 447 | } | |||||
| 448 | # check cache first | |||||
| 449 | 0 | (defined $handles{$table}) and return $handles{$table}; | ||||
| 450 | 0 | my $query = | ||||
| 451 | ($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" : | |||||
| 452 | ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" : | |||||
| 453 | ($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" : | |||||
| 454 | ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" : | |||||
| 455 | ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" : | |||||
| 456 | ($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" : | |||||
| 457 | ($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" : | |||||
| 458 | ($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" : | |||||
| 459 | ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" : undef ; | |||||
| 460 | 0 | unless ($query) { | ||||
| 461 | 0 | warn "ERROR: No parseletter_sth query for table '$table'"; | ||||
| 462 | 0 | return; # nothing to get | ||||
| 463 | } | |||||
| 464 | 0 | unless ($handles{$table} = C4::Context->dbh->prepare($query)) { | ||||
| 465 | 0 | warn "ERROR: Failed to prepare query: '$query'"; | ||||
| 466 | 0 | return; | ||||
| 467 | } | |||||
| 468 | 0 | return $handles{$table}; # now cache is populated for that $table | ||||
| 469 | } | |||||
| 470 | ||||||
| 471 | sub parseletter { | |||||
| 472 | 0 | my ( $letter, $table, $pk, $pk2 ) = @_; | ||||
| 473 | 0 | unless ($letter) { | ||||
| 474 | 0 | carp "ERROR: parseletter() 1st argument 'letter' empty"; | ||||
| 475 | 0 | return; | ||||
| 476 | } | |||||
| 477 | 0 | my $sth = parseletter_sth($table); | ||||
| 478 | 0 | unless ($sth) { | ||||
| 479 | 0 | warn "parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table."; | ||||
| 480 | 0 | return; | ||||
| 481 | } | |||||
| 482 | 0 | if ( $pk2 ) { | ||||
| 483 | 0 | $sth->execute($pk, $pk2); | ||||
| 484 | } else { | |||||
| 485 | 0 | $sth->execute($pk); | ||||
| 486 | } | |||||
| 487 | ||||||
| 488 | 0 | my $values = $sth->fetchrow_hashref; | ||||
| 489 | ||||||
| 490 | # TEMPORARY hack until the expirationdate column is added to reserves | |||||
| 491 | 0 | if ( $table eq 'reserves' && $values->{'waitingdate'} ) { | ||||
| 492 | 0 | my @waitingdate = split /-/, $values->{'waitingdate'}; | ||||
| 493 | ||||||
| 494 | 0 | $values->{'expirationdate'} = C4::Dates->new( | ||||
| 495 | sprintf( | |||||
| 496 | '%04d-%02d-%02d', | |||||
| 497 | Add_Delta_Days( @waitingdate, C4::Context->preference( 'ReservesMaxPickUpDelay' ) ) | |||||
| 498 | ), | |||||
| 499 | 'iso' | |||||
| 500 | )->output(); | |||||
| 501 | } | |||||
| 502 | ||||||
| 503 | ||||||
| 504 | # and get all fields from the table | |||||
| 505 | 0 | my $columns = C4::Context->dbh->prepare("SHOW COLUMNS FROM $table"); | ||||
| 506 | 0 | $columns->execute; | ||||
| 507 | 0 | while ( ( my $field ) = $columns->fetchrow_array ) { | ||||
| 508 | 0 | my $replacefield = "<<$table.$field>>"; | ||||
| 509 | 0 | $values->{$field} =~ s/\p{P}(?=$)//g if $values->{$field}; | ||||
| 510 | 0 | my $replacedby = $values->{$field} || ''; | ||||
| 511 | 0 | ($letter->{title} ) and $letter->{title} =~ s/$replacefield/$replacedby/g; | ||||
| 512 | 0 | ($letter->{content}) and $letter->{content} =~ s/$replacefield/$replacedby/g; | ||||
| 513 | } | |||||
| 514 | 0 | return $letter; | ||||
| 515 | } | |||||
| 516 | ||||||
| 517 - 528 | =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 | |||||
| 529 | ||||||
| 530 | sub EnqueueLetter ($) { | |||||
| 531 | 0 | my $params = shift or return undef; | ||||
| 532 | ||||||
| 533 | 0 | return unless exists $params->{'letter'}; | ||||
| 534 | 0 | return unless exists $params->{'borrowernumber'}; | ||||
| 535 | 0 | return unless exists $params->{'message_transport_type'}; | ||||
| 536 | ||||||
| 537 | # If we have any attachments we should encode then into the body. | |||||
| 538 | 0 | if ( $params->{'attachments'} ) { | ||||
| 539 | 0 | $params->{'letter'} = _add_attachments( | ||||
| 540 | { letter => $params->{'letter'}, | |||||
| 541 | attachments => $params->{'attachments'}, | |||||
| 542 | message => MIME::Lite->new( Type => 'multipart/mixed' ), | |||||
| 543 | } | |||||
| 544 | ); | |||||
| 545 | } | |||||
| 546 | ||||||
| 547 | 0 | my $dbh = C4::Context->dbh(); | ||||
| 548 | 0 | my $statement = << 'ENDSQL'; | ||||
| 549 | INSERT INTO message_queue | |||||
| 550 | ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type ) | |||||
| 551 | VALUES | |||||
| 552 | ( ?, ?, ?, ?, ?, ?, ?, NOW(), ?, ?, ? ) | |||||
| 553 | ENDSQL | |||||
| 554 | ||||||
| 555 | 0 | my $sth = $dbh->prepare($statement); | ||||
| 556 | 0 | my $result = $sth->execute( | ||||
| 557 | $params->{'borrowernumber'}, # borrowernumber | |||||
| 558 | $params->{'letter'}->{'title'}, # subject | |||||
| 559 | $params->{'letter'}->{'content'}, # content | |||||
| 560 | $params->{'letter'}->{'metadata'} || '', # metadata | |||||
| 561 | $params->{'letter'}->{'code'} || '', # letter_code | |||||
| 562 | $params->{'message_transport_type'}, # message_transport_type | |||||
| 563 | 'pending', # status | |||||
| 564 | $params->{'to_address'}, # to_address | |||||
| 565 | $params->{'from_address'}, # from_address | |||||
| 566 | $params->{'letter'}->{'content-type'}, # content_type | |||||
| 567 | ); | |||||
| 568 | 0 | return $result; | ||||
| 569 | } | |||||
| 570 | ||||||
| 571 - 579 | =head2 SendQueuedMessages ([$hashref])
my $sent = SendQueuedMessages( { verbose => 1 } );
sends all of the 'pending' items in the message queue.
returns number of messages sent.
=cut | |||||
| 580 | ||||||
| 581 | sub SendQueuedMessages (;$) { | |||||
| 582 | 0 | my $params = shift; | ||||
| 583 | ||||||
| 584 | 0 | my $unsent_messages = _get_unsent_messages(); | ||||
| 585 | 0 | MESSAGE: foreach my $message ( @$unsent_messages ) { | ||||
| 586 | # warn Data::Dumper->Dump( [ $message ], [ 'message' ] ); | |||||
| 587 | 0 | warn sprintf( 'sending %s message to patron: %s', | ||||
| 588 | $message->{'message_transport_type'}, | |||||
| 589 | $message->{'borrowernumber'} || 'Admin' ) | |||||
| 590 | if $params->{'verbose'} or $debug; | |||||
| 591 | # This is just begging for subclassing | |||||
| 592 | 0 | next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' ); | ||||
| 593 | 0 | if ( lc( $message->{'message_transport_type'} ) eq 'email' ) { | ||||
| 594 | 0 | _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} ); | ||||
| 595 | } | |||||
| 596 | elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) { | |||||
| 597 | 0 | _send_message_by_sms( $message ); | ||||
| 598 | } | |||||
| 599 | } | |||||
| 600 | 0 | return scalar( @$unsent_messages ); | ||||
| 601 | } | |||||
| 602 | ||||||
| 603 - 609 | =head2 GetRSSMessages
my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
returns a listref of all queued RSS messages for a particular person.
=cut | |||||
| 610 | ||||||
| 611 | sub GetRSSMessages { | |||||
| 612 | 0 | my $params = shift; | ||||
| 613 | ||||||
| 614 | 0 | return unless $params; | ||||
| 615 | 0 | return unless ref $params; | ||||
| 616 | 0 | return unless $params->{'borrowernumber'}; | ||||
| 617 | ||||||
| 618 | 0 | return _get_unsent_messages( { message_transport_type => 'rss', | ||||
| 619 | limit => $params->{'limit'}, | |||||
| 620 | borrowernumber => $params->{'borrowernumber'}, } ); | |||||
| 621 | } | |||||
| 622 | ||||||
| 623 - 630 | =head2 GetPrintMessages
my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
Returns a arrayref of all queued print messages (optionally, for a particular
person).
=cut | |||||
| 631 | ||||||
| 632 | sub GetPrintMessages { | |||||
| 633 | 0 | my $params = shift || {}; | ||||
| 634 | ||||||
| 635 | 0 | return _get_unsent_messages( { message_transport_type => 'print', | ||||
| 636 | borrowernumber => $params->{'borrowernumber'}, } ); | |||||
| 637 | } | |||||
| 638 | ||||||
| 639 - 648 | =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 | |||||
| 649 | ||||||
| 650 | sub GetQueuedMessages { | |||||
| 651 | 0 | my $params = shift; | ||||
| 652 | ||||||
| 653 | 0 | my $dbh = C4::Context->dbh(); | ||||
| 654 | 0 | my $statement = << 'ENDSQL'; | ||||
| 655 | SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued | |||||
| 656 | FROM message_queue | |||||
| 657 | ENDSQL | |||||
| 658 | ||||||
| 659 | 0 | my @query_params; | ||||
| 660 | 0 | my @whereclauses; | ||||
| 661 | 0 | if ( exists $params->{'borrowernumber'} ) { | ||||
| 662 | 0 | push @whereclauses, ' borrowernumber = ? '; | ||||
| 663 | 0 | push @query_params, $params->{'borrowernumber'}; | ||||
| 664 | } | |||||
| 665 | ||||||
| 666 | 0 | if ( @whereclauses ) { | ||||
| 667 | 0 | $statement .= ' WHERE ' . join( 'AND', @whereclauses ); | ||||
| 668 | } | |||||
| 669 | ||||||
| 670 | 0 | if ( defined $params->{'limit'} ) { | ||||
| 671 | 0 | $statement .= ' LIMIT ? '; | ||||
| 672 | 0 | push @query_params, $params->{'limit'}; | ||||
| 673 | } | |||||
| 674 | ||||||
| 675 | 0 | my $sth = $dbh->prepare( $statement ); | ||||
| 676 | 0 | my $result = $sth->execute( @query_params ); | ||||
| 677 | 0 | return $sth->fetchall_arrayref({}); | ||||
| 678 | } | |||||
| 679 | ||||||
| 680 - 692 | =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 | |||||
| 693 | ||||||
| 694 | sub _add_attachments { | |||||
| 695 | 0 | my $params = shift; | ||||
| 696 | ||||||
| 697 | 0 | return unless 'HASH' eq ref $params; | ||||
| 698 | 0 | foreach my $required_parameter (qw( letter attachments message )) { | ||||
| 699 | 0 | return unless exists $params->{$required_parameter}; | ||||
| 700 | } | |||||
| 701 | 0 0 | return $params->{'letter'} unless @{ $params->{'attachments'} }; | ||||
| 702 | ||||||
| 703 | # First, we have to put the body in as the first attachment | |||||
| 704 | 0 | $params->{'message'}->attach( | ||||
| 705 | Type => 'TEXT', | |||||
| 706 | Data => $params->{'letter'}->{'content'}, | |||||
| 707 | ); | |||||
| 708 | ||||||
| 709 | 0 0 | foreach my $attachment ( @{ $params->{'attachments'} } ) { | ||||
| 710 | 0 | $params->{'message'}->attach( | ||||
| 711 | Type => $attachment->{'type'}, | |||||
| 712 | Data => $attachment->{'content'}, | |||||
| 713 | Filename => $attachment->{'filename'}, | |||||
| 714 | ); | |||||
| 715 | } | |||||
| 716 | # we're forcing list context here to get the header, not the count back from grep. | |||||
| 717 | 0 | ( $params->{'letter'}->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) ); | ||||
| 718 | 0 | $params->{'letter'}->{'content-type'} =~ s/^Content-Type:\s+//; | ||||
| 719 | 0 | $params->{'letter'}->{'content'} = $params->{'message'}->body_as_string; | ||||
| 720 | ||||||
| 721 | 0 | return $params->{'letter'}; | ||||
| 722 | ||||||
| 723 | } | |||||
| 724 | ||||||
| 725 | sub _get_unsent_messages (;$) { | |||||
| 726 | 0 | my $params = shift; | ||||
| 727 | ||||||
| 728 | 0 | my $dbh = C4::Context->dbh(); | ||||
| 729 | 0 | my $statement = << 'ENDSQL'; | ||||
| 730 | SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, from_address, to_address, content_type | |||||
| 731 | FROM message_queue | |||||
| 732 | WHERE status = ? | |||||
| 733 | ENDSQL | |||||
| 734 | ||||||
| 735 | 0 | my @query_params = ('pending'); | ||||
| 736 | 0 | if ( ref $params ) { | ||||
| 737 | 0 | if ( $params->{'message_transport_type'} ) { | ||||
| 738 | 0 | $statement .= ' AND message_transport_type = ? '; | ||||
| 739 | 0 | push @query_params, $params->{'message_transport_type'}; | ||||
| 740 | } | |||||
| 741 | 0 | if ( $params->{'borrowernumber'} ) { | ||||
| 742 | 0 | $statement .= ' AND borrowernumber = ? '; | ||||
| 743 | 0 | push @query_params, $params->{'borrowernumber'}; | ||||
| 744 | } | |||||
| 745 | 0 | if ( $params->{'limit'} ) { | ||||
| 746 | 0 | $statement .= ' limit ? '; | ||||
| 747 | 0 | push @query_params, $params->{'limit'}; | ||||
| 748 | } | |||||
| 749 | } | |||||
| 750 | 0 | $debug and warn "_get_unsent_messages SQL: $statement"; | ||||
| 751 | 0 | $debug and warn "_get_unsent_messages params: " . join(',',@query_params); | ||||
| 752 | 0 | my $sth = $dbh->prepare( $statement ); | ||||
| 753 | 0 | my $result = $sth->execute( @query_params ); | ||||
| 754 | 0 | return $sth->fetchall_arrayref({}); | ||||
| 755 | } | |||||
| 756 | ||||||
| 757 | sub _send_message_by_email ($;$$$) { | |||||
| 758 | 0 | my $message = shift or return; | ||||
| 759 | 0 | my ($username, $password, $method) = @_; | ||||
| 760 | ||||||
| 761 | 0 | my $to_address = $message->{to_address}; | ||||
| 762 | 0 | unless ($to_address) { | ||||
| 763 | 0 | my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} ); | ||||
| 764 | 0 | unless ($member) { | ||||
| 765 | 0 | warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})"; | ||||
| 766 | 0 | _set_message_status( { message_id => $message->{'message_id'}, | ||||
| 767 | status => 'failed' } ); | |||||
| 768 | 0 | return; | ||||
| 769 | } | |||||
| 770 | 0 | my $which_address = C4::Context->preference('AutoEmailPrimaryAddress'); | ||||
| 771 | # If the system preference is set to 'first valid' (value == OFF), look up email address | |||||
| 772 | 0 | if ($which_address eq 'OFF') { | ||||
| 773 | 0 | $to_address = GetFirstValidEmailAddress( $message->{'borrowernumber'} ); | ||||
| 774 | } else { | |||||
| 775 | 0 | $to_address = $member->{$which_address}; | ||||
| 776 | } | |||||
| 777 | 0 | unless ($to_address) { | ||||
| 778 | # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})"; | |||||
| 779 | # warning too verbose for this more common case? | |||||
| 780 | 0 | _set_message_status( { message_id => $message->{'message_id'}, | ||||
| 781 | status => 'failed' } ); | |||||
| 782 | 0 | return; | ||||
| 783 | } | |||||
| 784 | } | |||||
| 785 | ||||||
| 786 | 0 | my $utf8 = decode('MIME-Header', $message->{'subject'} ); | ||||
| 787 | 0 | $message->{subject}= encode('MIME-Header', $utf8); | ||||
| 788 | 0 | my $content = encode('utf8', $message->{'content'}); | ||||
| 789 | 0 | my %sendmail_params = ( | ||||
| 790 | To => $to_address, | |||||
| 791 | From => $message->{'from_address'} || C4::Context->preference('KohaAdminEmailAddress'), | |||||
| 792 | Subject => encode('utf8', $message->{'subject'}), | |||||
| 793 | charset => 'utf8', | |||||
| 794 | Message => $content, | |||||
| 795 | 'content-type' => $message->{'content_type'} || 'text/plain; charset="UTF-8"', | |||||
| 796 | ); | |||||
| 797 | 0 | $sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username; | ||||
| 798 | 0 | if ( my $bcc = C4::Context->preference('OverdueNoticeBcc') ) { | ||||
| 799 | 0 | $sendmail_params{ Bcc } = $bcc; | ||||
| 800 | } | |||||
| 801 | ||||||
| 802 | 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 | ||||
| 803 | 0 | if ( sendmail( %sendmail_params ) ) { | ||||
| 804 | 0 | _set_message_status( { message_id => $message->{'message_id'}, | ||||
| 805 | status => 'sent' } ); | |||||
| 806 | 0 | return 1; | ||||
| 807 | } else { | |||||
| 808 | 0 | _set_message_status( { message_id => $message->{'message_id'}, | ||||
| 809 | status => 'failed' } ); | |||||
| 810 | 0 | carp $Mail::Sendmail::error; | ||||
| 811 | 0 | return; | ||||
| 812 | } | |||||
| 813 | } | |||||
| 814 | ||||||
| 815 | sub _send_message_by_sms ($) { | |||||
| 816 | 0 | my $message = shift or return undef; | ||||
| 817 | 0 | my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} ); | ||||
| 818 | 0 | return unless $member->{'smsalertnumber'}; | ||||
| 819 | ||||||
| 820 | 0 | my $success = C4::SMS->send_sms( { destination => $member->{'smsalertnumber'}, | ||||
| 821 | message => $message->{'content'}, | |||||
| 822 | } ); | |||||
| 823 | 0 | _set_message_status( { message_id => $message->{'message_id'}, | ||||
| 824 | status => ($success ? 'sent' : 'failed') } ); | |||||
| 825 | 0 | return $success; | ||||
| 826 | } | |||||
| 827 | ||||||
| 828 | sub _update_message_to_address { | |||||
| 829 | 0 | my ($id, $to)= @_; | ||||
| 830 | 0 | my $dbh = C4::Context->dbh(); | ||||
| 831 | 0 | $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id)); | ||||
| 832 | } | |||||
| 833 | ||||||
| 834 | sub _set_message_status ($) { | |||||
| 835 | 0 | my $params = shift or return undef; | ||||
| 836 | ||||||
| 837 | 0 | foreach my $required_parameter ( qw( message_id status ) ) { | ||||
| 838 | 0 | return undef unless exists $params->{ $required_parameter }; | ||||
| 839 | } | |||||
| 840 | ||||||
| 841 | 0 | my $dbh = C4::Context->dbh(); | ||||
| 842 | 0 | my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?'; | ||||
| 843 | 0 | my $sth = $dbh->prepare( $statement ); | ||||
| 844 | 0 | my $result = $sth->execute( $params->{'status'}, | ||||
| 845 | $params->{'message_id'} ); | |||||
| 846 | 0 | return $result; | ||||
| 847 | } | |||||
| 848 | ||||||
| 849 | ||||||
| 850 | 1; | |||||