Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
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 examining the Monastery: (8)
As of 2014-12-22 15:54 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (121 votes), past polls