#!/usr/bin/perl -T

use strict;
use warnings;

use CGI;
use CGI::Carp qw/warningsToBrowser fatalsToBrowser/;
use Data::Dumper;
use HTML::Template::Compiled;

package Questions;

sub _new {
    my $class       = shift;
    my $id          = shift or die 'It needs an ID to create an instance!';
    my $question    = shift or die 'It needs a question to create an instance!';
    my $answers     = [@_];
    my $type        = 'selection' if @$answers;
    my $self        = { id => $id, question => $question, type => $type, answers => $answers };
    
    return bless $self, $class;
}

sub question {
    my $self    = shift;
    return $self->{question};
}

sub render_form {
    my $self    = shift;
    my $output;
    if ($self->{type} ne 'selection') {
        $output = "<select name='$self->{id}'>\\n"
                . "<option value='1'>Sehr gut</option>\\n"
                . "<option value='2'>Gut</option>\\n"
                . "<option value='3'>Befriedigend</option>\\n"
                . "<option value='4'>Ausreichend</option>\\n"
                . "</select>\\n";        
    } else {
        $output = "<select name='$self->{id}'>\\n";
        for (0..$#{$self->{answers}}) {
            $output .= "<option value='$_'>"
                    .  $self->{answers}->[$_]
                    .  "</option>\\n";
        }
        $output .= "</select>\\n";
    }

    return $output;
}

sub render_radio {
    my $self    = shift;
    my $output;
    if ($self->{type} ne 'selection') {
        $output = "<select name='$self->{id}'>\\n"
                . "<option value='1'>Sehr gut</option>\\n"
                . "<option value='2'>Gut</option>\\n"
                . "<option value='3'>Befriedigend</option>\\n"
                . "<option value='4'>Ausreichend</option>\\n"
                . "</select>\\n";        
    } else {
        for (0..$#{$self->{answers}}) {
             $output .= "<input type='radio' name='$self->{id}' value='$_' />";
             $output .= $self->{answers}->[$_] . "<br />\\n";
        }
    }

    return $output;
}

sub bulk_create {
    my $class       = shift;
    my $filename    = shift or die 'It needs an filename to bulk_create!';
    my @catalog;
    
    open (BULK, '<', $filename) or die "bulk_create died cause of: $!";
    while (<BULK>) {
        next unless /^\\d+/;
        chomp;
        my ($id, $question, @answers) = split /;/;
        $question   =~ s/"//g;
        s/"//g for @answers;
        push @catalog, $class->_new($id, $question, @answers);
    }
    close (BULK);
    
    return \\@catalog;
}

1;

package Result;
use GD::Graph;
use GD::Graph::pie;
use MIME::Base64;

sub new {
    my $class       = shift;
    my $self        = {};
    return bless $self, $class;
}

sub topic {
    my $self = shift;
    $self->{topic} = shift if @_;
    return $self->{topic};
}

sub answer {
    my $self    = shift;
    if (@_) {
        my $choise  = shift;
        my $cnt     = shift;
        push @{$self->{answer}}, { choice => $choise, cnt => $cnt };
    }
    return $self->{answer};
}

sub as_pie_chart {
    my $self = shift;
    my $g = GD::Graph::pie->new(250, 250);
    my @data = (
        [map {$_->{choice}} @{$self->answer()}],
        [map {$_->{cnt}}    @{$self->answer()}],
    );
    my $gd = $g->plot(\\@data) or die $g->error;
    my $img_mime = '<IMG SRC="data:image/png;base64,'. encode_base64($gd->png). '" alt=""/>';
    return $img_mime; 
}

1;

package Answers;

use Storable;
use Data::Dumper;

our $source;     # let's try a class-variable for this (and for now)

sub new {
    my $class       = shift;
    $source         = shift or die 'new() needs a sourcename!';
    my $self        = -e "$source.db" ? retrieve("$source.db") : {};    
    return bless $self, $class;
}

sub update {
    my $self        = shift;
    my $form        = shift || {};
    for (keys %$form) {
        next if /action/;
        $self->{$_}->{$form->{$_}}++;
    }
    store $self, "$source.db" or die "Can't store $source.dat: $!\\n";
}

sub as_csv {
    my $self = shift;
    my $questions = shift;
    my $output = '';
    
    for my $id (sort { $a <=> $b } keys %$self) {
        if (ref $questions) {
            $output .= '"' . $questions->[$id-1]->{question} . '"' . "\\n";
        } else {
            $output .= $id . "\\n";
        }
        
        for (sort { $a <=> $b } keys %{$self->{$id}}) {
            if ($questions->[$id-1]->{answers}->[$_]) {
                $output .= '"' . $questions->[$id-1]->{answers}->[$_] . '"'
                        . ";" . $self->{$id}->{$_} . "\\n";
            } else {
                $output .= $_ . ";" . $self->{$id}->{$_} . "\\n";
            }
        }
        $output .= "\\n";
    }
    return $output;
}

sub as_report {
    my $self = shift;
    my $questions = shift;
    my $output = [];
    
    for my $id (sort { $a <=> $b } keys %$self) {
        my $current = new Result;
        
        if (ref $questions) {
            $current->topic($questions->[$id-1]->{question});
        } else {
            $current->topic($id);
        }
        
        for (sort { $a <=> $b } keys %{$self->{$id}}) {
            if ($questions->[$id-1]->{answers}->[$_]) {
                $current->answer($questions->[$id-1]->{answers}->[$_], $self->{$id}->{$_});
            } else {
                $current->answer($_, $self->{$id}->{$_})
            }
        }
        push @$output, $current;
    }
    return $output;
}

1;

package main;

my $source      = 'intel';
my $questions   = bulk_create Questions($source . '.txt');
my $q           = new CGI;
my $template    = HTML::Template::Compiled->new(filename => "vote5.html");
my $answers     = new Answers( $source );

if ($q->param('action') eq 'Abstimmung') {
    $answers->update({$q->Vars()});
    $template->param( message => 'Danke, Ihre Stimme wurde gezaehlt!' );
} elsif ( $q->param('action') eq 'rep' ) {
    $template->param( debug => $answers->as_report($questions) );
} elsif ( $q->param('action') eq 'csv' ) {
    print $q->header('text/plain'), $answers->as_csv($questions);
    exit;
} else {
    $template->param( questions => $questions );
}
print $q->header(), $template->output();