Formmail - make it show name and email in success response - forms

I'm using formmail.pl to handle a form I'm using on my site. There are several fields which are sent to the script including name, email, phone and some text in a text area.
As it stands, the successful submission prints the phone and textarea data correctly but doesn't print the name and email which were entered. In the email it sends the name and email in the 'from' header and as with the success page only shows the phone and textarea data are shown in the email body.
I would like to show all data in both cases however I can't seem to find the section of code that handles this. I'd post up the formmail.pl script except its over 3000 lines of code so I'll just post the places I think are responsible and hopefully somebody can point me in the right direction. I'm fairly new to Perl and its a bit overwhelming reading and understanding a script of this size.
sub success_page {
my ($self, $date) = #_;
if ($self->{FormConfig}{'redirect'}) {
print $self->cgi_object->redirect( $self->{FormConfig}{'redirect'} );
}
elsif ( $self->{CFG}{'no_content'}) {
print $self->cgi_object->header(Status => 204);
}
else {
$self->output_cgi_html_header;
$self->success_page_html_preamble($date);
$self->success_page_fields;
$self->success_page_footer;
}
}
sub success_page_html_preamble {
my ($self, $date) = #_;
my $title = $self->escape_html( $self->{FormConfig}{'title'} || 'Success' );
my $torecipient = 'to ' . $self->escape_html($self->{FormConfig}{'recipient'});
$torecipient = '' if $self->{Hide_Recipient};
my $attr = $self->body_attributes;
print <<END;
<head>
<title>$title</title>
END
$self->output_style_element;
print <<END;
<link type="text/css" href="css/stylesheet.css" rel="stylesheet" /></script>
</head>
<body>
<p>Below is what you submitted $torecipient on $date</p>
END
}
sub success_page_fields {
my ($self) = #_;
foreach my $f (#{ $self->{Field_Order} }) {
my $val = (defined $self->{Form}{$f} ? $self->{Form}{$f} : '');
$self->success_page_field( $self->escape_html($f), $self->escape_html($val) );
}
}
sub success_page_field {
my ($self, $name, $value) = #_;
print "<p><b>$name:</b> $value</p>\n";
}
Okay that's getting a bit long. That stuff is mostly for the success page and not much to do with the email side of things but maybe if somebody can find what I need there I can apply it to the email section also.
If any further information is needed let me know
Thanks in Advance

I haven't really used NMS FormMail myself, but looking at the source, it seems that you should be able to achieve something like what you want by setting the following extra configuration options:
$more_config{include_config_email} = 1;
$more_config{include_config_realname} = 1;
This should cause FormMail.pl to treat the email and realname fields as normal form fields, in addition to their special meaning.

Related

Sending a mail with a dynamic table from perl script

I have the following code in Perl:
foreach my $result ( #results ) {
if ( $result->{Error} ) {
print"No response received \n";}
else {
my $H = "$result->{H}";
my $I = "$result->{I}";
$mailbody.=qq(<h4 style="background: blue; color: white;">$H--->$I</h4>);
}
}
Here, I am using Mime::Lite to send mails:
$msg = MIME::Lite->new(
From => $from,
To => $to,
Cc => $cc,
Subject => $subject,
Data => $mailbody
);
$msg->attr("content-type" => "text/html/css");
$msg->send;
What I want is that the result data i.e $H and $I to be represented in the form of a table in the mail.
H | I
1 | 46
2 | 565756756767
3 | 232132
The number of rows of the table are dynamic and depend on the input given by the user. How can I do this?
If you want it to be a table in the email, you should create a table in the email body something like this:
$mailbody . = '<table>';
foreach my $result ( #results ) {
if ( $result->{Error} ) {
print"No response received \n";}
else {
my $H = "$result->{H}";
my $I = "$result->{I}";
$mailbody.=qq(<tr><td>$H</td><td>$I</td></tr>);
}
}
$mailbody . = '</table>';
If you want an HTML table in your email, then add HTML table elements to your output.
# Note: border=1 attribute to make the table borders visible.
$mailbody .= '<table border="1">';
foreach my $result ( #results ) {
if ( $result->{Error} ) {
print"No response received \n";}
else {
$mailbody .= qq(<tr><td>$result->{H}</td>)
. qq(<td>$result->{I}</td></tr>);
}
}
$mailbody .= </table>
In a comment to another answer that suggested something similar, you said that this doesn't work because you can't see the table borders. That was, of course, a simple case of adding border=1 so that the borders are displayed.
However.
It's always worth repeating that putting raw HTML strings into your program code is a terrible idea. It's a recipe for an unmaintainable mess. It's a bad idea when creating web applications and it's a bad idea when creating HTML to go into email bodies.
Far better to separate the code from creating the output and the best way to do that is to use a templating engine like the Template Toolkit. By creating a template file that contains all of the HTML output, you make it easier to change the way that the HTML looks without getting bogged down in the Perl code.
Also (and I've suggested this to you before) I would suggest that you avoid using MIME::Lite. But don't take my word for it. The current documentation for the module says this:
MIME::Lite is not recommended by its current maintainer. There are a number of alternatives, like Email::MIME or MIME::Entity and Email::Sender, which you should probably use instead. MIME::Lite continues to accrue weird bug reports, and it is not receiving a large amount of refactoring due to the availability of better alternatives. Please consider using something else.
I recommend switching to Email::Sender (together with Email::MIME) or Email::Stuffer.

HTML parsing with HTML::TokeParser::Simple

I am parsing an HTML file with HTML::TokeParser::Simple. The HTML file has the content shown far below. My problem is, I am trying to ignore the JavaScript from showing up as text content. Example:
use HTML::TokeParser::Simple;
my $p = HTML::TokeParser::Simple->new( 'test.html' );
while ( my $token = $p->get_token ) {
next unless $token->is_text;
print $token->as_is, "\n";
}
This prints the output as seen below:
Test HTML
<!--
var form_submitted = 0;
function submit_form() {
[..]
}
//-->
The actual HTML Document Content:
<html>
<span>Test HTML</span>
<script type="text/javascript">
<!--
var form_submitted = 0;
function submit_form() {
[..]
}
//-->
</script>
</html>
How do I ignore the JavaScript tag contents from showing.
I get the desired result. Comments are (correctly) not considered text by the version I have. Looks like you need to upgrade the modules you are using. (I used HTML::Parser 3.69 and HTML::TokeParser::Simple 3.15.)
>perl a.pl
Test HTML
>
You'll still have to process HTML entities and format the text usefully, the latter being quite difficult since you removed all formatting instruction. Your approach seems fatally flawed.
I believe you only need to use the as_text method.
my $tree = HTML::TreeBuilder->new();
$tree->parse( $html );
$tree->eof();
$tree->elementify(); # just for safety
my $text = $tree->as_text();
$tree->delete;
I adapted this from the WWW::Mechanize module (http://search.cpan.org/dist/WWW-Mechanize/) which has tons of convenience methods that can help you. It basically acts as a web browser in an object.
Scan through the token to ignore all open and close script tags. See below as used to resolved the issue.
my $ignore=0;
while ( my $token = $p->get_token ) {
if ( $token->is_start_tag('script') ) {
print $token->as_is, "\n";
$ignore = 1;
next;
}
if ( $token->is_end_tag('script') ) {
$ignore = 0;
print $token->as_is, "\n";
next;
}
if ($ignore) {
#Everything inside the script tag. Here you can ignore or print as is
print $token->as_is, "\n";
}
else
{
#Everything excluding scripts falls here handle as appropriate
next unless $token->is_text;
print $token->as_is, "\n";
}
}

Perl mechanize Find all links array loop issue

I am currently attempting to create a Perl webspider using WWW::Mechanize.
What I am trying to do is create a webspider that will crawl the whole site of the URL (entered by the user) and extract all of the links from every page on the site.
But I have a problem with how to spider the whole site to get every link, without duplicates
What I have done so far (the part im having trouble with anyway):
foreach (#nonduplicates) { #array contain urls like www.tree.com/contact-us, www.tree.com/varieties....
$mech->get($_);
my #list = $mech->find_all_links(url_abs_regex => qr/^\Q$urlToSpider\E/); #find all links on this page that starts with http://www.tree.com
#NOW THIS IS WHAT I WANT IT TO DO AFTER THE ABOVE (IN PSEUDOCODE), BUT CANT GET WORKING
#foreach (#list) {
#if $_ is already in #nonduplicates
#then do nothing because that link has already been found
#} else {
#append the link to the end of #nonduplicates so that if it has not been crawled for links already, it will be
How would I be able to do the above?
I am doing this to try and spider the whole site to get a comprehensive list of every URL on the site, without duplicates.
If you think this is not the best/easiest method of achieving the same result I'm open to ideas.
Your help is much appreciated, thanks.
Create a hash to track which links you've seen before and put any unseen ones onto #nonduplicates for processing:
$| = 1;
my $scanned = 0;
my #nonduplicates = ( $urlToSpider ); # Add the first link to the queue.
my %link_tracker = map { $_ => 1 } #nonduplicates; # Keep track of what links we've found already.
while (my $queued_link = pop #nonduplicates) {
$mech->get($queued_link);
my #list = $mech->find_all_links(url_abs_regex => qr/^\Q$urlToSpider\E/);
for my $new_link (#list) {
# Add the link to the queue unless we already encountered it.
# Increment so we don't add it again.
push #nonduplicates, $new_link->url_abs() unless $link_tracker{$new_link->url_abs()}++;
}
printf "\rPages scanned: [%d] Unique Links: [%s] Queued: [%s]", ++$scanned, scalar keys %link_tracker, scalar #nonduplicates;
}
use Data::Dumper;
print Dumper(\%link_tracker);
use List::MoreUtils qw/uniq/;
...
my #list = $mech->find_all_links(...);
my #unique_urls = uniq( map { $_->url } #list );
Now #unique_urls contains the unique urls from #list.

Extracting links inside <div>'s with HTML::TokeParser & URI

I'm an old-newbie in Perl, and Im trying to create a subroutine in perl using HTML::TokeParser and URI.
I need to extract ALL valid links enclosed within on div called "zone-extract"
This is my code:
#More perl above here... use strict and other subs
use HTML::TokeParser;
use URI;
sub extract_links_from_response {
my $response = $_[0];
my $base = URI->new( $response->base )->canonical;
# "canonical" returns it in the one "official" tidy form
my $stream = HTML::TokeParser->new( $response->content_ref );
my $page_url = URI->new( $response->request->uri );
print "Extracting links from: $page_url\n";
my($tag, $link_url);
while ( my $div = $stream->get_tag('div') ) {
my $id = $div->get_attr('id');
next unless defined($id) and $id eq 'zone-extract';
while( $tag = $stream->get_tag('a') ) {
next unless defined($link_url = $tag->[1]{'href'});
next if $link_url =~ m/\s/; # If it's got whitespace, it's a bad URL.
next unless length $link_url; # sanity check!
$link_url = URI->new_abs($link_url, $base)->canonical;
next unless $link_url->scheme eq 'http'; # sanity
$link_url->fragment(undef); # chop off any "#foo" part
print $link_url unless $link_url->eq($page_url); # Don't note links to itself!
}
}
return;
}
As you can see, I have 2 loops, first using get_tag 'div' and then look for id = 'zone-extract'. The second loop looks inside this div and retrieve all links (or that was my intention)...
The inner loop works, it extracts all links correctly working standalone, but I think there is some issues inside the first loop, looking for my desired div 'zone-extract'... Im using this post as a reference: How can I find the contents of a div using Perl's HTML modules, if I know a tag inside of it?
But all I have by the moment is this error:
Can't call method "get_attr" on unblessed reference
Some ideas? Help!
My HTML (Note URL_TO_EXTRACT_1 & 2):
<more html above here>
<div class="span-48 last">
<div class="span-37">
<div id="zone-extract" class="...">
<h2 class="genres"><img alt="extracting" class="png"></h2>
<li><a title="Extr 2" href="**URL_TO_EXTRACT_1**">2</a></li>
<li><a title="Con 1" class="sel" href="**URL_TO_EXTRACT_2**">1</a></li>
<li class="first">Pàg</li>
</div>
</div>
</div>
<more stuff from here>
I find that TokeParser is a very crude tool requiring too much code, its fault is that only supports the procedural style of programming.
A better alternatives which require less code due to declarative programming is Web::Query:
use Web::Query 'wq';
my $results = wq($response)->find('div#zone-extract a')->map(sub {
my (undef, $elem_a) = #_;
my $link_url = $elem_a->attr('href');
return unless $link_url && $link_url !~ m/\s/ && …
# Further checks like in the question go here.
return [$link_url => $elem_a->text];
});
Code is untested because there is no example HTML in the question.

Perl - How to get the email address from the FROM part of header?

I am trying to set up this script for my local bands newsletter.
Currently, someone sends an email with a request to be added, we manually add it to newsletter mailer I set up.
(Which works great thanks to help I found here!)
The intent now is to have my script below log into the email account I set up for the list on our server, grab the info to add the email automatically.
I know there are a bunch of apps that do this but, I want to learn myself.
I already have the "add to list" working when there is an email address returned from the header(from) below BUT, sometimes the header(from) is a name and not the email address (eg "persons name" is returned from persons name<email#address> but, not the <email#address>.)
Now, I am not set in stone on the below method but, it works famously... to a point.
I read all the docs on these modules and there was nothing I could find to get the darn email in there all the time.
Can someone help me here? Verbose examples are greatly appreciated since I am struggling learning Perl.
#!/usr/bin/perl -w
##########
use CGI;
use Net::IMAP::Simple;
use Email::Simple;
use IO::Socket::SSL; #optional i think if no ssl is needed
use strict;
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
######################################################
# fill in your details here
my $username = '#########';
my $password = '#############';
my $mailhost = '##############';
#######################################################
print CGI::header();
# Connect
my $imap = Net::IMAP::Simple->new($mailhost, port=> 143, use_ssl => 0, ) || die "Unable to connect to IMAP: $Net::IMAP::Simple::errstr\n";
# Log in
if ( !$imap->login( $username, $password ) ) {
print STDERR "Login failed: " . $imap->errstr . "\n";
exit(64);
}
# Look in the INBOX
my $nm = $imap->select('INBOX');
# How many messages are there?
my ($unseen, $recent, $num_messages) = $imap->status();
print "unseen: $unseen, <br />recent: $recent, <br />total: $num_messages<br />\n\n";
## Iterate through unseen messages
for ( my $i = 1 ; $i <= $nm ; $i++ ) {
if ( $imap->seen($i) ) {
my $es = Email::Simple->new( join '', #{ $imap->top($i) } );
printf( "[%03d] %s\n\t%s\n", $i, $es->header('From'), $es->header('Subject'));
print "<br />";
next;
}## in the long version these are pushed into different arrays for experimenting purposes
else {
my $es = Email::Simple->new( join '', #{ $imap->top($i) } );
printf( "[%03d] %s\n\t%s\n", $i, $es->header('From'), $es->header('Subject'));
print "<br />";
}
}
# Disconnect
$imap->quit;
exit;
use Email::Address;
my #addresses = Email::Address->parse('persons name <email#address>');
print $addresses[0]->address;
The parse method returns an array, so the above way works for me.
I'm making this a separate answer because even though this information is hidden in the comments of the accepted answer, it took me all day to figure that out.
First you need to get the From header using something like Email::Simple. THEN you need to extract the address portion with Email::Address.
use Email::Simple;
use Email::Address;
my $email = Email::Simple->new($input);
my $from = $email->header('From');
my #addrs = Email::Address->parse($from);
my $from_address = $addrs[0]->address; # finally, the naked From address.
Those 4 steps in that order.
The final step is made confusing by the fact that Email::Address uses some voodoo where if you print the parts that Email::Address->parse returns, they will look like simple strings, but they are actually objects. For example if you print the result of Email::Address->parse like so,
my #addrs = Email::Address->parse($from);
foreach my $addr (#addrs) { say $addr; }
You will get the complete address as output:
"Some Name" <address#example.com>
This was highly confusing when working on this. Granted, I caused the confusion by printing the results in the first place, but I do that out of habit when debugging.