yaml-files

conf.yaml

---
db_host: localhost
db_database: poll
db_user: itpeople
db_pass: secret
[download]

poll.yaml

--- #YAML:1.0
identifier: IT_Staff
description: Please vote about ...
public: Yes
--- #YAML:1.0
- question: How do you think...
  id: q01
- question: Please rate ...
  id: q02
[download]

.pl-files

create_poll.pl

#!/usr/bin/perl

use strict;
use warnings;
use DBI;
use YAML qw ( LoadFile );

my $poll_file = shift @ARGV or die "no file no poll!\n";
my ($poll, $questions) = LoadFile($poll_file) or die "Sorry, no questi
+on-file!\n";
my $config = LoadFile('conf/conf.yaml');

my $sql_create = qq{
CREATE TABLE $poll->{identifier} (
  ID bigint(20) unsigned NOT NULL auto_increment,
  Zeitstempel timestamp(14) NOT NULL,
};

$sql_create .= join("\n", map { "  $_->{id} smallint(5) unsigned defau
+lt '3'," } @$questions);

$sql_create .= "\n  primary key (ID))\n TYPE=MyISAM;";

my $dbh = DBI->connect ("DBI:mysql:host=$config->{db_host};database=$c
+onfig->{db_database}",
          $config->{db_user}, $config->{db_pass}, {PrintError => 0, Ra
+iseError => 1})
          or die "Failed to connect via DBI:$!\n";

$dbh->do($sql_create)
        or die "$sql_create: $dbh->errstr\n";

exit;
[download]

poll.pl

#!/usr/bin/perl

use strict;
use warnings;
use CGI;
use CGI::Carp qw ( warningsToBrowser fatalsToBrowser );
use DBI;
use HTML::Template;
use YAML qw ( LoadFile );

my $q = new CGI;
my $action = $q->param('action') || '';
my $what_poll = $q->param('what_poll') || '';
$q->delete('action', 'what_poll');
my $results = $q->Vars;
my ($poll, $questions) = LoadFile("$what_poll.yaml") or die "Sorry, no
+ question-file!\n";

print $q->header();

if ($action eq 'Abstimmen') {
  my $dbh = &connect_to_db();
  &vote($dbh);
  &show_results($dbh);
  $dbh->disconnect();
} else {
  &fill_form();
}
exit;

# subs

sub fill_form {
  my $template = HTML::Template->new(filename => 'templates/poll.tmpl'
+,
                       die_on_bad_params => 0);

  $template->param( 'questions'     => $questions,
                    'description'     => ${poll}->{description},
                    'what_poll'        => $what_poll );
  print $template->output;
}

sub vote {
  my $dbh = shift;
  my $sql_insert = "INSERT INTO $what_poll (";
  $sql_insert .= join(", ", keys %$results);
  $sql_insert .= ") VALUES (";
  $sql_insert .= join(", ", values %$results);
  $sql_insert .= ");";

  my $sth = $dbh->prepare($sql_insert)
    or die "$sql_insert: $dbh->errstr\n";
  $sth->execute();
  $sth->finish();
}

sub show_results {
  my $dbh = shift;
  my $sql_query = "SELECT ";
  $sql_query .= join(", ", map { 'AVG('.$_->{id}.')' } @$questions);
  $sql_query .= " FROM $what_poll;";

  my $sth = $dbh->prepare($sql_query)
    or die "$sql_query: $dbh->errstr\n";
  $sth->execute();

  my @row = $sth->fetchrow_array();
  $sth->finish();

  my $sth = $dbh->prepare("SELECT COUNT(*) AS Anzahl FROM $what_poll;"
+)
    or die "$sql_query: $dbh->errstr\n";
  $sth->execute();

  my @count = $sth->fetchrow_array();
  $sth->finish();

  my @bar = map { sprintf("%u", ($_/5.0)*100) } @row;
  map { $_ = sprintf("%.2f", $_) } @row;
  $_->{result} = shift @row for @$questions;
  $_->{bar} = shift @bar for @$questions;

  my $template = HTML::Template->new(filename => 'templates/result.tmp
+l',
                       die_on_bad_params => 0);

  $template->param( 'public'     => ( ${poll}->{public} =~ /yes/i) ? 1
+ : undef,
              'questions'    => $questions,
              'number_of_votes' => $count[0], );

  print $template->output;
}

sub connect_to_db {
  my $config = LoadFile('conf/conf.yaml');
  my $dbh = DBI->connect ("DBI:mysql:host=$config->{db_host};database=
+$config->{db_database}",
          $config->{db_user}, $config->{db_pass}, {PrintError => 0, Ra
+iseError => 1})
          or die "Failed to connect via DBI:$!\n";
  return $dbh;
}
[download]

what_poll.pl

#!/usr/bin/perl

use strict;
use warnings;
use CGI;
use CGI::Carp qw ( warningsToBrowser fatalsToBrowser );
use HTML::Template;

my $q = new CGI;
my @polls = <*.yaml>;
my $polls = [];

map {$_ =~ s/(.*)\.yaml$/$1/} @polls;
foreach my $poll (@polls) {
  my %row;
  $row{poll} = $poll;
  push @$polls, \%row;
}

#die join(", ", @polls);

print $q->header();

my $template = HTML::Template->new(filename => 'templates/what_poll.tm
+pl',
                       die_on_bad_params => 1);

$template->param( 'polls'     => $polls );
print $template->output;
[download]

The templates

header.tmpl

<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">

<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title><TMPL_VAR NAME="description"></title>
<meta name="author" content="Ronnie Neumann" />
<meta name="generator" content="Perl-Script using HTML::Template" />
<link rel="stylesheet" type="text/css" href="default.css" />
</head>
[download]

poll.tmpl

<TMPL_INCLUDE NAME="header.tmpl">
<body>
<div>
<form method="POST">
<input type="hidden" name="what_poll" value="<TMPL_VAR NAME="what_poll
+">" />
<h1><TMPL_VAR NAME="description"></h1>
<table summary="Questions">
  <tr>
    <th>Frage</th>
    <th> 1 - 2 - 3 - 4 -5 </th>
  </tr>
 <TMPL_LOOP NAME="questions">
  <tr>
    <td>
        <TMPL_VAR NAME="question">
    </td>
    <td>
        <input type="radio" name="<TMPL_VAR NAME="id">" value="1" />
        <input type="radio" name="<TMPL_VAR NAME="id">" value="2" />
        <input type="radio" name="<TMPL_VAR NAME="id">" value="3" />
        <input type="radio" name="<TMPL_VAR NAME="id">" value="4" />
        <input type="radio" name="<TMPL_VAR NAME="id">" value="5" />
    </td>
  </tr>
 </TMPL_LOOP>
</table>
<hr />
<input type="submit" name="action" value="Abstimmen" />
<input type="reset" value="Leeren" />
</form>
<hr />
</div>
<div>
Bitte bewerten Sie die einzelnen Fragen von 1 (schlecht) bis 5 (sehr g
+ut).
</div>
</body>
</html>
[download]

report.tmpl

<TMPL_INCLUDE NAME="header.tmpl">
<body>
<h1>Danke für die Teilnahme an dieser Umfrage</h1>
<TMPL_IF NAME="public">
 <table summary="Umfrageergebniss">
  <TMPL_LOOP NAME="questions">
  <tr>
    <td><TMPL_VAR NAME="question"></td>
    <td>
     <img style="width: <TMPL_VAR NAME="bar">px;
              height: 14px;
              border-width:1px;
              border-style:solid;"
           src="images/bar.png"
           alt="<TMPL_VAR NAME="result">" />
    </td>
    <td><TMPL_VAR NAME="result"></td>
  </tr>
  </TMPL_LOOP>
 </table>
 <hr />
 Anzahl abgegebener Stimmen: <TMPL_VAR NAME="number_of_votes"><br />
</TMPL_IF>
</body>
</html>
[download]

what_poll.tmpl

<TMPL_INCLUDE NAME="header.tmpl">
<body>
<TMPL_LOOP NAME="polls">
  <li /><a href="poll.pl?what_poll=<TMPL_VAR NAME="poll">"><TMPL_VAR N
+AME="poll"></a>
</TMPL_LOOP>
</body>
</html>
[download]