[17562] in Perl-Users-Digest
Perl-Users Digest, Issue: 4982 Volume: 9
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Tue Nov 28 18:10:43 2000
Date: Tue, 28 Nov 2000 15:10:17 -0800 (PST)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Message-Id: <975453017-v9-i4982@ruby.oce.orst.edu>
Content-Type: text
Perl-Users Digest Tue, 28 Nov 2000 Volume: 9 Number: 4982
Today's topics:
Poll it <kseterba@chello.no>
Re: Poll it (Tad McClellan)
Re: Poll it (Martien Verbruggen)
Re: Reading a csv file <bart.lateur@skynet.be>
Re: Reading a csv file (Martien Verbruggen)
Recursively load all objects in an HTML page... snakedjip@yahoo.com
Re: Session tracking! <webmaster@duckpaw.com>
Re: Session tracking! (Martien Verbruggen)
Re: Session tracking! <bart.lateur@skynet.be>
Digest Administrivia (Last modified: 16 Sep 99) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Tue, 28 Nov 2000 19:18:15 GMT
From: "Kos" <kseterba@chello.no>
Subject: Poll it
Message-Id: <XxTU5.44$k03.3529@news01.chello.no>
I am using Pollit but i want to diable ip logging. I tryed but then after
voting the results wont show. So is there eny way i can diable this.
The two scripts follow
This is the SSI
#!/usr/local/bin/perl
####################################################################
# Script: | Poll It #
# Version: | 2.05 #
# By: | Jason Berry (i2 Services, Inc. / CGI World) #
# Contact: | jason@cgi-world.com #
# WWWeb: | http://www.cgi-world.com #
# Copyright: | Jason Berry (CGI World of i2 Services, Inc.) #
# Released | August 09, 1998 #
####################################################################
# By using this software, you have agreed to the license #
# agreement packaged with this program. #
# #
####################################################################
# Variables:
#
#
$image_url = "http://www.your-url.com/image.gif";
# URL to the 'image.gif' that was packaged with this script. Upload
# that GIF Image to your website & enter the URL to it above.
$vote_text = "Rock the Vote!";
# Text that is shown on the submit button when casting your vote.
# Note:
##################################################################
# If you're looking to use an image in one of the variables
# below, input the IMAGE tag inside of the quotes as:
# <IMG SRC=\"image_url.gif\"> <-- Placing backslashes (\)
# before the extra quotes inside a quote.
###########################################################
$last_poll_text = "<LI>our Previous Polls Results";
# Text that is linked to view the previous results of your
# previous poll.
$results_not_available = "<BR>The results will be posted soon...";
# Message shown when the number of votes is not greater then
# the ammount you opted for when setting up a poll.
$poll_not_available = "<BR>Currently there is no opinion poll
available...<P>Check back soon for another poll...";
# Message listed when a poll is not available.
#
$non_SSI_CGI_FileName = "Poll_It_.cgi";
# The name of the file that was originaly named "Poll_It_v2.0.cgi" when
# you received this zipped up package. If you renamed that file to
poll.cgi
# then enter "poll.cgi" above.
#
#
# (We do not support this script if you edit below this line )
################################################################
#
#
%in = &ReadForm;
if ($0=~m#^(.*)(\\|/)#) { $cgidir = $1; }
else { $cgidir = `pwd`; chomp $cgidir; }
$script_url = $ENV{'SCRIPT_NAME'};
$data_dir = "$cgidir/pollit_files";
$poll_options = "$data_dir/poll_options.txt";
$poll_info = "$data_dir/poll_info.txt";
$ips_file = "$data_dir/ips.txt";
$last_file = "$data_dir/last_poll.txt";
$lockdir = "$data_dir/filelock";
open(IPS,"<$ips_file");
@ips = <IPS>;
close(IPS);
$all_ips = join('|',@ips);
$addr = "$ENV{'REMOTE_ADDR'}\n";
if(@ips && $addr =~ /$all_ips/) {
$voted = 1;
}
if($option_selected && !$voted) {
&FileLock("$lockdir");
open(MIPS,">>$ips_file");
print MIPS "$ENV{'REMOTE_ADDR'}\n";
close(MIPS);
&FileUnlock("$lockdir");
open(POPTIONS,"<$poll_options");
while(<POPTIONS>) {
($option_id,$poll_option,$votes_received) = split(/=/,$_);
if($option_id eq "total") {
$new_total = $poll_option + 1;
$push = "total=$new_total\n";
push(@reprint,$push);
}
else {
if($option_id eq "$option_selected") {
$new_ototal = $votes_received + 1;
$push = "$option_id\=$poll_option\=$new_ototal\n";
push(@reprint,$push);
}
else {
push(@reprint,$_);
}
}
}
close(POPTIONS);
&FileLock("$lockdir");
open(REPRINT,">$poll_options");
print REPRINT @reprint;
close(REPRINT);
&FileUnlock("$lockdir");
$voted = 1;
print "Location: $ENV{'HTTP_REFERER'}\n\n";
}
# Print Out SSI Poll Box:
###############################################################
&Template("$data_dir/_ssi_poll.html");
open(POLLINFO,"<$poll_info");
while(<POLLINFO>) {
chop($_);
($pinfo,$pvalue) = split(/=/,$_);
$$pinfo = "$pvalue";
}
close(POLLINFO);
open(POLLOPTIONS,"<$poll_options");
@unsorted_poll_options = <POLLOPTIONS>;
close(POLLOPTIONS);
foreach$unsorted(@unsorted_poll_options) {
($option_id,$poll_option,$votes_received) = split(/=/,$unsorted);
chop($votes_recieved);
if($option_id eq "total") {
$total = $poll_option;
$show_total = "Total Votes: $total";
}
$push = "$votes_received\=$option_id\=$poll_option";
push(@poll_options,$push);
}
# Show Voting Results:
#####################################
if($voted) {
foreach$p_option(sort { $b <=> $a } @poll_options) {
($votes_received,$option_id,$poll_option) = split(/=/,$p_option);
if($option_id ne "total" && $total > "0") {
$percent = (int(($votes_received / $total) * 1000)) / 10;
$percent = substr($percent,0,4);
$sign = "%";
if($votes_received < 1) {
$percent = "0";
}
$width = int($percent * 1);
if($votes_received < 1) {
$width = 2;
}
$percent = "$percent$sign";
$image_percent = "<IMG SRC=\"$image_url\" Height=\"10\"
Width=\"$width\">";
$show_results .= &Cell('poll_results');
}
}
$show_results .= &Cell('total_votes');
if($show_results_after > $total) {
undef($show_results);
$show_results = "$results_not_available";
}
}
# Show Voting Options:
#####################################
if(!$voted) {
foreach$p_option(@poll_options) {
($votes_received,$option_id,$poll_option) = split(/=/,$p_option);
if($option_id ne "total") {
$display_options .= &Cell("show_options");
}
}
if(!$display_options) { $display_options = "$poll_not_available" };
}
if($display_options) { $submit = " <BR> <INPUT Type=SUBMIT
Value=\"$vote_text\">" };
open(LASTPOLL,"<$last_file");
@last_poll = <LASTPOLL>;
close(LASTPOLL);
if(@last_poll) {
$last_poll = "<A
HREF=\"$non_SSI_CGI_FileName?load=lastpoll\">$last_poll_text</A><BR>";
}
print &Template("$data_dir/_ssi_poll.html",'html');
# Load Template: #
###############################################################
sub Template {
local(*FILE);
if ($_[1] eq 'html') { print "Content-type: text/html\n\n" unless
($ContentType++ > 0); }
elsif ($_[1] eq 'text') { print "Content-type: text/plain\n\n" unless
($ContentType++ > 0); }
if (!$_[0]) { return "<br>\nTemplate : No file was specified<br>\n"; }
elsif (!-e "$_[0]") { return "<br>\nTemplate : File '$_[0]' does not
exist<br>\n"; }
else {
open(FILE, "<$_[0]") || return "<br>\nTemplate : Could open
$_[0]<br>\n";
while (<FILE>) { $FILE .= $_; }
close(FILE);
for ($FILE) {
s/<!-- insert : (.*?) -->/\1/gi; # show hidden inserts
s/<!-- def : (\w+) -->(?:\r\n|\n)?(.*?)<!-- \/def : \1 -->/
$CELL{$1}=$2;''/ges; # read/remove template cells
s/\$(\w+)\$/${$1}/g; # translate $scalars$
}
}
return $FILE;
}
# Translate Cell: #
###############################################################
sub Cell {
my($CELL);
for (0..$#_) { if ($_[$_]) { $CELL .= $CELL{$_[$_]}; }}
if (!$_[0]) { return "<br>\nCell : No cell was specified<br>\n"; }
elsif (!$CELL) { return "<br>\nCell : Cell '$_[0]' is not
defined<br>\n"; }
else { $CELL =~ s/\$(\w+)\$/${$1}/g; } # translate $scalars$
return $CELL;
}
# Parse Form: #
###############################################################
# Usage : %in = &ReadForm; #
# #
###############################################################
sub ReadForm {
my($max) = $_[1]; # Max Input Size
my($name,$value,$pair,@pairs,$buffer,%hash); # localize variables
# Check input size if max input size is defined
if ($max && ($ENV{'CONTENT_LENGTH'}||length $ENV{'QUERY_STRING'}) > $max)
{
die("ReadForm : Input exceeds max input limit of $max bytes\n");
}
# Read GET or POST form into $buffer
if ($ENV{'REQUEST_METHOD'} eq 'POST') { read(STDIN, $buffer,
$ENV{'CONTENT_LENGTH'}); }
if ($ENV{'QUERY_STRING'}) { $buffer .= $ENV{'QUERY_STRING'}; }
@pairs = split(/&/, $buffer); # Split into name/value pairs
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair); # split into $name and $value
$value =~ tr/+/ /; # replace "+" with " "
$value =~ s/%([A-F0-9]{2})/pack("C", hex($1))/egi; # replace %hex with
char
$$name = $value;
}
return %hash;
}
# File Locking: #
###############################################################
# Usage : &FileLock("$lockdir"); #
# : &FileUnlock("$lockdir"); #
# #
###############################################################
sub FileLock {
my($i); # sleep counter
while (!mkdir($_[0],0777)) { # if there already is a lock
sleep 1; # sleep for 1 sec and try again
if (++$i>60) { die("File_Lock : Can't create filelock : $!\n"); }
}
}
sub FileUnlock {
rmdir($_[0]); # remove file lock dir
}
####################################################################
And the nexst one
#!/usr/local/bin/perl
####################################################################
# Script: | Poll It #
# Version: | 2.05 #
# By: | Jason Berry (i2 Services, Inc. / CGI World) #
# Contact: | jason@cgi-world.com #
# WWWeb: | http://www.cgi-world.com #
# Copyright: | Jason Berry (CGI World of i2 Services, Inc.) #
# Released | August 09, 1998 #
####################################################################
# By using this software, you have agreed to the license #
# agreement packaged with this program. #
# #
####################################################################
# Variables:
#
#
$admin_password = "protection";
# Password you would like to use for entering the administration
# area located at: ScriptName.cgi?load=login
$image_url = "http://www.your-url/image.gif";
# URL to the 'image.gif' that was packaged with this script. Upload
# that GIF Image to your website & enter the URL to it above.
$vote_text = "Rock the Vote!";
# Text that is shown on the submit button when casting your vote.
# Note:
##################################################################
# If you're looking to use an image in one of the variables
# below, input the IMAGE tag inside of the quotes as:
# <IMG SRC=\"image_url.gif\"> <-- Placing backslashes (\)
# before the extra quotes inside a quote.
###########################################################
$last_poll_text = "<LI>View our Previous Polls Results";
# Text that is linked to view the previous results of your
# previous poll.
$results_not_available = "<BR>The results will be posted soon...";
# Message shown when the number of votes is not greater then
# the ammount you opted for when setting up a poll.
$poll_not_available = "<BR>Currently there is no opinion poll
available...<P>Check back soon for another poll...";
# Message listed when a poll is not available.
#
#
#
# (We do not support this script if you edit below this line )
################################################################
#
#
%in = &ReadForm;
if ($0=~m#^(.*)(\\|/)#) { $cgidir = $1; }
else { $cgidir = `pwd`; chomp $cgidir; }
$script_url = $ENV{'SCRIPT_NAME'};
$data_dir = "$cgidir/pollit_files";
$poll_options = "$data_dir/poll_options.txt";
$last_poll_options = "$data_dir/last_poll_options.txt";
$poll_info = "$data_dir/poll_info.txt";
$last_poll_info = "$data_dir/last_poll_info.txt";
$ips_file = "$data_dir/ips.txt";
$last_file = "$data_dir/last_poll.txt";
$lockdir = "$data_dir/filelock";
# Administration Area:
###############################################################
if($admin_password eq "$entered_password") {
print "Content-Type: text/html\n\n";
# Add New Voting Option:
#########################################################
if($action eq "add_option" && $add_option) {
open(COPTIONS,"<$poll_options");
@coptions = <COPTIONS>;
close(COPTIONS);
$number_info = pop(@coptions);
@ninfo = split(/=/,$number_info);
$new_num = $ninfo[0] + 1;
open(COPTIONS2,">>$poll_options");
print COPTIONS2 "$new_num=$add_option=0\n";
close(COPTIONS2);
}
# Expire Poll & Remove Poll:
#########################################################
if($action eq "expire_poll") {
&last_poll;
&remove_poll;
}
# Delete Poll:
#########################################################
if($action eq "delete_poll") {
&remove_poll;
}
# New Poll Action:
######################################################
if($new_pollaction && $show_after && $new_title) {
if($new_pollaction eq "lastpoll") {
&last_poll;
}
&FileLock("$lockdir");
open(NEWOPTIONS,">$poll_options");
print NEWOPTIONS "total=0\n";
$ncount = 1;
foreach$new_option(@added_options) {
print NEWOPTIONS "$ncount=$new_option=0\n";
$ncount++;
}
close(NEWOPTIONS);
open(NEWINFO,">$poll_info");
print NEWINFO "poll_title=$new_title\n";
print NEWINFO "show_results_after=$show_after\n";
close(NEWINFO);
open(NEWIPS,">$ips_file");
print NEWIPS "";
close(NEWIPS);
&FileUnlock("$lockdir");
undef($action);
}
# Create New Poll:
#########################################################
if($action eq "create_new") {
# Create New Poll:
######################################################
&Template("$data_dir/_admin_create_poll.html");
$remove = join('|',@removes);
foreach$new_option(sort @added_options) {
if($new_option !~ /^$remove$/) {
$show_new_options .= &Cell('poll_options');
}
}
if($show_new_options) { $show_new_options .= "<P><font size=2
color=red>To remove an added option mark its checkbox <BR>next to it, then
press <INPUT Type=SUBMIT Value=\"OK\"> </font>" };
if(!$show_new_options) { $show_new_options = "<b><font color=red>No
NEW Options Currently...</font></b>" };
print &Template("$data_dir/_admin_create_poll.html");
exit;
}
# Show Main Menu:
#########################################################
else {
&Template("$data_dir/_admin_menu.html");
open(POLLINFO,"<$poll_info");
while(<POLLINFO>) {
chop($_);
($pinfo,$pvalue) = split(/=/,$_);
$$pinfo = "$pvalue";
}
close(POLLINFO);
open(POLLOPTIONS,"<$poll_options");
@unsorted_poll_options = <POLLOPTIONS>;
close(POLLOPTIONS);
foreach$unsorted(@unsorted_poll_options) {
($option_id,$poll_option,$votes_received) =
split(/=/,$unsorted);
chop($votes_recieved);
if($option_id eq "total") {
$total = $poll_option;
}
$push = "$votes_received\=$option_id\=$poll_option";
push(@poll_options,$push);
}
foreach$p_option(sort { $b <=> $a } @poll_options) {
($votes_received,$option_id,$poll_option) =
split(/=/,$p_option);
if($option_id ne "total" && $total > 0) {
$percent = (int(($votes_received / $total) * 1000)) / 10;
$percent = substr($percent,0,4);
$sign = "%";
if($votes_received < 1) {
$percent = "0";
}
$width = int($percent * 2);
if($votes_received < 1) {
$width = 2;
}
$percent = "$percent$sign";
$image_percent = "<IMG SRC=\"$image_url\" Height=\"10\"
Width=\"$width\">";
$show_results .= &Cell('poll_results');
}
}
if(!$show_results) { $show_results = "<b><font color=red>There are
currently no results for your current poll</font></b>" };
if(!$poll_title) { undef($show_results) };
print &Template("$data_dir/_admin_menu.html");
}
exit;
}
# Administration Login:
###############################################################
if($load =~ /login|admin/i || $entered_password && $entered_password ne
"$admin_password") {
print "Content-Type: text/html\n\n";
&Template("$data_dir/_admin_login.html");
print &Template("$data_dir/_admin_login.html");
exit;
}
# Show Last Poll Results:
###############################################################
if($load =~ /^lastpoll/i) {
print "Content-Type: text/html\n\n";
&Template("$data_dir/_last_poll.html");
open(POLLINFO,"<$last_poll_info");
while(<POLLINFO>) {
chop($_);
($pinfo,$pvalue) = split(/=/,$_);
$$pinfo = "$pvalue";
}
close(POLLINFO);
open(POLLOPTIONS,"<$last_poll_options");
@unsorted_poll_options = <POLLOPTIONS>;
close(POLLOPTIONS);
foreach$unsorted(@unsorted_poll_options) {
($option_id,$poll_option,$votes_received) = split(/=/,$unsorted);
chop($votes_recieved);
if($option_id eq "total") {
$total = $poll_option;
}
$push = "$votes_received\=$option_id\=$poll_option";
push(@last_poll_options,$push);
}
foreach$p_option(sort { $b <=> $a } @last_poll_options) {
($votes_received,$option_id,$poll_option) = split(/=/,$p_option);
if($option_id ne "total" && $total > 1) {
$percent = (int(($votes_received / $total) * 1000)) / 10;
$percent = substr($percent,0,4);
$sign = "%";
if($votes_received < 1) {
$percent = "0";
}
$width = int($percent * 2);
if($votes_received < 1) {
$width = 2;
}
$percent = "$percent$sign";
$image_percent = "<IMG SRC=\"$image_url\" Height=\"10\"
Width=\"$width\">";
$show_results .= &Cell('poll_results');
}
}
$show_results .= &Cell('total_votes');
print &Template("$data_dir/_last_poll.html");
exit;
}
# Show Poll:
###############################################################
if(!$ENV{'QUERY_STRING'}) {
open(IPS,"<$ips_file");
@ips = <IPS>;
close(IPS);
$all_ips = join('|',@ips);
$addr = "$ENV{'REMOTE_ADDR'}\n";
if(@ips && $addr =~ /$all_ips/) {
$voted = 1;
}
if($option_selected && !$voted) {
&FileLock("$lockdir");
open(MIPS,">>$ips_file");
print MIPS "$ENV{'REMOTE_ADDR'}\n";
close(MIPS);
&FileUnlock("$lockdir");
open(POPTIONS,"<$poll_options");
while(<POPTIONS>) {
($option_id,$poll_option,$votes_received) = split(/=/,$_);
if($option_id eq "total") {
$new_total = $poll_option + 1;
$push = "total=$new_total\n";
push(@reprint,$push);
}
else {
if($option_id eq "$option_selected") {
$new_ototal = $votes_received + 1;
$push = "$option_id\=$poll_option\=$new_ototal\n";
push(@reprint,$push);
}
else {
push(@reprint,$_);
}
}
}
close(POPTIONS);
&FileLock("$lockdir");
open(REPRINT,">$poll_options");
print REPRINT @reprint;
close(REPRINT);
&FileUnlock("$lockdir");
$voted = 1;
}
# Print Out Poll:
###############################################################
&Template("$data_dir/_poll.html");
open(POLLINFO,"<$poll_info");
while(<POLLINFO>) {
chop($_);
($pinfo,$pvalue) = split(/=/,$_);
$$pinfo = "$pvalue";
}
close(POLLINFO);
open(POLLOPTIONS,"<$poll_options");
@unsorted_poll_options = <POLLOPTIONS>;
close(POLLOPTIONS);
foreach$unsorted(@unsorted_poll_options) {
($option_id,$poll_option,$votes_received) = split(/=/,$unsorted);
chop($votes_recieved);
if($option_id eq "total") {
$total = $poll_option;
}
$push = "$votes_received\=$option_id\=$poll_option";
push(@poll_options,$push);
}
# Show Voting Results:
#####################################
if($voted) {
foreach$p_option(sort { $b <=> $a } @poll_options) {
($votes_received,$option_id,$poll_option) = split(/=/,$p_option);
if($option_id ne "total" && $total > 0) {
$percent = (int(($votes_received / $total) * 1000)) / 10;
$percent = substr($percent,0,4);
$sign = "%";
if($votes_received < 1) {
$percent = "0";
}
$width = int($percent * 2);
if($votes_received < 1) {
$width = 2;
}
$percent = "$percent$sign";
$image_percent = "<IMG SRC=\"$image_url\" Height=\"10\"
Width=\"$width\">";
$show_results .= &Cell('poll_results');
}
}
$show_results .= &Cell('total_votes');
if($show_results_after > $total) {
undef($show_results);
$show_results = "$results_not_available";
}
}
# Show Voting Options:
#####################################
if(!$voted) {
foreach$p_option(@poll_options) {
($votes_received,$option_id,$poll_option) = split(/=/,$p_option);
if($option_id ne "total") {
$display_options .= &Cell("show_options");
}
}
if(!$display_options) {
$display_options = "$poll_not_available" ;
$poll_title = "No Poll Currently Available...";
}
}
if($display_options) { $submit = " <BR> <INPUT Type=SUBMIT
Value=\"$vote_text\">" };
open(LASTPOLL,"<$last_poll_options");
@last_poll = <LASTPOLL>;
close(LASTPOLL);
if(@last_poll) {
$last_poll = "<A
HREF=\"$script_url?load=lastpoll\">$last_poll_text</A><BR>";
}
print &Template("$data_dir/_poll.html",'html');
}
# Send Poll to Last Poll: #
###############################################################
# Usage : &last_poll #
# #
###############################################################
sub last_poll {
open(CPOLLOPTIONS,"<$poll_options");
@cpoptions = <CPOLLOPTIONS>;
close(CPOLLOPTIONS);
open(CPOLLINFO,"<$poll_info");
@cpollinfo = <CPOLLINFO>;
close(CPOLLOINFO);
open(LASTPOLLOPTIONS,">$last_poll_options");
print LASTPOLLOPTIONS @cpoptions;
close(LASTPOLLOPTIONS);
$expired_date = localtime();
open(LASTPOLLINFO,">$last_poll_info");
print LASTPOLLINFO @cpollinfo;
print LASTPOLLINFO "expired=$expired_date\n";
close(LASTPOLLINFO);
}
# Remove Current Poll: #
###############################################################
# Usage : &remove_poll; #
# #
###############################################################
sub remove_poll {
open(POLL,">$poll_options");
print POLL "";
close(POLL);
open(INFO,">$poll_info");
print INFO "";
close(INFO);
open(IPS,">$ips_file");
print IPS "";
close(IPS);
}
# Load Template: #
###############################################################
sub Template {
local(*FILE);
if ($_[1] eq 'html') { print "Content-type: text/html\n\n" unless
($ContentType++ > 0); }
elsif ($_[1] eq 'text') { print "Content-type: text/plain\n\n" unless
($ContentType++ > 0); }
if (!$_[0]) { return "<br>\nTemplate : No file was specified<br>\n"; }
elsif (!-e "$_[0]") { return "<br>\nTemplate : File '$_[0]' does not
exist<br>\n"; }
else {
open(FILE, "<$_[0]") || return "<br>\nTemplate : Could open
$_[0]<br>\n";
while (<FILE>) { $FILE .= $_; }
close(FILE);
for ($FILE) {
s/<!-- insert : (.*?) -->/\1/gi; # show hidden inserts
s/<!-- def : (\w+) -->(?:\r\n|\n)?(.*?)<!-- \/def : \1 -->/
$CELL{$1}=$2;''/ges; # read/remove template cells
s/\$(\w+)\$/${$1}/g; # translate $scalars$
}
}
return $FILE;
}
# Translate Cell: #
###############################################################
sub Cell {
my($CELL);
for (0..$#_) { if ($_[$_]) { $CELL .= $CELL{$_[$_]}; }}
if (!$_[0]) { return "<br>\nCell : No cell was specified<br>\n"; }
elsif (!$CELL) { return "<br>\nCell : Cell '$_[0]' is not
defined<br>\n"; }
else { $CELL =~ s/\$(\w+)\$/${$1}/g; } # translate $scalars$
return $CELL;
}
# Parse Form: #
###############################################################
# Usage : %in = &ReadForm; #
# #
###############################################################
sub ReadForm {
my($max) = $_[1]; # Max Input Size
my($name,$value,$pair,@pairs,$buffer,%hash); # localize variables
# Check input size if max input size is defined
if ($max && ($ENV{'CONTENT_LENGTH'}||length $ENV{'QUERY_STRING'}) > $max)
{
die("ReadForm : Input exceeds max input limit of $max bytes\n");
}
# Read GET or POST form into $buffer
if ($ENV{'REQUEST_METHOD'} eq 'POST') { read(STDIN, $buffer,
$ENV{'CONTENT_LENGTH'}); }
elsif ($ENV{'REQUEST_METHOD'} eq 'GET') { $buffer =
$ENV{'QUERY_STRING'}; }
@pairs = split(/&/, $buffer); # Split into name/value pairs
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair); # split into $name and $value
$value =~ tr/+/ /; # replace "+" with " "
$value =~ s/%([A-F0-9]{2})/pack("C", hex($1))/egi; # replace %hex with
char
if($name eq "add_option" && $value) {
push(@added_options,$value);
}
if($name eq "remove_new") {
push(@removes,$value);
}
if($name ne "admin_password") {
$$name = $value;
}
}
return %hash;
}
# File Locking: #
###############################################################
# Usage : &FileLock("$lockdir"); #
# : &FileUnlock("$lockdir"); #
# #
###############################################################
sub FileLock {
my($i); # sleep counter
while (!mkdir($_[0],0777)) { # if there already is a lock
sleep 1; # sleep for 1 sec and try again
if (++$i>60) { die("File_Lock : Can't create filelock : $!\n"); }
}
}
sub FileUnlock {
rmdir($_[0]); # remove file lock dir
}
####################################################################
--
Med vennlig Hilsen
Kjell Olav
E-mail kos2000@online.no
------------------------------
Date: Tue, 28 Nov 2000 14:28:06 -0500
From: tadmc@metronet.com (Tad McClellan)
Subject: Re: Poll it
Message-Id: <slrn9281q6.12l.tadmc@magna.metronet.com>
Kos <kseterba@chello.no> wrote:
>I am using Pollit
Send mail to jason@cgi-world.com then.
[ snip *1100* lines of code! ]
--
Tad McClellan SGML consulting
tadmc@metronet.com Perl programming
Fort Worth, Texas
------------------------------
Date: Tue, 28 Nov 2000 22:17:02 GMT
From: mgjv@tradingpost.com.au (Martien Verbruggen)
Subject: Re: Poll it
Message-Id: <slrn928bjd.br5.mgjv@verbruggen.comdyn.com.au>
On Tue, 28 Nov 2000 19:18:15 GMT,
Kos <kseterba@chello.no> wrote:
> I am using Pollit but i want to diable ip logging. I tryed but then after
> voting the results wont show. So is there eny way i can diable this.
Please do not post hundreds of lines of code (twice) with the request
for us to 'adapt' your program. If you need changes, and you can't do
it yourself, hire someone. Otherwise, be prepared to learn Perl.
> # Contact: | jason@cgi-world.com #
What about sending an email to jason@cgi-world.com? The following
line:
> # (We do not support this script if you edit below this line )
suggests that they do support the program. Unless you've already
changed stuff.
Martien
--
Martien Verbruggen |
Interactive Media Division | I took an IQ test and the results
Commercial Dynamics Pty. Ltd. | were negative.
NSW, Australia |
------------------------------
Date: Tue, 28 Nov 2000 21:34:02 GMT
From: Bart Lateur <bart.lateur@skynet.be>
Subject: Re: Reading a csv file
Message-Id: <i3982t05u9jma1s7579mo48mihqm7iv9cr@4ax.com>
Jeff Zucker wrote:
>Joking or not, you are incorrect that there is "nothing you can do about
>it" -- at a minimum, you can wrap the call to Text::CSV_XS->parse() in
>an eval and handle lines it barfs on any way you want.
If I have to handle lines this module rejects anyway, I can handle all
lines myself. It will be slower, since it's not compiled C, but the time
I spend on figuring all exceptions it doesn't like, is a lot more than
the time it will *ever* take to run in all of its life.
An example of a field it doesn't like:
17" monitor
--
Bart.
------------------------------
Date: Tue, 28 Nov 2000 22:48:19 GMT
From: mgjv@tradingpost.com.au (Martien Verbruggen)
Subject: Re: Reading a csv file
Message-Id: <slrn928de2.br5.mgjv@verbruggen.comdyn.com.au>
On 28 Nov 2000 13:04:04 -0500,
David Wall <darkon@one.net> wrote:
> bart.lateur@skynet.be (Bart Lateur) wrote in
><6r572tcm3ip7kr079lqifuncb1oq7mmutu@4ax.com>:
>
>>David Wall wrote:
>>
>>>He'd probably be better off using Text:CSV_XS to parse the CSV file,
>>>unless he knows ahead of time that this code will work.
>>
>>Oh yeah?
>>
>>If Text::CSV_XS rejects your input, there's nothing you can do about it.
>>It happens.
>>
>>At least, with your own parsing code in Perl, you can *make it work*.
>>
>>(Only half joking)
>
> A good point. Ok, how about using Text::ParseWords? :-) I
Maybe. But I don't think that Bart was talking about what you suggest
below. Text::CSV_XS is limited to a very narrow character set, as
documented, and many people need to work with larger character sets
than that [1]. It does however accept only valid CSV syntax (which is
reasonable), and you deliberately created invalid CSV:
> 7-Nov-2000,Yes,"Smith, John","Doe, John","Doe, Jane"
This one's fine.
> 7-Nov-2000, Yes, "Smith, John", "Doe, John", "Doe, Jane"
Those spaces shouldn't be there.
> 12-Dec-2000, "No", "Smith, John", "Doofus, James "Billy"", "Doe, Jane"
Quotes within quotes need to be doubled.
The spaces shouldn't be there.
> 12-Dec-2000, "No", "Smith, John", "Doofus, James 'Billy'", "Doe, Jane"
The spaces shouldn't be there.
If you fix the spaces, you only have one wrong line, and that's your
fault, not the parser's. What you have written doesn't parse CSV, it
parses some other format.
You can't honestly expect any CSV parser to allow invalid syntax. CSV
is a defined file format. You can't just make something up that has
commas, call it CSV, and then expect CSV_XS to parse it.
Martien
[1] Switching to binary mode helps.
--
Martien Verbruggen |
Interactive Media Division | +++ Out of Cheese Error +++ Reinstall
Commercial Dynamics Pty. Ltd. | Universe and Reboot +++
NSW, Australia |
------------------------------
Date: Tue, 28 Nov 2000 21:50:48 GMT
From: snakedjip@yahoo.com
Subject: Recursively load all objects in an HTML page...
Message-Id: <9019bm$gkk$1@nnrp1.deja.com>
Hi,
With LWP::UserAgent, one can POST or GET a URL, and obtain in its
response the source to an HTML document...
A browser (like IE or Netscape) would then start downloading all of the
elements of that web page. For example, if a web page contains "<IMG
SRC=...>" tags, or "<SCRIPT SRC=...>" tags, the browser would download
the contents of those files, and embed them in the final document. Of
course, if any of these "sub-documents" contains other "SRC=" tags, the
browser will load them recursively...
I want to reproduce this behaviour in Perl.
The first solution that comes to mind is to parse the document
for "SRC=<document>", and load the contents of this <document> with
another LWP call, and do that recursively...
Is there an easier way ?
What packages do you suggest I use ?
Is there some sample code that already does this that I'm not aware of ?
Thanks for your time.
Sent via Deja.com http://www.deja.com/
Before you buy.
------------------------------
Date: Tue, 28 Nov 2000 16:21:33 -0500
From: "Ryan Buterbaugh" <webmaster@duckpaw.com>
Subject: Re: Session tracking!
Message-Id: <3a242223@news.nauticom.net>
ah, the great challenge of web engineering, stated in a paragraph ;-)
it all depends. a session ID can effectively be accomplished by using just
the IP address, since most users do all of their surfing in one session
(they dont surf, sign off/on, then surf at the same site again, at least,
not on purpose). so if your just looking for a per-session ID for each user
that comes, an IP address is fine.
however, if you want it to carry over from session to session, so you can
say that "this person was here before", you enter one of the biggest
dilemmas. thats why cookies were invented. realize, that if everyone had
static IP addresses, there would be no need for cookies at all. but since
we have dynamic IP addresses, and at least half of all internet users have
one (more like 2/3 probably, since most people at this point dial up for
internet access), you are in trouble. user agent doesnt mean much, since a
ton of users use the same browser (there are only a few primary browsers out
there...). you probably have to use a combination of cookies and the IP
address or subnet mask. however, there will inevitably be some users that
avoid all tracking, which you cant do anything about. and then there are
sites like www.anonymizer.com, which, although great for users, are annoying
as hell for web programmers, since everyone is coming from one site.
best idea, create a service that people will WANT to sign up for (its easy,
useful, etc, and another great web challenge), so you have a unique user
ID/email address/nickname to track all users with.
regardless, good luck, you'll need it
--
Ryan Buterbaugh
webmaster@duckpaw.com
Resources for the serious webmaster
www.duckpaw.com
"Neb" <berube@odyssee.net> wrote in message
news:qrRU5.266$s8.20852@news.globetrotter.net...
> Hi,
>
> I'm wondering, is there a way to create a unique session ID for people
> visiting my web site using some of the ENV variables ? I do not want to
> store the ID on the client using a cookie. I want that everytime the
client
> access a WEB page, I can find the ID using the information of the client,
> like something like the IP address, the browser name and version, etc.
>
> Is there a combo of many ENV variables that will create a unique session ?
>
> Thank you,
>
> neb
>
>
>
>
------------------------------
Date: Tue, 28 Nov 2000 22:12:32 GMT
From: mgjv@tradingpost.com.au (Martien Verbruggen)
Subject: Re: Session tracking!
Message-Id: <slrn928bb0.br5.mgjv@verbruggen.comdyn.com.au>
[In the future, please put your reply _after_ the suitably trimmed
text you reply to. It's the commonly accepted posting style here, and
on Usenet in general. It makes it much easier to follow the thread.]
On Tue, 28 Nov 2000 16:21:33 -0500,
Ryan Buterbaugh <webmaster@duckpaw.com> wrote:
[re-ordered post]
> "Neb" <berube@odyssee.net> wrote in message
> news:qrRU5.266$s8.20852@news.globetrotter.net...
>> Hi,
>>
>> I'm wondering, is there a way to create a unique session ID for
>> people visiting my web site using some of the ENV variables ? I do
>> not want to store the ID on the client using a cookie. I want that
>> everytime the client access a WEB page, I can find the ID using the
>> information of the client, like something like the IP address, the
>> browser name and version, etc.
>
> ah, the great challenge of web engineering, stated in a paragraph
> ;-) it all depends. a session ID can effectively be accomplished by
> using just the IP address, since most users do all of their surfing
> in one session
Oh? What about web proxies? And what about those clients that do have
an IP address that changes? Leaving aside the intricacies of dynamic
IP allocation, what about people losing their modem connection, and
who proceed browsing your site after reconnecting?
> (they dont surf, sign off/on, then surf at the same site again, at
> least, not on purpose). so if your just looking for a per-session
> ID for each user that comes, an IP address is fine.
Whether they do it on purpose or not is not the issue.
> however, if you want it to carry over from session to session, so you can
Even without the 'carry over' your first solution doesn't work for
about half or more of the people out there, simply because of proxies.
> say that "this person was here before", you enter one of the biggest
> dilemmas. thats why cookies were invented. realize, that if
> everyone had static IP addresses, there would be no need for cookies
> at all.
Cookies solve much more than the 'problem' of dynamic IP addresses.
They don't solve everything, though. The problem that really needs to
be solved is that people should stop thinking about IP addresses as if
they mean anything more than an address at a low level where you have
no business looking when you're programming for the Web.
I really see no Perl content here, so followups have been set.
Take this discussion to another group that talks about this stuff.
Please refrain from giving advice on non-Perl topics here, especially
if it's bad advice, because people will feel the need to correct you,
lengthening the offtopic thread even more.
Thank you
Martien
--
Martien Verbruggen |
Interactive Media Division | Unix is the answer, but only if you
Commercial Dynamics Pty. Ltd. | phrase the question very carefully
NSW, Australia |
------------------------------
Date: Tue, 28 Nov 2000 22:43:53 GMT
From: Bart Lateur <bart.lateur@skynet.be>
Subject: Re: Session tracking!
Message-Id: <d7c82t8q1mf465tar1pu1qbdj8bu6aup42@4ax.com>
Neb wrote:
>I'm wondering, is there a way to create a unique session ID for people
>visiting my web site using some of the ENV variables ?
Experiment with adding extra stuff following a slash in your URL. See
$ENV{PATH_INFO} for getting at it. You can check out, huh,
<http://web.stonehenge.com/merlyn/WebTechniques/col18.html> for an
example.
--
Bart.
------------------------------
Date: 16 Sep 99 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 16 Sep 99)
Message-Id: <null>
Administrivia:
The Perl-Users Digest is a retransmission of the USENET newsgroup
comp.lang.perl.misc. For subscription or unsubscription requests, send
the single line:
subscribe perl-users
or:
unsubscribe perl-users
to almanac@ruby.oce.orst.edu.
| NOTE: The mail to news gateway, and thus the ability to submit articles
| through this service to the newsgroup, has been removed. I do not have
| time to individually vet each article to make sure that someone isn't
| abusing the service, and I no longer have any desire to waste my time
| dealing with the campus admins when some fool complains to them about an
| article that has come through the gateway instead of complaining
| to the source.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
To request back copies (available for a week or so), send your request
to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
where x is the volume number and y is the issue number.
For other requests pertaining to the digest, send mail to
perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
sending perl questions to the -request address, I don't have time to
answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V9 Issue 4982
**************************************
