#!/usr/bin/perl -w -T
# vim: set sw=8 ts=8 si et: 
# 
use strict; 

my $mailto = 'webmaster@luther.de';
#----- nothing more to configure -----
use Cwd;
use File::Basename;
use Mail::Sendmail;
use Text::Format;
use CGI;
use CGI::Carp 'fatalsToBrowser';
$CGI::POST_MAX = 1024 * 10;
$CGI::DISABLE_UPLOADS = 1;


# global variables: 
my $q = new CGI;
my $referer = $q->referer();
my $br = "<br>\n";

my %msg = (
title => "Suggestions, Wishes, Contact"
, possibly => "Possibly from: "
, sent => "Your suggesstion has been sent."
, error => "Error sending message: "
, link => "Following this link "
, back => " you should reach the original page."
, subject => "Subject"
, suggest => "Suggestion for WWW page"
, text => "Text"
, email => "Email"
, send => "Send"

);

$ENV{'PATH'} = '/bin:/usr/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

my %subst = (
        '<!-- %%FEEDBACKFORM%% -->' => '',
);

my $dir  = cwd();
my $name = basename($q->script_name,'.cgi');
my $tmpl = "$dir/$name.tmpl";

print $q->header;

if ( defined $q->param('body') && $q->param('body') ne "" ) {
        $subst{'<!-- %%FEEDBACKFORM%% -->'} = send_mail($q,\%msg,$mailto);
} else {
        $subst{'<!-- %%FEEDBACKFORM%% -->'} = feedback_form($q,\%msg);
}

print skin_html($q,$tmpl,\%subst);

#--- nur noch Funktionen ---

# feedback_form($q,$msg)
#
# Gibt ein HTML-Formular, das mit den Parametern aus $q vorbelegt ist
# als String zurück. Erläuternde Texte werden mit $msg an die
# Zielsprache angepaßt.
#
sub feedback_form {
        my ($q,$msg) = @_;

        my $form = $q->start_form
                 . $q->hidden( -name    => 'hurl'
                             , -default => $referer
                             )
                 . "\n"
                 . $msg->{'subject'}
                 . $br
                 . $q->textfield( -name    => 'subject'
                                , -default => $msg->{'suggest'}
                                , -size    => 55
                                )
                 . $br
                 . $msg->{'text'}
                 . $br
                 . $q->textarea( -name    => 'body'
                               , -rows    => 10
                               , -columns => 55
                               )
                 . $br
                 . $msg->{'email'}
                 . $br
                 . $q->textfield( -name => 'email'
                                , -size => 55
                                )
                 . $br
                 . $q->submit( -name  => 'send'
                             , -value => $msg->{'send'}
                             )
                 . $br
                 . $q->textfield( -name    => 'url'
                                , -default => $referer
                                , -size    => 55
                                )
                 . "\n"
                 . $q->end_form
                 ;
        return $form;
} # feedback_form()

# send_mail($q,$msg,$mailto)
#
# Formatiert den Text aus $q->param('body') und sendet in an $mailto.
# (Miß-)Erfolgsmeldungen werden mittels $msg an die Zielsprache
# angepaßt zurückgegeben.
#
sub send_mail {
        my ($q,$msg,$mailto) = @_;
        my $html = '';

        my $text = Text::Format->new({columns=>72,firstIndent=>0});

        my $pbody = $q->param('body');
        $pbody =~ s/\r//g;
        my $body = $text->paragraphs(split(/\n\n/,$pbody))
                 . "\n\n"
                 . $q->param('url')
                 ;

        my %mail = ( To      => $mailto
                   , Subject => $q->param('subject')
                   , Message => $body
                   );
        if ( $q->param('hurl') ne $q->param('url') ) {
                $mail{'Message'} .= "\n\n"
                                 .  $q->param('hurl')
                                 ;
        }
        if ( $q->param('email') ne "" ) {
                $mail{'Message'} .= "\n\n"
                                  . $msg->{'possibly'}
                                  . $q->param('email')
                                  ;
                $mail{'From'} = $q->param('email');
        } else {
                $mail{'From'} = $mailto;
        }
        if (sendmail(%mail)) {
                $html .= $msg->{'sent'} . "<br><hr>\n";
        } else {
                $html .= "<hr>"
                       . $msg{'error'}
                       . "$Mail::Sendmail::error<br>\n"
                       . "$Mail::Sendmail::log<br><hr>\n"
                       ;
        }
        my $burl = $q->param('hurl') ? $q->param('hurl')
                 : $q->param('url')  ? $q->param('url')
                 : $q->referer
                 ;
        if ($burl) {
                $html .= $msg->{'link'}
                      . $q->a({href=>$burl},$burl)
                      . $msg->{'back'}
                      ;
        }
        return $html;
} # send_mail()

# skin_html($q,$tmpl,\%subst)
#
# Ersetzt die Schlüssel aus %subst in der Datei $tmpl mit den Werten
# aus %subst und gibt den resultierenden HTML-Text zurück.
# Kann $tmpl nicht geöffnet werden, wird mit Hilfe von $q ein
# Not-HTML-Text erzeugt und zurückgegeben.
#
sub skin_html {
        my ($q,$tmpl,$subst) = @_;
        my $html;

        my $map = sub {
                my $tmpl = shift;
                return $subst->{$tmpl} ? $subst->{$tmpl} : '';
        };
        if (open(HTML,$tmpl)) {
                while (<HTML>) {
                        s/(<!-- %%[^%]+%% -->)/$map->($1)/e;
                        $html .= $_;
                }
                close(HTML);
        } else {
                $html .= $q->start_html . "\n";
                foreach my $key (sort keys %{$subst}) {
                        $html .= "$subst->{$key}\n";
                }
                $html .= $q->end_html . "\n";
        }
        return $html;
} # skin_html()

__END__ 

