Graphical Survey Manager

[jerrygarciuh]

Category:

Fun Stuff

Description:

This script generates polls from a flatfile its admin creates, accepts polling info and uses GD::Graph3d to create .pngs of the results. It has an easy admin backend for adding and deleting new polls. Needed improvements include:

• Password protection for admin mode which is currently diabled by the limit on requests to POST. There are a lot of ways this can be redressed and I haven't decided which I want yet.
• A way (probably cookies) to keep folks from repeated voting
• Improved data structure to make it easy for the delete_survey sub to clean up the .png and .poll files, this won't be hard, I just haven't done it yet.
• And lastly a way to get GD to print text at a 45º angle. Currently it changes to vertical if the labels get too wide, but this is hard to read. GD::Text::Align has been recommended for this purpose, but not implemented yet.

Hope ya dig it!
jg

See 2.25.02 post in thread for updates. Code below reflects changes posted there. 2.26.02 update: sub referer check updated and it's called moved to the top of the script to prevent saved copies of the forms being manipulated and posted to the script.

#!/usr/bin/perl
use strict;

use Fcntl ':flock';  # import LOCK_* constants
use GD::Graph::bars3d;
use CGI qw/:standard/;
use CGI::Carp qw/fatalsToBrowser /;

my $q = CGI->new();

######### CONFIG #############
my $survey_folder_path ="/home/thesite/www/survey/";
my $image_URL = "http://www.thesite.com/survey/";
my $textclr = "gold";
my $transparent = "TRUE";
my $sort_it=1;  #0 for no sort
##############################
my (@col,@val,%data,$k,$v,$word,$total_per);
my (%data,@file,$total_votes,$percent,$admin, $delete_survey,@surveys,
+$new_survey);
my ($name,$input,$title,$xlabel,$ylabel,$menu_name,$question, @radio_v
+als, $choices);

referer_check();

my $meth = $q->request_method;
if ($meth ne 'POST' && $q->param()) {
    print $q->header,start_html,
            h1( "Please vote using our form",
            a( {-href=>url}, "here" ), ".",
            ),
            end_html;
    exit;
}

if (!$q->param()) {
    choose_survey();
}

if ($q->param( 'new_survey' )) {
    new_survey();
}

if ($q->param( 'menu_name' )) {
    $menu_name = $q->param( 'menu_name' );
    make_survey();
}
if ($q->param( 'admin' )) {
    $admin = $q->param( 'admin' );
    admin_survey();
}

if ($q->param( 'delete_survey' )) {
    delete_survey();
}


get_data();
make_graph();
exit;

sub get_survey_list {
    my $data_file = $survey_folder_path."data.info";
    open (DH, "$data_file");
    while (<DH>) {
        chomp;
        my @line = split(/:/, join('', $_));
        $_=shift(@line);
        my $next =$_;
        push (@surveys,$_); #array of choices for popup menu
    }
    close DH;
    @surveys;
}

sub choose_survey {
    get_survey_list();
    print $q->header(-type=>"text/html"),
                start_html( {-bgcolor=>"black",-title=>"nolaFlash Surv
+ey Selector"} ),
                table( {-width=>'400'},
                Tr( {-align=>'CENTER'},
                 td(
                    font( {-color=>'gold', -face=>'Arial', -size=>'3'}
+,"Please select a survey:"),
                start_form( {-action=>self_url} ),
                popup_menu( {-name=> "menu_name",-values=>\@surveys} )
+,
                        p(  submit( {-value=>"Onward!"} ), ),
                    end_form,
                    ), #td
                   ), #tr
                ), #table
                end_html;
    exit;
}

sub make_survey {
    my $data_file = $survey_folder_path."data.info";
    open (DH, "$data_file") or die "where's the data file? : $!";
    while (<DH>) {
        chomp;
        my @line = split(/:/, join('', $_));
        $_ = shift(@line);
        if (/^$menu_name/) {               #get vars for form
             $name =         shift(@line);
            $question =     shift(@line);
            $title =         shift(@line);
            $xlabel =     shift(@line);
            $ylabel =     shift(@line);
            @radio_vals =     @line;
        }

    }

    close DH or die "Data file won't close : $!";

    print     $q->    header,start_html( {-title=>"$title",-bgcolor=>"
+black",-text=>'gold'} ),
                start_form( {-method=>"post"} ), p( {-font=>'Arial',-s
+ize=>'3'},b( $question ), );

    my $end = @radio_vals;
    for (my $i=0; $i < $end; $i++) {
        print $q->radio_group( {-name=>"input",-value=>$radio_vals[$i]
+, -default=>''},"$radio_vals[i]"),br;
        }
    print $q->hidden( {-name=>"name",-value=>$name} ),hidden( {-name=>
+"title",-value=>$title} ),
                hidden( {-name=>"xlabel",-value=>$xlabel} ),hidden( {-
+name=>"ylabel",
                -value=>$ylabel} ),submit( {-value=>"Vote!"} ),end_for
+m,end_html;
    exit;
}

sub referer_check {
    my $referer = $ENV{HTTP_REFERER};
    my $hostname = quotemeta( $ENV{HTTP_HOST} || $ENV{SERVER_NAME} );
    if ( $referer !~ m|^http://$hostname/| ) {
        print $q->header,start_html( {-title=>"For Shame!"} ),
                        div( {-align=>"center"},
                            h1("What are you trying to pull here?"),
                            p("Please use the form at",
                            a({-href=>url}, "Our Site."),
                            ), #end_p
                        ), #end_div
                    end_html;
        exit;
    }
}
sub get_data {
    $input = $q->param( "input" );
    $name = $q->param( "name" );
    $title = $q->param( "title" );
    $xlabel = $q->param( "xlabel" );
    $ylabel = $q->param( "ylabel" );
    my $results_file = "$survey_folder_path$name.poll";
    if (-e $results_file){
        open (FH, "+< $results_file") or die "where's the data file? :
+ $!";
    } else {
        open (FH, "> $results_file") or die "where's the data file? : 
+$!";
    }
    flock (FH,LOCK_EX) or die "Couldn't flock: $!";



    my @file = <FH>;
    chomp @file;
    %data = split(/:/, join('', @file));
    if ($input){
        $data{$input}++;
    }

    seek FH, 0, 0;
    truncate (FH,0) or die "Can't truncate: $!";

    my $file = join(":", %data);
    print FH $file;



    close FH or die "Data file won't close : $!";

    for (values %data) { $total_votes += $_ }

    #for (values %data) {            #make the hash values into percen
+ts
    #$_ = $_/$total_votes*100;
    #}
    if ($sort_it) {
        foreach $word (sort {lc($a) cmp lc($b)} keys %data) {
            push( @col , $word );
            push( @val ,  $data{ $word } );
        }
    } else {
        @col = (keys %data);
        @val = (values %data);
    }
}

sub make_graph {
    my $colors=qw(lgray gray dgray black lblue blue dblue gold lyellow
+ yellow dyellow lgreen green dgreen lred red     dred lpurple purple 
+dpurple lorange orange pink dpink marine cyan lbrown dbrown white);

    if($#col != $#val){
        print $q->header;
        print "<b><h1>Error:  Parameters are not balanced</h1></b>";
        exit;
    }
    my @data = ( [@col], [@val] );
    my $graph = new GD::Graph::bars3d(400,300);
    if($title ne ''){
        $graph->set(title => "$title");
    }
    if($ylabel ne ''){
        $graph->set(y_label => "$ylabel");
    }

    if($xlabel ne ''){
        $graph->set(x_label => "$xlabel");
    }

    $_ = join('',@col);
    my $label_length = tr/a-zA-Z//;
    my $vertical_labels;

    if ($label_length > 40) {
        $vertical_labels = 1;
    } else {
        $vertical_labels = 0;
    }

    $graph->set(cycle_clrs => 'TRUE',
              dclrs => [ qw(marine dgray dpurple dred dgreen gold lpur
+ple dpink dbrown dblue) ],
              transparent => "$transparent",
                bar_spacing => '10',
                legend_placement => 'CB',
                bar_width => '15',
                y_label_skip     => '1',
                x_label_position => '0.5',
                show_values => '1',
                x_labels_vertical => "$vertical_labels" );
    $graph->set_text_clr("$textclr");
    $graph->set_values_font('ARIAL.TTF', 24);
    $graph->set_legend_font('ARIAL.TTF', 24);
    $graph->set_x_label_font('ARIAL.TTF', 24);
    $graph->set_y_label_font('ARIAL.TTF', 24);

    my $gd = $graph->plot( \@data );

    open(IMG, ">$survey_folder_path$name.png") or die $!;
    binmode IMG;
    print IMG $gd->png;
    close IMG;

    my $caption;
    if ($input) {
            $caption ="You cast vote number $total_votes.";
        } else {
            $caption ="There have been $total_votes votes, but you did
+n&#039;t cast one!";
        }

    print $q->header,start_html( {-title=>"Survey Results", -bgcolor=>
+"#000000" } ),
         table({-width=>'400'},
             Tr( {-align=>'CENTER'},
                 td(
                 img( {-src=>"$image_URL$name.png",-heigth=>'300',-wid
+th=>'400'} ),
                 font( {-color=>'gold', -face=>'Arial', -size=>'3'},$c
+aption ),
                 ),
            ), #tr
        ), #table
    end_html;
}

sub admin_survey {
    get_survey_list();
    print $q->header,start_html( {-title=>"Survey Admin Page", -bgcolo
+r=>"#FFFACD"} ),
            div( {-align=>'center'},
            font( { -face=>'Arial' }),  h1( "Survey Admin Page" ),
            table( {-width=>'80%', -border=>'1'},
                Tr(
                    td( {-align=>'center'},
                    font( {-face=>'Arial', -size=>'3'} ),
                    b( "Delete a survey?" ),
                    start_form( { -action=>url } ),
                    popup_menu( {-name=> "delete_me",-values=>\@survey
+s} ),
                    hidden( { -name=>"delete_survey",-value=>"true" } 
+),
                    p( submit( {-value=>"Delete Survey!"} ), ),
                    end_form,
                    ), #td
                    td(
                    font( {-face=>'Arial', -size=>'3'} ),
                    h4( {-align=>'center'},"Add a survey?" ),
                        start_form( { -action=>url } ),
                       table(
                        Tr(
                        td( {-align=>'right'},"Name for menu (this can
+ contain spaces):" ),
                        td( textfield( {-name=>"menu_name",-maxlength=
+>'20'} ), ),
                        ),
                        Tr(
                        td( {-align=>'right'},"Name for files (letters
+ and numbers only):" ),
                        td( textfield( {-name=>"name",-maxlength=>'20'
+} ), ),
                        ),
                        Tr(
                        td( {-align=>'right'},"Survey Question:" ),
                        td( textfield( {-name=>"question",-maxlength=>
+'150',-size=>'40'} ), ),
                        ),
                        Tr(
                        td( {-align=>'right'},"Title of this survey (g
+oes over graph):" ),
                        td( textfield( {-name=>"title",-maxlength=>'15
+0'} ), ),
                        ),
                        Tr(
                        td( {-align=>'right'},"Horizontal Label (i.e. 
+'Cheeses or Monks'):" ),
                        td( textfield( {-name=>"xlabel",-maxlength=>'2
+0'} ), ),
                        ),
                        Tr(
                        td ( {-align=>'right'},"Vertical Label (usuall
+y 'Votes'):", ),
                        td( textfield( {-name=>"ylabel",-maxlength=>'2
+0'} ), ),
                        ),
                        Tr(
                        td( {-colspan=>'2',-align=>'center'}, "List yo
+ur choices seperated by commas:",
                        textarea( {-name=>"choices", -cols=>'40',-maxl
+ength=>'200'} ), ),
                        ),
                        Tr(
                        td( {-align=>'center'},submit(-value=>"Create 
+Poll"), ),
                        td( {-align=>'center'},reset(-value=>"Clear Fo
+rm"), ),
                        ),
                        ), #table
                    hidden( {-name=>"new_survey",-value=>'true'}), end
+_form,
                    ), #td
                   ), #tr
                ), #table
                p( a( {-href=>url}, "Back To Surveys" ), ),
                ), #div from top
                end_html;
    exit;
}

sub new_survey {
    $menu_name = $q->param( 'menu_name' ) || "Survey_$$";
    $name = $q->param( 'name' ) || "Survey_$$";
    $name =~ s/\W//g;
    $question    = $q->param( 'question' );
    $title = $q->param( 'title' );
    $xlabel = $q->param( 'xlabel' );
    $ylabel = $q->param( 'ylabel' );
    $choices = $q->param( 'choices' );
    if (!$choices) {
        print $q->header,start_html,h1("You can't have a survey with n
+o choices!"),
                a( {-href=>url."?admin=1"}, "Try, try again!" ), end_h
+tml;
        exit;
    }
    my @choices = split( /,/ ,$choices );
    my @all = ($menu_name, $name, $question, $title, $xlabel, $ylabel,
+ @choices);
    my $output = join( ":", @all);

    my $data_file = $survey_folder_path."data.info";
    if (-w $data_file) {
        open (DH, ">> $data_file") or die "where's the data file? : $!
+";
    } else {
        open (DH, "> $data_file") or die "Couldn't create the data fil
+e! : $!";
    }
    flock (DH,LOCK_EX) or die "Couldn't flock: $!";
    print DH "$output\n";
    close DH or die "Data file won't close : $!";

    my $info_output = join(":0:", @choices);
    $info_output = "$info_output:0";

    my $info_file= "$survey_folder_path$name.poll";
    open (INFO, "> $info_file") or die "Couldn't create the info file!
+ : $!";
    print INFO $info_output;
    close INFO or die "Info file won't close : $!";

    print $q->redirect( url."?admin=1" );
}



sub delete_survey {
    my @line;
    my $delete_me = $q->param( 'delete_me' );
    my $data_file = $survey_folder_path."data.info";
    open (DH, "+< $data_file") or die "where's the data file? : $!";
    flock (DH,LOCK_EX) or die "Couldn't flock: $!";
    @line = grep {! /\Q$delete_me\E/} <DH>;
    seek DH, 0, 0;
    truncate (DH,0) or die "Can't truncate: $!";
    print DH @line;
    close DH or die "Data file won't close : $!";
    print $q->redirect( url."?admin=1" );
}