use MIME::Lite;
use Mail::Sendmail;
+use Date::Calc qw( Add_Delta_Days );
+use Encode;
+use Carp;
+use Template;
+use Module::Load::Conditional qw(can_load);
use C4::Koha qw(GetAuthorisedValueByCode);
use C4::Members;
use C4::SMS;
use C4::Debug;
use Koha::DateUtils;
-use Date::Calc qw( Add_Delta_Days );
-use Encode;
-use Carp;
+use Koha::SMS::Providers;
+
use Koha::Email;
+use Koha::DateUtils qw( format_sqldatetime dt_from_string );
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
BEGIN {
require Exporter;
- # set the version for version checking
- $VERSION = 3.07.00.049;
@ISA = qw(Exporter);
@EXPORT = qw(
&GetLetters &GetLettersAvailableForALibrary &GetLetterTemplates &DelLetter &GetPreparedLetter &GetWrappedLetter &addalert &getalert &delalert &findrelatedto &SendAlerts &GetPrintMessages &GetMessageTransportTypes
}
-# FIXME: using our here means that a Plack server will need to be
-# restarted fairly regularly when working with this routine.
-# A better option would be to use Koha::Cache and use a cache
-# that actually works in a persistent environment, but as a
-# short-term fix, our will work.
-our %letter;
sub getletter {
my ( $module, $code, $branchcode, $message_transport_type ) = @_;
- $message_transport_type ||= 'email';
-
+ $message_transport_type //= '%';
if ( C4::Context->preference('IndependentBranches')
and $branchcode
}
$branchcode //= '';
- if ( my $l = $letter{$module}{$code}{$branchcode}{$message_transport_type} ) {
- return { %$l }; # deep copy
- }
-
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare(q{
SELECT *
FROM letter
- WHERE module=? AND code=? AND (branchcode = ? OR branchcode = '') AND message_transport_type = ?
+ WHERE module=? AND code=? AND (branchcode = ? OR branchcode = '')
+ AND message_transport_type LIKE ?
ORDER BY branchcode DESC LIMIT 1
});
$sth->execute( $module, $code, $branchcode, $message_transport_type );
my $line = $sth->fetchrow_hashref
or return;
$line->{'content-type'} = 'text/html; charset="UTF-8"' if $line->{is_html};
- $letter{$module}{$code}{$branchcode}{$message_transport_type} = $line;
return { %$line };
}
+
=head2 DelLetter
DelLetter(
sub getalert {
my ( $borrowernumber, $type, $externalid ) = @_;
my $dbh = C4::Context->dbh;
- my $query = "SELECT a.*, b.branchcode FROM alert a JOIN borrowers b USING(borrowernumber) WHERE";
+ my $query = "SELECT a.*, b.branchcode FROM alert a JOIN borrowers b USING(borrowernumber) WHERE 1";
my @bind;
if ($borrowernumber and $borrowernumber =~ /^\d+$/) {
- $query .= " borrowernumber=? AND ";
+ $query .= " AND borrowernumber=?";
push @bind, $borrowernumber;
}
if ($type) {
- $query .= " type=? AND ";
+ $query .= " AND type=?";
push @bind, $type;
}
if ($externalid) {
- $query .= " externalid=? AND ";
+ $query .= " AND externalid=?";
push @bind, $externalid;
}
- $query =~ s/ AND $//;
my $sth = $dbh->prepare($query);
$sth->execute(@bind);
return $sth->fetchall_arrayref({});
if ( $type eq 'issue' ) {
# prepare the letter...
- # search the biblionumber
+ # search the subscriptionid
my $sth =
$dbh->prepare(
- "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
+ "SELECT subscriptionid FROM serial WHERE serialid=?");
$sth->execute($externalid);
- my ($biblionumber) = $sth->fetchrow
+ my ($subscriptionid) = $sth->fetchrow
or warn( "No subscription for '$externalid'" ),
return;
+ # search the biblionumber
+ $sth =
+ $dbh->prepare(
+ "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
+ $sth->execute($subscriptionid);
+ my ($biblionumber) = $sth->fetchrow
+ or warn( "No biblionumber for '$subscriptionid'" ),
+ return;
+
my %letter;
# find the list of borrowers to alert
- my $alerts = getalert( '', 'issue', $externalid );
+ my $alerts = getalert( '', 'issue', $subscriptionid );
foreach (@$alerts) {
my $borinfo = C4::Members::GetMember('borrowernumber' => $_->{'borrowernumber'});
my $email = $borinfo->{email} or next;
# warn "sending issues...";
my $userenv = C4::Context->userenv;
- my $branchdetails = GetBranchDetail($_->{'branchcode'});
+ my $library = Koha::Libraries->find( $_->{branchcode} );
my $letter = GetPreparedLetter (
module => 'serial',
letter_code => $letter_code,
'biblio' => $biblionumber,
'biblioitems' => $biblionumber,
'borrowers' => $borinfo,
+ 'subscription' => $subscriptionid,
+ 'serial' => $externalid,
},
want_librarian => 1,
) or return;
my %mail = $message->create_message_headers(
{
to => $email,
- from => $branchdetails->{'branchemail'},
- replyto => $branchdetails->{'branchreplyto'},
- sender => $branchdetails->{'branchreturnpath'},
+ from => $library->branchemail,
+ replyto => $library->branchreplyto,
+ sender => $library->branchreturnpath,
subject => Encode::encode( "UTF-8", "" . $letter->{title} ),
message => $letter->{'is_html'}
? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ),
if C4::Context->preference('ReplytoDefault');
$mail{'Sender'} = C4::Context->preference('ReturnpathDefault')
if C4::Context->preference('ReturnpathDefault');
+ $mail{'Bcc'} = $userenv->{emailaddress}
+ if C4::Context->preference("ClaimsBccCopy");
unless ( sendmail(%mail) ) {
carp $Mail::Sendmail::error;
}
# send an "account details" notice to a newly created user
elsif ( $type eq 'members' ) {
- my $branchdetails = GetBranchDetail($externalid->{'branchcode'});
+ my $library = Koha::Libraries->find( $externalid->{branchcode} )->unblessed;
my $letter = GetPreparedLetter (
module => 'members',
letter_code => $letter_code,
branchcode => $externalid->{'branchcode'},
tables => {
- 'branches' => $branchdetails,
+ 'branches' => $library,
'borrowers' => $externalid->{'borrowernumber'},
},
substitute => { 'borrowers.password' => $externalid->{'password'} },
my %mail = $email->create_message_headers(
{
to => $externalid->{'emailaddr'},
- from => $branchdetails->{'branchemail'},
- replyto => $branchdetails->{'branchreplyto'},
- sender => $branchdetails->{'branchreturnpath'},
+ from => $library->{branchemail},
+ replyto => $library->{branchreplyto},
+ sender => $library->{branchreturnpath},
subject => Encode::encode( "UTF-8", "" . $letter->{'title'} ),
message => $letter->{'is_html'}
? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ),
if ($substitute) {
while ( my ($token, $val) = each %$substitute ) {
+ if ( $token eq 'items.content' ) {
+ $val =~ s|\n|<br/>|g if $letter->{is_html};
+ }
+
$letter->{title} =~ s/<<$token>>/$val/g;
$letter->{content} =~ s/<<$token>>/$val/g;
}
}
}
+ $letter->{content} = _process_tt(
+ {
+ content => $letter->{content},
+ tables => $tables,
+ }
+ );
+
$letter->{content} =~ s/<<\S*>>//go; #remove any stragglers
-# $letter->{content} =~ s/<<[^>]*>>//go;
return $letter;
}
($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" :
($table eq 'opac_news' ) ? "SELECT * FROM $table WHERE idnew = ?" :
($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
+ ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
+ ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
undef ;
unless ($query) {
warn "ERROR: No _parseletter_sth query for table '$table'";
parameters :
- $letter : a hash to letter fields (title & content useful)
- $table : the Koha table to parse.
- - $values : table record hashref
+ - $values_in : 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
sub _parseletter {
- my ( $letter, $table, $values ) = @_;
+ my ( $letter, $table, $values_in ) = @_;
+
+ # Work on a local copy of $values_in (passed by reference) to avoid side effects
+ # in callers ( by changing / formatting values )
+ my $values = $values_in ? { %$values_in } : {};
+
+ if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
+ $values->{'dateexpiry'} = format_sqldatetime( $values->{'dateexpiry'} );
+ }
if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
my @waitingdate = split /-/, $values->{'waitingdate'};
$values->{'expirationdate'} = '';
- if( C4::Context->preference('ExpireReservesMaxPickUpDelay') &&
- C4::Context->preference('ReservesMaxPickUpDelay') ) {
+ if ( C4::Context->preference('ReservesMaxPickUpDelay') ) {
my $dt = dt_from_string();
$dt->add( days => C4::Context->preference('ReservesMaxPickUpDelay') );
- $values->{'expirationdate'} = output_pref({ dt => $dt, dateonly => 1 });
+ $values->{'expirationdate'} = output_pref( { dt => $dt, dateonly => 1 } );
}
$values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
}
while ( my ($field, $val) = each %$values ) {
- my $replacetablefield = "<<$table.$field>>";
- my $replacefield = "<<$field>>";
$val =~ s/\p{P}$// if $val && $table=~/biblio/;
#BZ 9886: Assuming that we want to eliminate ISBD punctuation here
#Therefore adding the test on biblio. This includes biblioitems,
#but excludes items. Removed unneeded global and lookahead.
$val = GetAuthorisedValueByCode ('ROADTYPE', $val, 0) if $table=~/^borrowers$/ && $field=~/^streettype$/;
+
+ # Dates replacement
my $replacedby = defined ($val) ? $val : '';
if ( $replacedby
and not $replacedby =~ m|0000-00-00|
{
# If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
- eval {
- $replacedby = output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly });
- };
- warn "$replacedby seems to be a date but an error occurs on generating it ($@)" if $@;
+ my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
+
+ for my $letter_field ( qw( title content ) ) {
+ my $filter_string_used = q{};
+ if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
+ # We overwrite $dateonly if the filter exists and we have a time in the datetime
+ $filter_string_used = $1 || q{};
+ $dateonly = $1 unless $dateonly;
+ }
+ my $replacedby_date = eval {
+ output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly });
+ };
+
+ if ( $letter->{ $letter_field } ) {
+ $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
+ $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
+ }
+ }
+ }
+ # Other fields replacement
+ else {
+ for my $letter_field ( qw( title content ) ) {
+ if ( $letter->{ $letter_field } ) {
+ $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g;
+ $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g;
+ }
+ }
}
- ($letter->{title} ) and do {
- $letter->{title} =~ s/$replacetablefield/$replacedby/g;
- $letter->{title} =~ s/$replacefield/$replacedby/g;
- };
- ($letter->{content}) and do {
- $letter->{content} =~ s/$replacetablefield/$replacedby/g;
- $letter->{content} =~ s/$replacefield/$replacedby/g;
- };
}
if ($table eq 'borrowers' && $letter->{content}) {
_send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
}
elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
- _send_message_by_sms( $message );
+ if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
+ my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} );
+ my $sms_provider = Koha::SMS::Providers->find( $member->{'sms_provider_id'} );
+ $message->{to_address} .= '@' . $sms_provider->domain();
+ _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
+ } else {
+ _send_message_by_sms( $message );
+ }
}
}
return scalar( @$unsent_messages );
return $mtts;
}
+=head2 GetMessage
+
+ my $message = C4::Letters::Message($message_id);
+
+=cut
+
+sub GetMessage {
+ my ( $message_id ) = @_;
+ return unless $message_id;
+ my $dbh = C4::Context->dbh;
+ return $dbh->selectrow_hashref(q|
+ SELECT message_id, borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type
+ FROM message_queue
+ WHERE message_id = ?
+ |, {}, $message_id );
+}
+
+=head2 ResendMessage
+
+ Attempt to resend a message which has failed previously.
+
+ my $has_been_resent = C4::Letters::ResendMessage($message_id);
+
+ Updates the message to 'pending' status so that
+ it will be resent later on.
+
+ returns 1 on success, 0 on failure, undef if no message was found
+
+=cut
+
+sub ResendMessage {
+ my $message_id = shift;
+ return unless $message_id;
+
+ my $message = GetMessage( $message_id );
+ return unless $message;
+ my $rv = 0;
+ if ( $message->{status} ne 'pending' ) {
+ $rv = C4::Letters::_set_message_status({
+ message_id => $message_id,
+ status => 'pending',
+ });
+ $rv = $rv > 0? 1: 0;
+ # Clear destination email address to force address update
+ _update_message_to_address( $message_id, undef ) if $rv &&
+ $message->{message_transport_type} eq 'email';
+ }
+ return $rv;
+}
+
=head2 _add_attachements
named parameters:
my $branch_email = undef;
my $branch_replyto = undef;
my $branch_returnpath = undef;
- if ($member){
- my $branchdetail = GetBranchDetail( $member->{'branchcode'} );
- $branch_email = $branchdetail->{'branchemail'};
- $branch_replyto = $branchdetail->{'branchreplyto'};
- $branch_returnpath = $branchdetail->{'branchreturnpath'};
+ if ($member) {
+ my $library = Koha::Libraries->find( $member->{branchcode} );
+ $branch_email = $library->branchemail;
+ $branch_replyto = $library->branchreplyto;
+ $branch_returnpath = $library->branchreturnpath;
}
my $email = Koha::Email->new();
my %sendmail_params = $email->create_message_headers(
}
_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
+
if ( sendmail( %sendmail_params ) ) {
_set_message_status( { message_id => $message->{'message_id'},
status => 'sent' } );
return $result;
}
+sub _process_tt {
+ my ( $params ) = @_;
+
+ my $content = $params->{content};
+ my $tables = $params->{tables};
+
+ my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
+ my $template = Template->new(
+ {
+ EVAL_PERL => 1,
+ ABSOLUTE => 1,
+ PLUGIN_BASE => 'Koha::Template::Plugin',
+ COMPILE_EXT => $use_template_cache ? '.ttc' : '',
+ COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
+ FILTERS => {},
+ ENCODING => 'UTF-8',
+ }
+ ) or die Template->error();
+
+ my $tt_params = _get_tt_params( $tables );
+
+ my $output;
+ $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error();
+
+ return $output;
+}
+
+sub _get_tt_params {
+ my ($tables) = @_;
+
+ my $params;
+
+ my $config = {
+ biblio => {
+ module => 'Koha::Biblios',
+ singular => 'biblio',
+ plural => 'biblios',
+ pk => 'biblionumber',
+ },
+ borrowers => {
+ module => 'Koha::Patrons',
+ singular => 'borrower',
+ plural => 'borrowers',
+ pk => 'borrowernumber',
+ },
+ branches => {
+ module => 'Koha::Libraries',
+ singular => 'branch',
+ plural => 'branches',
+ pk => 'branchcode',
+ },
+ items => {
+ module => 'Koha::Items',
+ singular => 'item',
+ plural => 'items',
+ pk => 'itemnumber',
+ },
+ opac_news => {
+ module => 'Koha::News',
+ singular => 'news',
+ plural => 'news',
+ pk => 'idnew',
+ },
+ reserves => {
+ module => 'Koha::Holds',
+ singular => 'hold',
+ plural => 'holds',
+ fk => [ 'borrowernumber', 'biblionumber' ],
+ },
+ serial => {
+ module => 'Koha::Serials',
+ singular => 'serial',
+ plural => 'serials',
+ pk => 'serialid',
+ },
+ subscription => {
+ module => 'Koha::Subscriptions',
+ singular => 'subscription',
+ plural => 'subscriptions',
+ pk => 'subscriptionid',
+ },
+ suggestions => {
+ module => 'Koha::Suggestions',
+ singular => 'suggestion',
+ plural => 'suggestions',
+ pk => 'suggestionid',
+ },
+ issues => {
+ module => 'Koha::Checkouts',
+ singular => 'checkout',
+ plural => 'checkouts',
+ fk => 'itemnumber',
+ },
+ borrower_modifications => {
+ module => 'Koha::Patron::Modifications',
+ singular => 'patron_modification',
+ plural => 'patron_modifications',
+ fk => 'verification_token',
+ },
+ };
+
+ foreach my $table ( keys %$tables ) {
+ next unless $config->{$table};
+
+ my $ref = ref( $tables->{$table} ) || q{};
+ my $module = $config->{$table}->{module};
+
+ if ( can_load( modules => { $module => undef } ) ) {
+ my $pk = $config->{$table}->{pk};
+ my $fk = $config->{$table}->{fk};
+
+ if ( $ref eq q{} || $ref eq 'HASH' ) {
+ my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
+ my $object;
+ if ( $fk ) { # Using a foreign key for lookup
+ $object = $module->search( { $fk => $id } )->next();
+ } else { # using the table's primary key for lookup
+ $object = $module->find($id);
+ }
+ $params->{ $config->{$table}->{singular} } = $object;
+ }
+ else { # $ref eq 'ARRAY'
+ my $object;
+ if ( @{ $tables->{$table} } == 1 ) { # Param is a single key
+ $object = $module->search( { $pk => $tables->{$table} } )->next();
+ }
+ else { # Params are mutliple foreign keys
+ my @values = @{ $tables->{$table} };
+ my @keys = @{ $config->{$table}->{fk} };
+ my %params = map { $_ => shift(@values) } @keys;
+ $object = $module->search( \%params )->next();
+ }
+ $params->{ $config->{$table}->{singular} } = $object;
+ }
+ }
+ else {
+ croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
+ }
+ }
+
+ $params->{today} = dt_from_string();
+
+ return $params;
+}
+
1;
__END__