CGI-ContactForm
view release on metacpan or search on metacpan
lib/CGI/ContactForm.pm view on Meta::CPAN
my %form_vars;
$form_vars{style} = stylesheet( $args->{styleurl} );
$form_vars{scriptname} = \$scriptname;
$form_vars{erroralert} = \$erroralert;
$form_vars{$_} = \$args->{$_} for @formargs;
for (qw/name email subject message/) {
$form_vars{$_} = \$in->{$_};
$form_vars{$_.'error'} = \$error->{$_};
}
$form_vars{softwrap} = \$softwrap;
templateprint($args->{formtmplpath}, $args->{encoding}, %form_vars);
} else {
headprint($args);
print <<FORM;
<form action="$scriptname" method="post">
<table cellpadding="3">
<tr>
<td colspan="4"><h1 class="halign">$args->{title} $args->{recname}</h1></td>
</tr><tr>
<td><p$error->{name}>$args->{namelabel}</p></td><td><input type="text" name="name"
value="$in->{name}" size="20" /> </td>
<td><p$error->{email}>$args->{emaillabel}</p></td><td><input type="text" name="email"
value="$in->{email}" size="20" /></td>
</tr><tr>
<td><p$error->{subject}>$args->{subjectlabel}</p></td>
<td colspan="3"><input type="text" name="subject" value="$in->{subject}" size="55" /></td>
</tr><tr>
<td colspan="4"><p$error->{message}>$args->{msglabel}</p></td>
</tr><tr>
<td colspan="4">
<textarea name="message" rows="8" cols="65"$softwrap>$in->{message}</textarea>
</td>
</tr><tr>
<td colspan="4" class="halign">
$erroralert
<input class="button" type="reset" value="$args->{reset}" />
<input class="button" type="submit" value="$args->{send}" /></td>
</tr><tr>
<td colspan="4"><p class="returnlink"><a href="$args->{returnlinkurl}">
$args->{returnlinktext}</a></p></td>
</tr>
</table>
</form>
</body>
</html>
FORM
}
}
sub headprint {
my $args = shift;
print "Content-type: text/html; charset=$args->{encoding}\n\n";
print <<HEAD;
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>$args->{title} $args->{recname}</title>
<style type="text/css">
.error { font-weight: bold }
</style>
${ stylesheet( $args->{styleurl} ) }
</head>
<body>
HEAD
}
sub stylesheet {
my $url = shift || return \'';
$url =~ s/ /%20/g;
\('<link rel="stylesheet" type="text/css" href="' . $url . '" />');
}
sub templateprint {
my ($template, $encode, %tmpl_vars) = @_;
my $error;
open FH, "< $template" or die "Can't open $template\n$!";
my $output = do { local $/; <FH> };
close FH;
$output =~ s[<(?:!--\s*)?tmpl_var\s*(?:name\s*=\s*)?
(?:"([^">]*)"|'([^'>]*)'|([^\s=>]*))
\s*(?:--)?>][
if ( $tmpl_vars{lc $+} ) {
${ $tmpl_vars{lc $+} };
} else {
$error .= "Unknown template variable: '$+'\n";
}
]egix;
CFdie("<pre>$error") if $error;
print "Content-type: text/html; charset=$encode\n\n";
print $output;
}
sub namefix {
my $name = $_[0];
if ($name =~ /[[:^ascii:]]/) {
return &mimeencode;
}
if ($name =~ /[^ \w]/) {
$name =~ tr/"/'/;
$name = qq{"$name"};
}
$name;
}
sub mimeencode {
my ($str, $enc) = @_;
return $str unless $str =~ /[[:^ascii:]]/;
my @parts;
while ( $str =~ /(.{1,40}.*?(?:\s|$))/g ) {
my $part = $1;
push @parts, MIME::QuotedPrint::encode($part, '');
}
join "\r\n\t", map { "=?$enc?Q?$_?=" } @parts;
}
sub reformat {
# This subroutine was initially copied from Text::Flowed v0.14, written by
# Philip Mak. It has undergone a couple of changes since.
( run in 2.096 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )