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" />&nbsp;</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}" />&nbsp;&nbsp;
<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 )