Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Graphical Survey Manager

by jerrygarciuh (Curate)
on Feb 24, 2002 at 22:25 UTC ( #147222=sourcecode: print w/ replies, xml ) Need Help??

Category: Fun Stuff
Author/Contact Info David Martin aka jerrygarciuh
perlgeek@nolaFlash.com
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" );
}

Comment on Graphical Survey Manager
Download Code
Re: Graphical Survey Manager
by zentara (Archbishop) on Feb 25, 2002 at 23:43 UTC
    Hi, I'm trying out your cgi script and was wondering if you could post up a sample 'data.info' file. I couldn't quite get your 'admin' mode to create it.
      Good points. New code posted with updated new_survey sub that tests for writable file and creates one if it is absent. Also changed is the sub get_survey_list which no longer dies if there is no data.info .
      HTH
      jg
      _____________________________________________________
      It's not my tree.

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://147222]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others about the Monastery: (5)
As of 2015-03-07 00:19 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    When putting a smiley right before a closing parenthesis, do you:









    Results (181 votes), past polls