File Coverage

Poll.pm

Criterion	Covered	Total	%
statement	30	163	18.4
branch	0	48	0.0
condition	0	24	0.0
subroutine	10	29	34.4
pod			n/a
total	40	264	15.1

package WWW::Poll;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
use Carp;

require Exporter;
require AutoLoader;

@ISA = qw(Exporter AutoLoader);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(

);
$VERSION = '0.01';


# Preloaded methods go here.

my $deBug=1;

# define constant variables
use constant QID => 'qid.dat';
use constant QUEST => 'questions.dat';
use constant ANS => '_ans.dat';
use constant VOTES => '_poll.dat';
use constant MAXWIDTH => '300';
# make a constant for fonts & the bar image location
use constant FONT => '';
my $imagepath = $ENV{SCRIPT_NAME}; # same as calling script
$imagepath =~ s|^(.*/).*?$|$1|;
use constant IMAGE => $imagepath.'bar.jpg';
undef $imagepath;

# new initializes with latest poll
sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $self = {};
	$self->{POLL_ID} = undef;
	$self->{POLL_PATH} = undef;
	$self->{POLL_QUESTION} = undef;
	$self->{POLL_ANSWERS} = ();
	$self->{POLL_VOTES} = ();
	$self->{POLL_LIST} = ();
	$self->{DATE} = ();
	bless ($self, $class);
	return $self;
}

#------ BEGIN poll object methods ------#

sub id {
	my $self = shift;
	if (@_) { $self->{POLL_ID} = shift; }
	if ( !$self->{POLL_ID} ) { $self->_get_qid; }
	return $self->{POLL_ID};
}

sub question {
	my $self = shift;
	if (@_) { $self->{POLL_QUESTION} = shift; }
	if ( !$self->{POLL_QUESTION} ) { $self->_get_question; }
	return $self->{POLL_QUESTION};
}

sub answers {
	my $self = shift;
	if (@_) {  %{ $self->{POLL_ANSWERS} } = @_; }
	if ( !$self->{POLL_ANSWERS} ) { $self->_get_answers; }
	return $self->{POLL_ANSWERS};
	#return %{ $self->{POLL_ANSWERS} };
}

sub votes {
	my $self = shift;
	if (@_) {  %{ $self->{POLL_VOTES} } = @_; }
	if ( !$self->{POLL_VOTES} ) { $self->_get_votes; }
	return $self->{POLL_VOTES};
	#return %{ $self->{POLL_VOTES} };
}

sub path {
	my $self = shift;
	if (@_) { $self->{POLL_PATH} = shift; }
	return $self->{POLL_PATH};
}

sub list {
	my $self = shift;
	if (!$self->{POLL_LIST}) { $self->_get_question("all"); }
	return %{ $self->{POLL_LIST} };
}

sub date {
	my $self = shift;
	if (@_) { $self->{POLL_DATE} = shift; }
	if (!$self->{POLL_DATE}) { $self->{POLL_DATE} = &_create_date; }
	return $self->{POLL_DATE};
}

#------ END poll object methods ------#

#-------------------------------------------#

#------ BEGIN public methods ------#

# read poll returning poll id
sub get {
	my $self = shift;
	# $self->get($n) will return a specified poll
	# or the latest poll if no params or valid files
	if (@_ && ($_[0] =~ /\d/)) { $self->{POLL_ID} = shift;  } else { $self->id; }
	# retrieve poll question
	$self->_get_question;
	# retrieve poll answers file
	$self->_get_answers;
	# retrieve poll results file
	$self->_get_votes;
	# send them html
	#return $self->_create_poll_html;
	return $self->id;
}

# read poll returning html
sub get_html {
	my $self = shift;
	# $self->get($n) will return a specified poll
	# or the latest poll if no params or valid files
	if (@_ && ($_[0] =~ /\d/)) { $self->{POLL_ID} = shift;  } else { $self->id; }
	# retrieve poll question
	$self->_get_question;
	# retrieve poll answers file
	$self->_get_answers;
	# retrieve poll results file
	$self->_get_votes;
	# send them html
	return $self->_create_poll_html;
}

# vote on a poll
sub vote {
	my $self = shift;
	my $vote = shift;

	# get poll content
	$self->_get_votes;
	# increment proper poll result
	foreach ($self->rkeys) {
		( $_ == $vote ) ? ++$self->votes->{$_} : next ;
	}
	# write new poll back to file
	$self->_write_votes;
	undef $vote;	# cleanliness is next to godliness
	return 1;
}

# seed answers for poll creation
sub add_answers {
	my $self = shift;
	my $i=1;
	foreach (@_) {
		next unless (/\w/);
		$self->{POLL_ANSWERS}->{$i} = $_;
		$i++;
	}
}

# create a new poll
sub create {
	my $self = shift;
	# check to be sure all params have been set
	$self->_check_params;
	# clean out tabs & newlines from data
	$self->_clean_input;
	# get last qid number
	$self->_get_qid;
	# increment poll id
	$self->id($self->id+1);
	# append the question to the question file
	$self->_insert_question;
	# create answers file for new poll
	$self->_write_answers;
	# seed the votes object
	foreach ($self->akeys) { $self->{POLL_VOTES}->{$_} = '1'; }
	# create votes file for new poll
	$self->_write_votes;
	# update the qid file
	$self->_set_qid;
	# return some output html
	return $self->_create_admin_html;
}

# return keys for votes
sub rkeys {
	my $self = shift;
	if ( !$self->{POLL_VOTES} ) { $self->_get_votes; }
	return (keys %{ $self->votes });
}

# return keys for answers
sub akeys {
	my $self = shift;
	if ( !$self->{POLL_ANSWERS} ) { $self->_get_answers; }
	return (keys %{ $self->answers });
}

#------ END public methods ------#

#-------------------------------------------#

#------ BEGIN private methods ------#
# All private methods are accessing the hashes (except $self->id) directly
# rather than the proper object methods (just for the hell of it)

#- BEGIN reading from files METHODS
sub _get_qid {
	my $self = shift;
	# get qid of latest poll
	open(QFILE,$self->{POLL_PATH}."/".QID) || croak "$!, Perhaps \$poll->path() wasn't set?\n".$self->{POLL_PATH}."/".QID if $deBug;
	my @qid = ;
	close(QFILE);
	$self->{POLL_ID} = $qid[0];
}

sub _get_question {
	my $self = shift;
	# open & retrieve question
	open(QFILE,$self->{POLL_PATH}."/".QUEST) || croak "$!, Perhaps \$poll->path() wasn't set?\n".$self->{POLL_PATH}."/".QUEST if $deBug;
	if ( @_ && $_[0] eq 'all') {
		while() {
			/^(\d+)\t.*?\t(.*?)$/o;
			$self->{POLL_LIST}->{$1}=$2;
		}
	} else {
		while() {
			if (/^$self->{POLL_ID}\t(.*?)\t(.*?)$/o) {
				$self->{POLL_QUESTION}=($2);
				$self->date($1);
			}
		}
	}
	close(QFILE);
}

sub _get_answers {
	my $self = shift;
	open(AFILE,$self->{POLL_PATH}."/".$self->id.ANS) || croak "$!, Perhaps \$poll->path() wasn't set?\n".$self->{POLL_PATH}."/".$self->id.ANS if $deBug;
	while () {
		/^(\d+)\t(.*?)$/o;
		$self->{POLL_ANSWERS}->{$1}=$2
	}
	close(AFILE);
}

sub _get_votes {
	my $self = shift;
	# open & retrieve poll results file
	open(PFILE,$self->{POLL_PATH}."/".$self->id.VOTES) || croak "$!, Perhaps \$poll->path() wasn't set?\n".$self->{POLL_PATH}."/".$self->id.VOTES if $deBug;
	while () {
		/^(\d+)\t(\d+)$/o;
		$self->{POLL_VOTES}->{$1}=$2;
	}
	close(PFILE);
}

sub _create_poll_html {
	my $self = shift;
	my ($sum,@votes);

	foreach (keys %{$self->{POLL_VOTES}}) {
		push @votes, $self->{POLL_VOTES}->{$_};
		$sum += $self->{POLL_VOTES}->{$_};
	}

	# get highest vote
	my @maxvotes = sort { $b<=>$a } @votes;
	my $maxvote = $maxvotes[0];
	undef (@maxvotes,@votes);

	if ( $maxvote<1 ) { $maxvote=1; }
	#my $factor = MAXWIDTH/(MAXWIDTH-$maxvote);
	#croak $factor;

	my $format_date = $self->{POLL_DATE};
	$format_date =~ s|(\d{4})(\d{2})(\d{2})|$2/$3/$1|;
	my $html = "
			";  "; 




291




 





 





 





 





 





 



 	$html .= " 




292




 





 





 





 





 





 



 			 




293




 





 





 





 





 





 



 					".FONT."".$self->{POLL_QUESTION}."  




294




 





 





 





 





 





 



 					( question posted ".$format_date." - ".$sum." votes total )




295




 





 





 





 





 





 



 	foreach ( sort keys %{$self->{POLL_VOTES}} ) { 




296




 





 





 





 





 





 



 		my $vote = ( $self->{POLL_VOTES}->{$_}<1 ) ? 1 : $self->{POLL_VOTES}->{$_} ; 




297




 





 





 





 





 





 



 		if ($sum<1 ) { $sum=1; } 




298




 





 





 





 





 





 



 		$html .= " 




299




 





 





 





 





 





 



 			 




300




 





 





 





 





 





 



 				 




301




 





 





 





 





 





 



 					".FONT.$self->{POLL_ANSWERS}->{$_}." 




302




 





 





 





 





 





 



 					 




303




 





 





 





 





 





 



 					 




304




 





 





 





 





 





 



 					 ".int(($vote/$sum)*100)."%  - ".$vote." votes 




305




 





 





 





 





 





 



 			"; 




306




 





 





 





 





 





 



 	} 




307




 





 





 





 





 





 



 	$html .= " 




308




 





 





 





 





 





 



 			";
	$html .= "

					".FONT."".$self->{POLL_QUESTION}."
					( question posted ".$format_date." - ".$sum." votes total )
	foreach ( sort keys %{$self->{POLL_VOTES}} ) {
		my $vote = ( $self->{POLL_VOTES}->{$_}<1 ) ? 1 : $self->{POLL_VOTES}->{$_} ;
		if ($sum<1 ) { $sum=1; }
		$html .= "


					".FONT.$self->{POLL_ANSWERS}->{$_}."


					 ".int(($vote/$sum)*100)."%  - ".$vote." votes
			";
	}
	$html .= "

	return $html;
}

sub _create_admin_html {
	# format some html to display to admin
	my $self = shift;
	my $html = "
		"; ";  




317




 





 





 





 





 





 



 		".FONT."".$self->{POLL_QUESTION}."




318




 





 





 





 





 





 



 	foreach ( keys %{$self->{POLL_ANSWERS}} ) { 




319




 





 





 





 





 





 



 		$html .= " 




320




 





 





 





 





 





 



 		".FONT."Answer ".$_.":".FONT.$self->{POLL_ANSWERS}->{$_}."




321




 





 





 





 





 





 



 	} 




322




 





 





 





 





 





 



 	$html .= qq|\n\n|;

	foreach ( keys %{$self->{POLL_ANSWERS}} ) {
		$html .= "

	}
	$html .= qq|\n
	return $html;
}
#- END reading from files METHODS

#- BEGIN writing to files METHODS
sub _set_qid {
	my $self = shift;
	# get qid of latest poll
	open(QFILE,">".$self->{POLL_PATH}."/".QID) || croak "$!, Perhaps \$poll->path() wasn't set?\n".$self->{POLL_PATH}.QID if $deBug;
	print QFILE $self->id;
	close(QFILE);
}

sub _insert_question {
	my $self = shift;
	# insert question & date(YYYYMMDD) into file
	open(QFILE,">>".$self->{POLL_PATH}."/".QUEST) || croak "$!" if $deBug;
	print QFILE $self->id."\t".$self->date."\t".$self->{POLL_QUESTION}."\n";
	close(QFILE);
}

sub _write_answers {
	my $self = shift;
	open(AFILE,">".$self->{POLL_PATH}."/".$self->id.ANS) || croak "$!" if $deBug;
	foreach ( keys %{$self->{POLL_ANSWERS}} ) {
		print AFILE $_ ."\t".$self->{POLL_ANSWERS}->{$_}."\n";
	}
	close(AFILE);
	return 1;
}

sub _write_votes {
	my $self = shift;
	open(PFILE,">".$self->{POLL_PATH}."/".$self->id.VOTES) || croak "$!" if $deBug;
	foreach ( keys %{$self->{POLL_VOTES}} ) {
		print PFILE $_ ."\t".$self->{POLL_VOTES}->{$_}."\n";
	}
	close(PFILE);
	return 1;
}
#- END writing to files METHODS

#- BEGIN miscellany METHODS
sub _chmod_files {
	my $self = shift;
	chmod 0666, $self->{POLL_PATH}."/".$self->id.VOTES,$self->{POLL_PATH}."/".$self->id.ANS;
	return 1;
}

sub _check_params {
	my $self = shift;
	if ( scalar((keys %{$self->{POLL_ANSWERS}}))<1 ) { die "$! Answers weren't set"; }
	if ( $self->{POLL_QUESTION} !~ /\w/ ) { die "$! Question wasn't set"; }
}

sub _clean_input {
	my $self = shift;
	$self->{POLL_QUESTION} =~ s/[\t\r\n]/  /g;
	foreach ( keys %{ $self->{POLL_ANSWERS} } ) {
		$self->{POLL_ANSWERS}->{$_} =~ s/[\t\r\n]/  /g;
	}
}

sub _create_date {
	my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
	$mon = '0'.($mon+1) if ($mon<10);
	$mday = '0'.$mday if ($mday<10);
	return (($year+1900).$mon.$mday);
}
#- END miscellany METHODS

# uncomment this if mod_perl complains in the error log
#sub DESTROY { }

#------ END private methods ------#

#-------------------------------------------#


# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__