CGI-Application-MailPage
view release on metacpan or search on metacpan
lib/CGI/Application/MailPage.pm view on Meta::CPAN
$file = 'index.html';
$filename .= '/index.html';
}
my $ext;
($base, $ext) = $file =~ /(.*)\.([^\.]+)$/;
} else {
$base_url = URI->new($page);
$base_url = $base_url->scheme . '://' . $base_url->authority . '/' . $base_url->path;
}
# open the email template
my $template;
if ($self->param('email_template')) {
$template = $self->load_tmpl($self->param('email_template'),
die_on_bad_params => 0,
cache => 1,
);
} else {
my @path = $self->tmpl_path;
@path = @{ $self->tmpl_path} if(ref($path[0]) eq 'ARRAY');
$template = $self->load_tmpl('CGI/Application/MailPage/templates/email.tmpl',
die_on_bad_params => 0,
path => [@path, @INC],
cache => 1,
);
}
$template->param(%$valid_data);
$template->param(%{$self->param('extra_tmpl_params')})
if($self->param('extra_tmpl_params'));
# get the IP address of the original sender
my $sender_ip = $ENV{HTTP_X_FORWARDED_FOR} || $ENV{REMOTE_ADDR} || '';
# $msg will end up with either a Mail::Internet or MIME::Entity object.
my $msg;
# are we doing attachments?
if (index($format, '_attachment') != -1) {
# open up a MIME::Entity for our msg
$msg = MIME::Entity->build(
'Type' => "multipart/mixed",
'From' => "$name <$from_email>",
'Reply-To' => "$name <$from_email>",
'To' => $to_emails,
'Subject' => $subject,
'Date' => HTTP::Date::time2str(time()),
'X-Originating-Ip' => $sender_ip,
);
$msg->attach(Data => $template->output);
# attach the straight HTML if requested
if ($format =~ /^(both|html)/) {
my $buffer = "";
if ($self->param('read_file_callback')) {
my $callback = $self->param('read_file_callback');
$buffer = $callback->($filename);
} elsif( $self->param('remote_fetch') && ($page =~ /^https?:\/\//) ) {
#fetch this page with LWP
require LWP::UserAgent;
require HTTP::Request;
my $agent = LWP::UserAgent->new();
my $response = $agent->request(HTTP::Request->new(GET => $page));
if( $response->is_success ) {
$buffer = $response->content();
} else {
return $self->error("Unable to retrieve remote page $page");
}
} else {
open(HTML, $filename) or return $self->error("Can't open $filename : $!");
while(read(HTML, $buffer, 10240, length($buffer))) {}
close(HTML);
}
# add <BASE> tag in <HEAD>
$buffer =~ s/(<\s*[Hh][Ee][Aa][Dd].*?>)/$1\n<base href=$base_url>\n/
if( $base_url );
my $attached_filename = $base ? "$base.html" : $page;
$msg->attach(
Data => $buffer,
Type => 'text/html',
Filename => $attached_filename,
);
}
# attach text translation
if ($format =~ /^(both|text)/) {
my $new_filename = $base ? "$base.txt" : "$page.txt";
$msg->attach(
Data => $self->_html2text($filename, $page),
Type => 'text/plain',
Filename => $new_filename,
);
}
} else {
# non attachment mail
my $header = Mail::Header->new();
$header->add(From => "$name <$from_email>");
$header->add('Reply-To' => "$name <$from_email>");
$header->add(To => join(', ', @$to_emails));
$header->add(Subject => $subject);
$header->add(Date => HTTP::Date::time2str(time()));
$header->add('X-Originating-Ip' => $sender_ip)
if( $sender_ip );
my @lines;
push(@lines, $template->output());
if ($format =~ /^(both|text)/) {
push(@lines, "\n---\n\n");
push(@lines, $self->_html2text($filename, $page));
}
if ($format =~ /^(both|html)/) {
push(@lines, "\n---\n\n");
if ($self->param('read_file_callback')) {
my $callback = $self->param('read_file_callback');
my $buffer = $callback->($filename);
push(@lines, split("\n", $buffer));
} elsif( $self->param('remote_fetch') && ($page =~ /^https?:\/\//) ) {
#fetch this page with LWP
require LWP::UserAgent;
require HTTP::Request;
my $agent = LWP::UserAgent->new();
my $response = $agent->request(HTTP::Request->new(GET => $page));
if( $response->is_success ) {
my $buffer = $response->content();
@lines = split(/\r?\n/, $buffer);
} else {
return $self->error("Unable to retrieve remote page $page");
}
} else {
open(HTML, $filename) or return $self->error("Can't open $filename : $!");
push(@lines, <HTML>);
close(HTML);
}
}
if ($format =~ /url/) {
push(@lines, "\n$page");
}
$msg = Mail::Internet->new([], Header => $header, Body => \@lines);
return $self->error("Unable to create Mail::Internet object!")
unless defined $msg;
}
# send the message using SMTP - other methods can be added later
unless($self->param('dump_mail')) {
my $smtp = Net::SMTP->new($self->param('smtp_server'));
return $self->error("Unable to connect to SMTP server ".$self->param('smtp_server')." : $!")
unless defined $smtp and UNIVERSAL::isa($smtp,'Net::SMTP');
$smtp->debug(1) if $self->param('smtp_debug');
$smtp->mail("$name <$from_email>");
foreach (@$to_emails) {
$smtp->to($_);
}
$smtp->data();
$smtp->datasend($msg->as_string());
$smtp->dataend();
$smtp->quit();
} else {
# debuging hook for test.pl
my $mailref = $self->param('dump_mail');
$$mailref = $msg->as_string();
return $self->error("Mail Dumped");
}
# all done
return $self->show_thanks;
}
sub show_thanks {
my $self = shift;
my $query = $self->query;
my $page = $query->param('page');
my $template;
if ($self->param('thanks_template')) {
$template = $self->load_tmpl($self->param('thanks_template'),
die_on_bad_params => 0,
cache => 1,
);
lib/CGI/Application/MailPage.pm view on Meta::CPAN
if ( ref( $node ) )
{
# if it is a list element ...
if ( $node->tag =~ /^(?:li|dd|dt)$/ )
{
# recurse get_paragraphs
my @new_paras = get_paragraphs( $node );
# pre-pend appropriate prefix for list
$new_paras[ 0 ] =
$prefix{ $node->tag } . $new_paras[ 0 ]
;
# and update the @paras array
@paras = ( @paras, @new_paras );
# and traverse no more
return 0;
}
else
{
# any other element, just traverse
return 1;
}
}
else
{
# add text to the current paragraph ...
$paras[ $#paras ] =
join( ' ', $paras[ $#paras ], $node )
if $node =~ /\S/
;
# and recurse no more
return 0;
}
},
0
);
}
else
{
# add test to current paragraph ...
$paras[ $#paras ] = join( ' ', $paras[ $#paras ], $child )
if $child =~ /\S/
;
}
}
return @paras;
}
#--------------------------------------------------------------------------
#
# Main
#
#--------------------------------------------------------------------------
# parse the HTML file
if ($self->param('read_file_callback')) {
my $callback = $self->param('read_file_callback');
$html_tree->parse( $callback->($filename) );
} elsif( $self->param('remote_fetch') && ($page =~ /^https?:\/\//) ) {
#fetch this page with LWP
require LWP::UserAgent;
require HTTP::Request;
my $agent = LWP::UserAgent->new();
my $response = $agent->request(HTTP::Request->new(GET => $page));
if( $response->is_success ) {
my $buffer = $response->content();
$html_tree->parse($buffer);
} else {
return $self->error("Unable to retrieve remote page $page");
}
} else {
open(HTML, $filename) or return $self->error("Can't open $filename : $!");
$html_tree->parse( join( '', <HTML> ) );
close(HTML);
}
# main tree traversal routine
$html_tree->traverse(
sub {
my( $node, $startflag, $depth ) = @_;
# ignore what's in the <HEAD>
return 0 if ref( $node ) and $node->tag eq 'head';
# only visit nodes once
return 0 unless $startflag;
# if this node is non-text ...
if ( ref $node )
{
# if this is a para ...
if ( $node->tag eq 'p' )
{
# iterate sub-paragraphs (including lists) ...
for ( get_paragraphs( $node ) )
{
# if it is a <LI> ...
if ( /^\* / )
{
# indent first line by 4, rest by 6
$text_formatter->firstIndent( 4 );
$text_formatter->bodyIndent( 6 );
}
# if it is a <DT> ...
elsif ( s/^\+ // )
{
# set left margin to 4
$text_formatter->leftMargin( 4 );
}
# if it is a <DD> ...
elsif ( s/^- // )
{
# set left margin to 8
$text_formatter->leftMargin( 8 );
}
# print formatted paragraphs ...
$result .= $text_formatter->paragraphs( $_ );
# and reset formatter defaults
$text_formatter->leftMargin( 0 );
$text_formatter->firstIndent( 0 );
$text_formatter->bodyIndent( 0 );
}
$result .= "\n";
return 0;
}
# if this is a heading ...
( run in 0.912 second using v1.01-cache-2.11-cpan-140bd7fdf52 )