I'm writing an email service which sends data to my users with Email::Sender::Simple and Email::Sender::Transport::SMTPS. Right now, I've got a package which should just take some inputs and send an e-mail:
package MyApp::Service::Mail;
use Email::Sender::Simple qw(sendmail);
use Email::Simple;
use Email::Sender::Transport::SMTPS;
use Try::Tiny;
use Dancer;
use constant CANT_SEND_MAIL => -1;
use constant SENT_SUCCESSFULLY => 1;
sub new {
my $class = shift;
my $self = {};
bless $self, $class;
return $self;
}
sub sendEmail {
my $self = shift;
my $to = shift;
my $subject = shift;
my $body = shift;
my $failed = 0;
my $email = Email::Simple->create(
header => [
To => $to,
From => 'noreply#myapp.com',
Subject => $subject
],
body => $body
);
my $transport = Email::Sender::Transport::SMTPS->new({
host => config->{smtp_host},
port => config->{smtp_port},
sasl_username => config->{smtp_username},
sasl_password => config->{smtp_password},
ssl => 'ssl'
});
try {
sendmail($email, {transport => $transport});
} catch {
$failed = 1;
}
return $self->CANT_SEND_MAIL if ($failed eq 1);
return $self->SENT_SUCCESSFULLY;
}
1;
This is based heavily on the example from the CPAN page for the modules involved.
Note that those config variables are coming from Dancers config.yml, and I have confirmed they are being passed in correctly. I have also confirmed that $to, $body and $subject contain what I expect them to.
The sendEmail function is being called and returning 1 (SENT_SUCCESSFULLY) but I cannot see anything in the Sent box on my e-mail client, and there is nothing at the receiving address either. I've been trying to find some kind of debug function to delve deeper into why this is failing, but to no avail.
Code calling this is:
package MyApp::Service::Mail::User;
use MyApp::Service::Mail;
our #ISA = qw(MyApp::Service::Mail);
sub sendPasswordByEmail {
my $self = shift;
my $to = shift;
my $username = shift;
my $subject = "Test E-Mail";
(my $body = << " END_MESSAGE") =~ s/^ {4}//gm;
Dear $username,
This is a test e-mail.
END_MESSAGE
return $self->sendEmail($to, $subject, $body);
}
1;
I can confirm the SMTP account definitely works as I use it in my e-mail client (Thunderbird). Any suggestions as to why this function could be returning 1 with no success? Is there a way to debug the connection between this and my SMTP server (it's 3rd party so can't check the logs) to see if a connection is being established and what's being passed / whether there's a problem?
There is a semicolon missing after the try {} catch {} block. Without it, the following line becomes part of the same statement, so the entire try/catch block is conditional based on $failed, which will never be 1 at that point.
This is an unfortunate side effect of the implementation of Try::Tiny, but it can't be avoided in a pure-perl implementation. Your existing code is parsed is like:
try(
sub {
sendmail($email, {transport => $transport});
},
catch(
sub {
$failed = 1;
},
return($self->CANT_SEND_MAIL),
),
) if ($failed eq 1);
Related
I want to be able to send an email if the contents of a variable are not empty
this is my code:
my $output = $ssh->capture({stdin_data => <<'EOS'}, 'pfexec /usr/bin/perl');
use File::Find::Rule;
my $dir = '/dir';
my $today = time();
my $onehour = $today - (60*60);
my $oneday = $today - (24*60*60);
my #files = File::Find::Rule->file()
->name("*.0")
->mtime(">$oneday")
->mtime("<$onehour")
->in( "$dir" );
for my $file (#files) {
print "$file\n";
}
EOS
sub send_email{
use MIME::Lite;
$to = 'abcd#gmail.com';
$cc = 'efgh#mail.com';
$from = 'webmaster#yourdomain.com';
$subject = 'Test Email';
$msg = MIME::Lite->new(
From => $from,
To => $to,
Cc => $cc,
Subject => $subject,
Data => $output
);
$msg->send;
}
if ($output) {
send_email($output);
}
as you can see i connect remotely to a server. find a few files and if files are found send them by email.
I do not know how to create the subroutine so it takes the $output as parameter and sends it by mail.
thanks
So you're asking how subroutines receive parameters? It's through the #_ array. I did a little rewrite of your sub below.
Note: use Mime::Lite; should move outside the sub...it's probably best to move it all the way to the top. All use modules is always runned first anyway, no matter where it's at in your code, so it might as well be listed close to the top. Also, it's often useful to view all dependencies at one place. On the slight chance you absolutely don't want to load the Mime::Lite module unless send_email is called, use require Mime::Lite; instead of use inside the sub, it will then be included the first time the sub is called.
Remember to use my for local vars so you don't get trouble with others vars using the same name as your program grows (known as namespace pollution)
use MIME::Lite;
...
my $output = $ssh->capture( ... );
...
sub send_email {
my($data) = #_;
my $subject = 'Test Email';
my($to,$cc,$from) = ('abcd#gmail.com',
'efgh#mail.com',
'webmaster#yourdomain.com');
my $msg = MIME::Lite->new(
From => $from,
To => $to,
Cc => $cc,
Subject => $subject,
Data => $data,
);
$msg->send;
}
send_email($output) if $output;
I am creating a bot that connects to a Matrix server. For that I use Net::Async::Matrix.
The code:
#!/usr/bin/perl
use strict;
use warnings;
use Net::Async::Matrix;
use Net::Async::Matrix::Utils qw ( parse_formatted_message );
use IO::Async::Loop;
use Data::Dumper;
my $loop = IO::Async::Loop->new;
my $matrix = Net::Async::Matrix->new(
server => 'matrix.server.net',
on_error => sub {
my ( undef, $message ) = #_;
warn "error: $message\n";
},
);
$loop->add( $matrix );
$matrix->login(
user_id => '#bot:matrix.server.net',
password => 'password',
)->get;
my $room = $matrix->join_room( '#Lobby:matrix.server.net' )->get;
$room->configure(
on_message => sub {
my ( undef, $member, $content, $event ) = #_;
my $msg = parse_formatted_message( $content );
my $sendername = $member->displayname;
print Dumper $sendername;
&sendmsg("$sendername said: $msg");
},
);
my $stream = $matrix->start;
sub sendmsg {
my $input = shift;
if ($input) {
$room->send_message(
type => "m.text",
body => $input,
),
}
}
$loop->run;
Basically, I want the bot to echo what was said.
I get following output:
$VAR1 = 'm1ndgames'; Longpoll failed - encountered object 'm1ndgames
said: test', but neither allow_blessed, convert_blessed nor
allow_tags settings are enabled (or TO_JSON/FREEZE method missing) at
/usr/local/share/perl/5.24.1/Net/Async/Matrix.pm line 292.
and I don't understand it. When I enter a string like test into the body, it gets sent to the room.
parse_formatted_message returns a String::Tagged object. This class overloads concatenation so that "$sendername said: $msg" also returns a String::Tagged object. This object is passed to sendmsg which tries to serialize it into JSON, but it refuses to serialize objects.
Fix: Replace
my $msg = parse_formatted_message( $content );
with
my $msg = parse_formatted_message( $content )->str;
I'd guess that this is a quoting error. If you look at Net::Async::Matrix::Room:
sub send_message
{
my $self = shift;
my %args = ( #_ == 1 ) ? ( type => "m.text", body => shift ) : #_;
my $type = $args{msgtype} = delete $args{type} or
croak "Require a 'type' field";
$MSG_REQUIRED_FIELDS{$type} or
croak "Unrecognised message type '$type'";
foreach (#{ $MSG_REQUIRED_FIELDS{$type} } ) {
$args{$_} or croak "'$type' messages require a '$_' field";
}
if( defined( my $txn_id = $args{txn_id} ) ) {
$self->_do_PUT_json( "/send/m.room.message/$txn_id", \%args )
->then_done()
}
else {
$self->_do_POST_json( "/send/m.room.message", \%args )
->then_done()
}
}
The type you sent is handled by this sub, and then the actual message gets handed off to _do_POST_json in Net::Async::Matrix.
But you've sent a string containing a :.
So I think what's happening is it's encoding like this:
use JSON;
use Data::Dumper;
my $json = encode_json ( {body => "m1ndgames: said test"});
print Dumper $json;
But the response that's coming back, at line 292 which is:
if( length $content and $content ne q("") ) {
eval {
$content = decode_json( $content );
1;
} or
return Future->fail( "Unable to parse JSON response $content" );
return Future->done( $content, $response );
}
So I think is what is happening is the remote server is sending you a broken error code, and the module isn't handling it properly - it's expecting JSON but it isn't actually getting it.
My best guess would be - try dropping the : out of your message, because I would guess there's some bad quoting happening. But without seeing the code on the server side, I can't quite tell.
I'm trying to write a process that listens to ActiveMQ and based on the message, goes out and grabs data from a webservice, does some processing and then puts the process data to another webservice. (REST/JSON)
The module below works fine until one of the wonky webservices I talk to returns an error. I've tried many things to catch the error but to no avail, yet. Once the webservice error happens though I get the following message:
unhandled callback exception on event (MESSAGE,
AnyEvent::STOMP::Client=HASH(0x3ad5e48), HASH(0x3a6bbb0)
{"action":"created","data":{"id":40578737,"type":"alert","who":null},"guid":"ADCCEE0C-73A7-11E6-8084-74B346D1CA67","hostname":"myserver","pid":48632}):
$fork_manager->start() should be called within the manager process
OK, I conceptually understand that child process is trying to start another process and that fork manager is saying that is a no no. But given the module below, what is the proper way to start a new process to handle the long running processing. Or why is an child process dying causing this exception and how can I prevent this
Here's the module (stripped down)
package consumer;
use AnyEvent::ForkManager;
use AnyEvent::STOMP::Client;
use JSON;
use Data::Dumper;
use v5.18;
use Moose;
sub run {
my $self = shift;
my $pm = AnyEvent::ForkManager->new(max_workers => 20);
my $stomp = AnyEvent::STOMP::Client->new();
$stomp->connect();
$stomp->on_connected(sub {
my $stomp = shift;
$stomp->subscribe('/topic/test');
say "Connected to STOMP";
});
$pm->on_start(sub {
my ($pm,$pid,#params) = #_;
say "Starting $pid worker";
});
$pm->on_finish(sub {
my ($pm, $pid,#params) = #_;
say "Finished $pid worker";
});
$pm->on_error(sub {
say Dumper(\#_);
});
$stomp->on_message(sub {
my ($stomp, $header, $body) = #_;
my $href = decode_json $body;
$pm->start(cb => sub {
my ($pm, #params) = #_;
$self->process(#params);
},
args => [ $href->{id}, $href->{data}->{type}, $href->{data}->{who} ],
);
});
my $cv = AnyEvent->condvar;
$cv->recv;
}
sub process {
say "Processing ".Dumper(\#_);
sleep 5;
if ( int(rand(10)) < 5 ) {
die "OOPS"; # this triggers the error message above
}
say "Done Processing $_[1]";
}
1;
Heres the driver for the module above:
#!/usr/bin/env perl
use v5.18;
use lib '.';
use consumer;
my $c = consumer->new();
$c->run;
Finally a traffic generator that you can use to see this in action:
#!/usr/bin/env perl
use lib '../lib';
use lib '../../lib';
use v5.18;
use Data::Dumper;
use JSON;
use Net::STOMP::Client;
$ENV{'scot_mode'} = "testing";
my $stomp = Net::STOMP::Client->new(
host => "127.0.0.1",
port => 61613
);
$stomp->connect();
for (my $i = 1; $i < 1000000; $i++) {
my $href = {
id => $i,
type => "event",
what => "foo",
};
my $json = encode_json $href;
say "Sending ".Dumper($href);
$stomp->send(
destination => "/topic/test",
body => $json,
);
}
$stomp->disconnect();
I was able to solve this by using Try::Catch and wrapping the call to self->process with a try catch like this:
$stomp->on_message(sub {
my ($stomp, $header, $body) = #_;
my $href = decode_json $body;
$pm->start(cb => sub {
my ($pm, #params) = #_;
try {
$self->process(#params);
}
catch {
# error handling stuff
};
},
args => [ $href->{id}, $href->{data}->{type}, $href->{data}->{who} ],
);
}
);
I wanted to send emails in perl code. So I used MIME::Lite module.
I am able to send emails as I wanted if I removed last_send_successful check, else I get error mentioned below.I want to know if the email was sent successfully. Below is the code snippet I used.
sub sendEmailWithCSVAttachments {
my $retries = 3;
my $retry_duration = 500000; # in microseconds
my $return_status;
my ( $from, $to, $cc, $subject, $body, #attachments_path_array );
$from = shift;
$to = shift;
$cc = shift;
$subject = shift;
$body = shift;
#attachments_path_array = shift;
my $msg = MIME::Lite->new(
From => $from,
To => $to,
Cc => $cc,
Subject => $subject,
Type => 'multipart/mixed'
) or die "Error while creating multipart container for email: $!\n";
$msg->attach(
Type => 'text',
Data => $body
) or die "Error while adding text message part to email: $!\n";
foreach my $file_path (#attachments_path_array) {
my $file_name = basename($file_path);
$msg->attach(
Type => 'text/csv',
Path => $file_path,
Filename => $file_name,
Disposition => 'attachment'
) or die "Error while adding attachment $file_name to email: $!\n";
}
my $sent = 0;
while ( !$sent && $retries-- > 0 ) {
eval { $msg->send(); };
if ( !$# && $msg->last_send_successful() ) {
$sent = 1;
} else {
print "Sending failed to $to.";
print "Will retry after $retry_duration microseconds.";
print "Number of retries remaining $retries";
usleep($retry_duration);
print "Retrying...";
}
}
if ($sent) {
my $sent_message = $msg->as_string();
print "Email sent successfully:";
print "$sent_message\n";
$return_status = 'success';
} else {
print "Email sending failed: $#";
$return_status = 'failure';
}
}
The error I am getting is:
Can't locate object method "last_send_successful" via package "MIME::Lite"
This means this method is not present. But it is given in the reference I am using.
So am I missing something or is there alternative to check if the last send was successful or the reference I am using is incorrect?
Is this check redundant as I am already using eval block?
Will using eval catch the error of email not getting delivered? (Most probably no but want to confirm)
How to make sure that email is delivered with MIME::Lite?
You don't need to use the eval block or do anything fancy to ensure that the mail has been sent; that is what last_send_successful is for. When the send subroutine successfully completes its work, it sets an internal variable ($object->{last_send_successful}); this is what the last_send_successful sub is checking. It is usually not necessary to use an eval block unless you are trying to prevent a script dying or throwing a runtime or syntax error.
You can simplify your code to something like the following:
$msg->send;
if ($msg->last_send_successful) {
# woohoo! Message sent
}
else {
# message did not send.
# take appropriate action
}
or
$msg->send;
while (! $msg->last_send_successful) {
# message did not send.
# take appropriate action
}
I'm trying to use the Net::Twitter::Stream Perl module from CPAN to read the stream from sample.json. I believe this is the corect module though they way they crafted it allows one to process the filter stream. I've modified it as such but I must be missing something as I don't get any data in return. I establish a connection but nothing comes back. I'm guessing this should be an easy fix but I'm a touch new to this part of Perl.....
package Net::Twitter::Stream;
use strict;
use warnings;
use IO::Socket;
use MIME::Base64;
use JSON;
use IO::Socket::SSL;
use LibNewsStand qw(%cf);
use utf8;
our $VERSION = '0.27';
1;
=head1 NAME
Using Twitter streaming api.
=head1 SYNOPSIS
use Net::Twitter::Stream;
Net::Twitter::Stream->new ( user => $username, pass => $password,
callback => \&got_tweet,
track => 'perl,tinychat,emacs',
follow => '27712481,14252288,972651' );
sub got_tweet {
my ( $tweet, $json ) = #_; # a hash containing the tweet
# and the original json
print "By: $tweet->{user}{screen_name}\n";
print "Message: $tweet->{text}\n";
}
=head1 DESCRIPTION
The Streaming verson of the Twitter API allows near-realtime access to
various subsets of Twitter public statuses.
The /1/status/filter.json api call can be use to track up to 200 keywords
and to follow 200 users.
HTTP Basic authentication is supported (no OAuth yet) so you will need
a twitter account to connect.
JSON format is only supported. Twitter may depreciate XML.
More details at: http://dev.twitter.com/pages/streaming_api
Options
user, pass: required, twitter account user/password
callback: required, a subroutine called on each received tweet
perl#redmond5.com
#martinredmond
=head1 UPDATES
https fix: iwan standley <iwan#slebog.net>
=cut
sub new {
my $class = shift;
my %args = #_;
die "Usage: Net::Twitter::Stream->new ( user => 'user', pass => 'pass', callback => \&got_tweet_cb )" unless
$args{user} && $args{pass} && $args{callback};
my $self = bless {};
$self->{user} = $args{user};
$self->{pass} = $args{pass};
$self->{got_tweet} = $args{callback};
$self->{connection_closed} = $args{connection_closed_cb} if
$args{connection_closed_cb};
my $content = "follow=$args{follow}" if $args{follow};
$content = "track=$args{track}" if $args{track};
$content = "follow=$args{follow}&track=$args{track}\r\n" if $args{track} && $args{follow};
my $auth = encode_base64 ( "$args{user}:$args{pass}" );
chomp $auth;
my $cl = length $content;
my $req = <<EOF;
GET /1/statuses/sample.json HTTP/1.1\r
Authorization: Basic $auth\r
Host: stream.twitter.com\r
User-Agent: net-twitter-stream/0.1\r
Content-Type: application/x-www-form-urlencoded\r
Content-Length: $cl\r
\r
EOF
my $sock = IO::Socket::INET->new ( PeerAddr => 'stream.twitter.com:https' );
#$sock->print ( "$req$content" );
while ( my $l = $sock->getline ) {
last if $l =~ /^\s*$/;
}
while ( my $l = $sock->getline ) {
next if $l =~ /^\s*$/; # skip empty lines
$l =~ s/[^a-fA-F0-9]//g; # stop hex from compaining about \r
my $jsonlen = hex ( $l );
last if $jsonlen == 0;
eval {
my $json;
my $len = $sock->read ( $json, $jsonlen );
my $o = from_json ( $json );
$self->{got_tweet} ( $o, $json );
};
}
$self->{connection_closed} ( $sock ) if $self->{connection_closed};
}
You don't need to post the source, we can pretty much figure it out. You should try one of the examples, but my advice is to use AnyEvent::Twitter::Stream which comes with a good example that you only have to modify a bit to get it running
sub parse_from_twitter_stream {
my $user = 'XXX';
my $password = 'YYYY';
my $stream = Net::Twitter::Stream->new ( user => $user, pass => $password,
callback => \&got_tweet,
connection_closed_cb => \&connection_closed,
track => SEARCH_TERM);
sub connection_closed {
sleep 1;
warn "Connection to Twitter closed";
parse_from_twitter_stream();#This isn't working for me -- can't get connection to reopen after disconnect
}
sub got_tweet {
my ( $tweet, $json ) = #_; # a hash containing the tweet
#Do stuff here
}
}