#!/usr/bin/perl -w
# File: poll		-*- Perl -*- 
# Created by: Alex (wtwf.com) Thu Mar 26 11:27:08 1998
# Last Modified: Time-stamp: <Tue Jan 28 07:26:48 PST 2003> 
# RCS $Id: poll,v 1.5 2004/03/24 22:58:51 ark Exp $ 

# distributed under the GNU public license available from www.gnu.org

# original copyright 1998 Alex wtwf.com

# for more info see 
#   USA: http://bungee.jump.com/~ark/scripts/poll.shtml
#   UK:  http://www.tardis.ed.ac.uk/~ark/scripts/poll.shtml

# no warranty - use at your own risk. I don't care if this trashes your disk

# a poll server - will record and retrun Poll Results

# we'll let the log file get to 400k before it's considered too big.
$maxfilesize=400000;

$arkHOME=(getpwnam('ark'))[7];
unshift(@INC,"$arkHOME/lib/perl");

# this is the directory I put the poll files in - you will have to change this
$dir="$arkHOME/html/scripts/logs/polls/";

# you'll also have to change the imgURL line below to point to a good
# image for you

use Socket;
require "ark-lib.pl";

use CGI;

use Time::Local;

BEGIN {
  # set up the global variables
  
  %votes=();
  @possib=(); # array of the possible voting options - to keep them in order
  $IP='$^';
  $total=0;
  $question='';
  $extraText=''; #$ extra text added by teh program
  $extra='';     # extra text from the poll file
  %pastvotes=();
  $expires=0;
  $expiresSTR='';
  
  $debug=0;
  
  $LOCK_SH=1;
  $LOCK_EX=2;
  # $LOCK_NB=4;
  $LOCK_UN=8;

  if( $ENV{'SERVER_NAME'} && $ENV{'SERVER_NAME'} =~ /ragemtb.com/i ){
    $imgURL='/Images/bkg/gold1x1.gif';
  } else {
    $imgURL='http://www.bloodyeck.com/Images/bg/gold1x1.gif';
  }
}

MAIN:
{
  &ARKprint_header() if $debug;
  
  my $poll=$ENV{'PATH_INFO'};
  
  if( !$poll || length($poll) < 2 ){
    &ARKerror("No Poll name specified");
  }
  
  if( $poll =~ /(\w+)/ ){
    $poll=$1;
  } else {
    &ARKerror("Poll name can only contain letters and numbers");
  }
  
  # strip off the 
  # $poll=~s/^\///;
  
  my $pfile="$dir$poll";
  
  &ARKdodgy_filename($pfile);
  
  if( ! -r $pfile ){
    &ARKerror("You cannot read that Poll file - maybe it doesn't exist");
  }
  
  $cgi=new CGI;
  if( $cgi->param() ){
    &register_vote( $pfile, $cgi );
  } else {
    &display_results( $pfile );
  }
}

sub register_vote
{
  my( $file, $cgi )=@_;
  
  &read_file( $file, 1 );
  
  if( $expires && $expires < time   ){
    $extraText="<P>This Poll is no longer accepting votes</P>";
  } else {
    my $vote=$cgi->param('submit');

    # escape the vote to prevent malicious people making their own forms...
    $vote=~s/</\&lt;/g;
    $vote=~s/>/\&gt;/g;
  
    my $addr=$ENV{'REMOTE_ADDR'};
    
    # print "your past vote from $addr was $pastvotes{$addr} <BR>\n";
    
    if( $pastvotes{$addr} ){
      # update existing vote
      if( $pastvotes{$addr} ne $vote ){
	$extraText="<P>Changing your vote from \"$pastvotes{$addr}\" to \"$vote\"</P>\n";
      }
      $votes{$pastvotes{$addr}}--;
      $total--;
    }
    
    if( $votes{$vote} ){
      $votes{$vote}++; 
    } else {
      $votes{$vote}=1;
    }
    
    # add this to possib if we have to...
    if( ! &member_of( $vote, @possib ) ){
      push( @possib, $vote );
    }
    
    
    $pastvotes{$addr}=$vote;
    
    $total++;
    
    &write_file( $file );
  }
  
  if( $cgi->param('thanks') ){
    &ARKrelocate(&ARKjoinURL($ENV{'HTTP_REFERER'},$cgi->param('thanks') ));
  } else {
    &print_results();
  }
}
    
sub member_of
{
  $val=shift;
  
  while( @_ ){
    return 1 if( $val eq shift );
  }
  return 0;
}

sub display_results
{
  my( $file)= @_;
  
  &read_file( $file );
  &print_results();
}

sub print_results
{
  &ARKprint_header();
  
  &ARKprint_title_smart("Poll Results") unless $ENV{'DOCUMENT_NAME'};
  
  print "<H2>Poll: $question</H2>\n$extraText\n";
  my $pc;
  
  if( $total ){  
    print "<TABLE BORDER=0>\n";
    for $fil (@possib){
      $pc=int(($votes{$fil}*100)/$total+0.5);
      printf("<TR><TH ALIGN=RIGHT>%s</TH><TD><IMG ALIGN=CENTER SRC=\"%s\" WIDTH=%s HEIGHT=30 ALT=\"%s\"> %s%%</TD></TR>\n",
	     $fil, $imgURL, $pc==0? 1:$pc*3, 
	     '*' x ($pc/2),
	     $pc);
    }
    print "</TABLE>\n";
  } else {
    print "<P>No votes have been made yet</P>\n";
  }
  print "<P>TOTAL VOTES: $total</P>\n";
  
  if( $extra ){
    print $extra;
  }
  
  &ARKprint_back()  unless $ENV{'DOCUMENT_NAME'};
  
  &ARKprint_sig_smart("Poll Results")  unless $ENV{'DOCUMENT_NAME'};
}


sub read_file
{
  my( $file, $full )=@_;
  
  open( IN, "<$file") || &ARKerror("Can't open POLL file for reading");
  
  flock IN, $LOCK_SH;
  
  my $line='';
  
  while( <IN> ){
    $line=$_;
    s/#.*$//;
    next if /^\s*$/;
    
    while ( $line=~/\\$/ && !eof( IN )){
      $line=~s/\\$//;
      print "Reading extra line\n" if $debug;
      $line.=<IN>;
    }
    
    print "Line is $line\n" if $debug;
    
    
    $_=$line;
    
    if( /question:\s*(.*)$/i ){
      $question=$1;
    } elsif( /total:\s*(\d+)$/i ){
      $total=$1;
    } elsif( /result:\s*(.+)\s*=\s*(\d+)$/i ){
      $votes{$1}=$2;
      push(@possib, $1);
    } elsif( /expires:\s*(\d+)\/(\d+)\/(\d+)$/i ){
      # the date is in Brit Speak - i.e. Day/Month/Year
      print "found date $1 $2 $3\n" if $debug;
      $expiresSTR="$1/$2/$3";
      if( $3 < 1000 ){
	$expires=timelocal(1,1,1,$1, $2-1, $3) ;
      } else {
	$expires=timelocal(1,1,1,$1, $2-1, $3+1000) ;
      }
      # print (1,1,1,$1, $2, $3<1000 ? $3+1000 : $3 );
      
      printf( "done time is %d expires=%d - expired = %d\n",
	     time, $expires, time > $expires ) if $debug;
      
    } elsif( /extra:\s*(.*)/mi ){
      # the date is in Brit Speak - i.e. Day/Month/Year
      $extra=$line;
      $extra=~ s/extra:\s+//i;
    } elsif( /vote:\s*(.+)\s*=\s*(.+)/i ){
      last if ! $full;
      $pastvotes{$1}=$2;
      $IP.='|'.$1;
    }
    last if ( !$full && $question && $total );
  }
  
  flock IN, $LOCK_UN;
  
  close IN;
}


sub write_file
{
  my( $file )=@_;
  
  # this is an attemot to combat the case where the log file was reset
  # don't know how it happened - I guess locking just failed :-(
  return unless $question; 
  
  if( -s $file > $maxfilesize ){
    &ARKerror("That poll has reached it's maximum size, sorry") ;
  }
  
  open( OUT, ">$file") || &ARKerror("Can't open POLL file for writing");
  
  flock OUT, $LOCK_EX;
  
  print OUT "# Poll file last written " . localtime(time) . "\n";
  print OUT "Question: $question\n";
  
  if( $expires ){
    print OUT "Expires: $expiresSTR\n";
  }
  
  if( $extra ){
    my $extraOUT=$extra;
    $extraOUT =~ s/\n/\\\n/gm;
    $extraOUT =~ s/^\\\n$//gm;
    print OUT "Extra: $extraOUT\n";
  }
  
  for $fil (@possib){
    print OUT "Result: $fil=$votes{$fil}\n";
  }
  
  print OUT "Total: $total\n";
  
  for $fil (sort keys %pastvotes){
    print OUT "Vote: $fil=$pastvotes{$fil}\n";
  }
  
  flock OUT, $LOCK_UN;
  
  close OUT;
}