) {
next if (/^#/ or ! /\w+/);
chomp;
if ($message =~ /\b$_\b/i) {
$found=1;
last;
}
}
close(BADWORDS);
return $found;
}
#-----------------------------------------------------------------------------
sub ObjectNotFound {
my ($object,$objectpath) = @_;
my $message="Postcard image/object not found URL: $object
Directory path: $objectpath";
my $suggestion=qq(Is $WebRoot/$object actually viewable?);
Error($message,undef,$suggestion);
}
#-----------------------------------------------------------------------------
# Checks to see if a remote image/object is from an allowable site.
#
sub RemoteSiteAllowed {
my $object=shift;
my $found=0;
#
# Extract hostname from URL
#
$object =~ m!http://(.*?)/!i;
my $sitename=$1;
#
# Check to see if the remote site is in the allowable list
#
open REMOTE,$RemoteSites or Error("Can not open remote sites list $RemoteSites",$!);
while () {
next if (/^#/ or ! /\w+/);
if (/$sitename/) {
$found=1;
last;
}
}
close(REMOTE);
Error("$Sitename is not a allowable remote site",undef,"Add $Sitename to the remotesites.txt file") unless $found;
}
#-----------------------------------------------------------------------------
# Inserts image width and height attributes.
#
sub SizeTags {
if (/%HEIGHT%|/i or /%WIDTH%|/i) {
if ( $] < 5.005 ) {
if (-f "$Modules/size-5.004.pm" ) {
require 'size-5.004.pm';
}
else {
Error("Module $Modules/size-5.004.pm does not exist");
}
($width,$height) = imgsize($ImagePath) unless $width;
}
else {
if (-f "$Modules/size.pm") {
require size;
Image::Size->import();
}
else {
Error("Module $Modules/size.pm does not exist");
}
($width,$height,$error) = imgsize($ImagePath) unless $width;
Error("Image size error: $error") unless $width;
}
s!%WIDTH%|!$width!ig;
s!%HEIGHT%|!$height!ig;
}
}
#-----------------------------------------------------------------------------
# Retrieves an object/image from a remote site if the object does exist in the
# local cache and has not expired.
#
sub GetRemoteObject {
my $object=shift;
my $objectname=basename($object);
my ($file,$now,$mtime,$age);
#
# Clean out old files from the cache
#
CleanCache() if ($CacheAge or $CacheAge == 0);
#
# Check to see if the cached version is still current
#
if (-f "$CacheDir/$objectname") {
$now=time();
$mtime=(stat("$CacheDir/$objectname"))[9];
$age=int(($now - $mtime) / 60 / 60 / 24);
return "$CacheDir/$objectname" if ($age < $CacheExpiry);
}
#
# Import required modules from LWP
#
if (-f "$Modules/simple.pm") {
require simple;
require status;
LWP::Simple->import();
LWP::Status->import();
}
else {
Error("Module $Modules/simple.pm does not exist");
}
$file=get($object);
if (defined($file)) {
open(CACHE,">$CacheDir/$objectname") or Error("Can not open $CacheDir/$objectname", $!,"Check the permissions on the directory $CacheDir");
binmode(CACHE);
print CACHE $file;
close(CACHE);
}
else {
Error("Can not retrieve $file",$!,"Check that the URL is correct and that you are not behind a firewall");
}
return "$CacheDir/$objectname";
}
#-----------------------------------------------------------------------------
# Send postcard as an HTML file
#
sub SendHTML {
my $i=0;
my $Text;
$ExtraImages=0;
$Text = ReadHTML();
$Plaintext = ReadPlain();
#
# Build a multipart/alternative MIME object
#
$msg = new MIME::Lite(
From => "$Sender",
To => "$Receiver",
Subject => "$Subject",
Type => 'multipart/alternative',
);
$msg->add("Bcc" => $Bcc) if $Bcc;
$msg->add("Reply-To" => $ReplyTo) if $ReplyTo;
$msg->add("Errors-To" => $Sender);
$msg->replace('X-Mailer' => "Postcard Direct ($Version)");
$msg->add('X-Source' => "http://postcard-direct.com");
$plain = $msg->attach(
Type => 'text/plain',
Data => "$Plaintext"
);
$html = $msg->attach(Type =>'multipart/related');
$html->attach(
Type => 'text/html',
Data => $Text
);
#
# Attach an image if one exists
#
if ($param{image}) {
$html->attach(
Type => "image/$ImageType",
Path => $ImagePath,
Id => "<$CID>"
);
}
#
# Attach the midi file (if chosen)
#
if ($param{midi} ne 'none' and $param{midi}) {
Error("Midi file not found: $MidiDir/$param{midi}") if (! -f "$MidiDir/$param{midi}");
$html->attach(
Type => "audio/mid",
Encoding => 'base64',
Path => "$MidiDir/$param{midi}",
Id => "<$MidiCID>"
);
}
#
# Attach any object files if they are local
#
if ($param{object} ne 'none' and $param{object} !~ /http:/i and $param{object} ne '') {
$ObjectType=ObjectType($param{object});
$html->attach(
Type => "$ObjectType",
Encoding => 'base64',
Path => "$TopLevel$param{object}",
Id => "<$ObjectCID>"
);
}
#
# Attach any additional images
#
if ($ExtraImages > 0) {
foreach ($i=0; $i < $ExtraImages; $i++) {
chomp $ExtraImagePath[$i];
$html->attach(
Type => "image/$ExtraImageType[$i]",
Path => "$ExtraImagePath[$i]",
Id => "<$ImageCID[$i]>"
);
}
}
}
#-----------------------------------------------------------------------------
# Sends the postcard in HTML design, but doesn't include the image in the
# mail, just the URL to the image.
#
sub SendWeb {
open POSTCARD,"$DesignDir/$param{design}" or Error("Can not open postcard design $DesignDir/$param{design}", $!);
$Subject=$param{subject} if $param{subject};
my $text;
while () {
next if (/^#/);
#
# Make sure additional images have a full URL
#
if (/img src/i and ! (/%IMAGE%||%OBJECT%|/i) and ! /img src=\"?http:/i) {
s!(![](\"?)(\S+)(.*)!$1$WebRoot$2$3!i;)
/i) {
if ($param{image} !~ /http:/i) {
s!%IMAGE%|!$WebRoot$param{image}!ig;
}
else {
s!%IMAGE%|!$param{image}!ig;
}
}
if (/%OBJECT%|!$WebRoot$param{object}!ig;
}
else {
s!%OBJECT%|!$param{object}!ig;
}
}
if ($param{'preview'} or $param{'preview.x'}) {
s!%BACK%|!!ig;
}
if ((/%MIDI%|/i) and $param{midi} ne 'none' and $param{midi}) {
Error("Midi file not found: $MidiDir/$param{midi}") if (! -f "$MidiDir/$param{midi}");
s!%MIDI%|!<![CDATA[<bgsound src="$WebRoot$MidiURL/$param{midi}" autostart="true"></bgsound>]]> !ig;
}
else {
s/%MIDI%|//ig;
}
s!%BACK%|!!ig;
s!%SEND%|!!ig;
s!%TITLE%|!$param{title}!ig;
s!%SENDER%|!$param{s_name}!ig;
s!%SENDER_EMAIL%|!$param{s_email}!ig;
s!%RECIPIENT%|!$param{r_name}!ig;
s!%RECIPIENT_EMAIL%|!$param{r_email}!ig;
s!%SUBJECT%|!$Subject!ig;
s!%MESSAGE%|!$param{message}!ig;
s!%FIELD1%|!$param{field1}!ig;
s!%FIELD2%|!$param{field2}!ig;
s!%FIELD3%|!$param{field3}!ig;
s!%FIELD4%|!$param{field4}!ig;
$text .= $_;
}
close(POSTCARD);
# Now create the mail structure
$msg = new MIME::Lite
From => $Sender,
To => $Receiver,
Subject => $Subject,
Type => 'text/html',
Data => $text;
$msg->add("Bcc" => $Bcc) if $Bcc;
$msg->add("Reply-To" => $ReplyTo) if $ReplyTo;
$msg->add("Errors-To" => $Sender);
$msg->replace('X-Mailer' => "Postcard Direct ($Version)");
$msg->add('X-Source' => "http://postcard-direct.com");
}
#-----------------------------------------------------------------------------
# Sends a "traditional" card, ie: send a link to the recipient to pick up
# their card.
sub SendTraditional {
open POSTCARD,"$DesignDir/$param{design}" or Error("Can not open postcard design $DesignDir/$param{design}", $!);
$Subject=$param{subject} if $param{subject};
my $text;
while () {
next if (/^#/);
#
# Make sure additional images have a full URL
#
if (/img src/i and ! /%IMAGE%|/i and ! /img src=\"?http:/i) {
s!(/i) {
if ($param{image} !~ /http:/i) {
s!%IMAGE%|!$WebRoot$param{image}!ig;
}
else {
s!%IMAGE%|!$param{image}!ig;
}
}
if (/%OBJECT%|!$WebRoot$param{object}!ig;
}
else {
s!%OBJECT%|!$param{object}!ig;
}
}
if ((/%MIDI%|/i) and $param{midi} ne 'none' and $param{midi}) {
Error("Midi file not found: $MidiDir/$param{midi}") if (! -f "$MidiDir/$param{midi}");
s!%MIDI%|!<![CDATA[<bgsound src="$MidiURL/$param{midi}" autostart="true"></bgsound>]]> !ig;
}
else {
s/%MIDI%|//ig;
}
s!%BACK%|!!ig;
s!%SEND%|!!ig;
s!%TITLE%|!$param{title}!ig;
s!%SENDER%|!$param{s_name}!ig;
s!%SENDER_EMAIL%|!$param{s_email}!ig;
s!%RECIPIENT%|!$param{r_name}!ig;
s!%RECIPIENT_EMAIL%|!$param{r_email}!ig;
s!%SUBJECT%|!$Subject!ig;
s!%MESSAGE%|!$param{message}!ig;
s!%FIELD1%|!$param{field1}!ig;
s!%FIELD2%|!$param{field2}!ig;
s!%FIELD3%|!$param{field3}!ig;
s!%FIELD4%|!$param{field4}!ig;
if (/%STYLESHEET%|/i) {
my $stylesheet=Stylesheet();
s!%STYLESHEET%|!$stylesheet!ig;
}
$text .= "$_";
}
close(POSTCARD);
#
# Store the postcard
#
Error("$PostcardDir does not exist") if (! -d $PostcardDir);
Error("The webserver does not have write permission to $PostcardDir",undef,"Change permissions to the directory to 777.") if (! -w $PostcardDir);
my $reference=int(time) . rand();
open CARD,">$PostcardDir/$reference.html" or Error("Can not create $PostcardDir/$reference.html",$!);
print CARD $text;
close(CARD);
#
# Now create the mail structure with containing the text
# from the traditional template.
#
open TRADITIONAL,$Traditional or Error("Can not open traditional template $Traditional",$!);
undef $text;
$PostcardURL = "$WebRoot/$pdurl/" . basename($PostcardDir);
while () {
next if (/^#/ or /-->/ or /
HTML
}
