in reply to How do a make an IP look up non-greedy?

I'm NOT trying to berate you. But I would like to know:
1) what $LOG_FILE has in it.
2) the current environment vars
3) what do you want for output?

It would be very helpful if you could show some lines of input and some lines of output.

  • Comment on Re: How do a make an IP look up non-greedy?

Replies are listed 'Best First'.
Re^2: How do a make an IP look up non-greedy?
by kjg (Sexton) on Jun 16, 2009 at 10:40 UTC
    Thank-you! Input is Snippet of the logfile: 
    10.30.147.23    2009-06-15    09:04:47    1245053087    Help for Hospi
+ces    no-email    no-comment
192.9.200.49    2009-06-15    09:04:50    1245053090    Alzheimer's So
+ciety/Alzheimer Scotland    no-email    no-comment
10.30.117.36    2009-06-15    09:04:50    1245053090    Help for Hospi
+ces    no-email    no-comment
10.30.135.9    2009-06-15    09:04:50    1245053090    NSPCC Childline
+    no-email    no-comment
10.30.198.18    2009-06-15    09:04:59    1245053099    Help for Hospi
+ces    no-email    no-comment

    [download]

    Current evironment vars? Give me a clue please...... :blush: Tell you what - this is the entire script - this subrouteine is wrapped in a time-lock cookie just to complicate matters! 

    #!/usr/bin/perl

 
# Additional security patch added 12-30-2000 in decode
# subroutine.
#
# Added option to block multiple vote attempts using IP
# address. Additional security mods. (02-10-2002)

# Modified IP based multi-vote blocking to allow time based
# blocking as well. (02-16-2002)

# IMPORTANT: This changed the format of the log file. There
# is now a integer number representing the vote time located
# between the human readable date and the first vote response
# field.
#
#------------SCRIPT CONFIGURATION SECTION--------------------

# The script can be called in this manner to provide view without
# voting:

# http://domain.com/cgi-bin/survey/survey.cgi?survey_name=number1


# $DATA_PATH is the FULL system path to the directory where
# your survey data files are stored. Your web server must have
# permission to write to and create files in this directory

  $DATA_PATH= "e:/inetpub/wwwybs/ybsone/cgi-bin/survey/";

# The $DOMAIN must be your site's domain name. 

  $DOMAIN="wwwybs.ybs.com/ybsone";

# $GRAPHICSDIR is the directory under your main html directory
# containing the colored gif files.

  $GRAPHICSDIR="survey";
 
# To prevent people from voting too often, set $USE_COOKIES=1
# HOURS is the NUMBER OF HOURS before the voter can vote
# again. 1 Day=24, 1 Week=168, 1 Month=720 give or take....
# To disable cookies, let $USE_COOKIES=0
#
# WARNING: DO NOT ENABLE COOKIES UNTIL YOU ARE SURE EVERYTHING
# IS WORKING PERFECTLY, OR YOUR DEBUGGING CAN BE SERIOUSLY
# SLOWED DOWN WHILE YOU WAIT FOR THE COOKIE TO EXPIRE. ;-) 

  $USE_COOKIES=1;
  $HOURS=0; # one hour delay between votes

# Set $USE_LOGGING to 1 to turn on log file capture.
# Log format is an ASCII tab delimited file consisting of:
# Visitor's IP address, date, time, responses, e-mail, comments
# Can be easily imported into spreadsheets and databases

  $USE_LOGGING=1;

# If you USE_LOGGING, you can also block multiple votes from
# the same IP address. Just set $BLOCK_IP=1
# If $HOURS (from above) is set to zero, a voter from an IP
# address can only vote once. You can set a minimum time
# between votes by setting $HOURS=1  (as an example) to allow
# a voter from an IP address to vote every hour.

$BLOCK_IP=1;

# IF $SHOW_RESULTS=0 (do not display after voting), be sure
# to set $JUMP_URL to the page the voter should be sent to.
# By default, it sends the voter back to the page they came from.
# When used with SHOW_RESULTS=1, this is the link they can click
# on after viewing the voting.

  $SHOW_RESULTS=1;
  $JUMP_URL="http://wwwybs.ybs.com/ybsone/index.htm";

# These are the cosmetic settings in case you do not like my
# terrible taste in colors! The actual result page layout can
# be found near the bottom of the script.

  $TABLECOLOR="#FFFFFF";
  $HEADINGCOLOR="#FFFFFF";
  $HEADINGFONT="arial,helvetica";
  $BORDERCOLOR="#000080";
  $FONT="arial,helvetica";
  $FONTCOLOR="#000000";

# the script starts for real here....

  &decode_vars;
  &check_files;

  if ($ENV{'REQUEST_METHOD'} eq "POST" && -e $DATA_FILE && -w $DATA_FI
+LE){
   if ($BLOCK_IP == 1 && $USE_LOGGING == 1 && &is_blocked == 1 ){
      &already_voted;
      exit;
   }
   if ($USE_COOKIES == 1){
     $COOKIEVAL=&get_cookie($SURVEY_NAME);
     if (  $COOKIEVAL > time){
      &already_voted;
      exit;
     }
     else{
      $cookie=&set_cookie($SURVEY_NAME,(time + ($HOURS * 3600)),$HOURS
+);
      print "$cookie\n";
     }
   }
   $MODE="VOTE";
   &set_colors;
   &process_file;
   &do_stats;
   if ($SHOW_RESULTS == 1){
     print "Content-type: text/html\n\n";
     $PAGEHEADER=&set_page_header;
     $PAGEFOOTER=&set_page_footer;
     print "$PAGEHEADER\n";
     &display_stats;
     print "$PAGEFOOTER\n";
   }
    else{
      print "Location: $JUMP_URL\n\n";
    }
   exit;
  }

  if ($ENV{'REQUEST_METHOD'} eq "GET" && -e $DATA_FILE){
   $MODE="VIEW";
   &set_colors;
   &process_file;
   &do_stats;
   $PAGEHEADER=&set_page_header;
   $PAGEFOOTER=&set_page_footer;
   print "Content-type: text/html\n\n";
   print "$PAGEHEADER\n";
   &display_stats;
   print "$PAGEFOOTER\n";
   exit;
  }

sub do_stats{
  $oldtag="NONE";
  @groups=();
  foreach $toshow (@list){
   @tags=split(/\|/,$toshow);
   if ($tags[0] ne $oldtag){
     $group=$tags[0];
     push(@groups,$group);
     $total{$group}=0;
     $oldtag = $tags[0];
   }
   $total{$group} = $total{$group} + $questions{$toshow};
  }
}

sub display_stats{
  $oldgroup="NONE";
  $itemcount=0;
  foreach $toshow (@list){
   @tags=split(/\|/,$toshow);
   if ($tags[0] ne $oldgroup){
     if ($oldgroup ne "NONE"){
        $GROUPFOOTER=&set_footer($total{$group});
        print "$GROUPFOOTER\n";
     }
     $group=$tags[0];
     $GROUPHEAD=&set_group_header($title{$group});
     print "$GROUPHEAD\n";
     $oldgroup=$group;
     $itemcount=0;
   }
   if ($total{$group} > 0){
     $pct=int((($questions{$toshow} / $total{$group}  * 100)+.5)) ;
   }
    else{
      $pct=0;
    }
   @qi=split(/\|/,$toshow);
   $giffile=@colors[$itemcount];
   $RESPONSELINE=&set_question($qi[1],$questions{$toshow},$pct, $giffi
+le);
   print "$RESPONSELINE\n";
   $itemcount = $itemcount + 1;
  }
  $GROUPFOOTER=&set_footer($total{$group});
  print "$GROUPFOOTER\n";
}

sub process_file {
  &get_the_lock;
  if ($USE_LOGGING == 1 && $MODE eq "VOTE"){
    $SYSTIME=&sys_date;
    $SYSINT=time;
    $LOG_LINE="$ENV{'REMOTE_ADDR'}\t$SYSTIME\t$SYSINT\t";
    open(LO,">>$LOG_FILE");
  }
  open(IX,"<$DATA_FILE");
  while ($line=<IX>){
    @loga=();
    chop $line;
    @parts=split(/:/,$line);
    $q=$parts[0];
    $n=$parts[1];
    $t=$parts[2];
    @tags=split(/\|/,$line);
    $ti=$tags[0];
    $title{$ti} = $t;
    $titles{$q} = $t;
    if ($fields{$ti} eq $q){ 
     $questions{$q} = $n + 1; 
     @loga=split(/\|/,$q);
     if ($USE_LOGGING == 1 && $MODE eq "VOTE"){$LOG_LINE .= "$loga[1]\
+t";}
    }
      else{ $questions{$q} = $n; }
    push(@list,$q);
  }
  close(IX);
  if ($MODE eq "VOTE"){
    open(IY,">$DATA_FILE");
    foreach $toshow (@list){
      print IY "$toshow:$questions{$toshow}:$titles{$toshow}:\n";
    }
    close(IY);
  }
  if ($USE_LOGGING == 1 && $MODE eq "VOTE"){
    if ($fields{'email'} eq ""){$fields{'email'}="no-email";}
    if ($fields{'comments'} eq ""){$fields{'comments'}="no-comment";}
    $LOG_LINE .= "$fields{'email'}\t$fields{'comments'}";
    print LO "$LOG_LINE\n";
    close(LO);
  }
  &drop_the_lock;
}

sub set_colors{
#this allows for up to 22 responses per question. if you have more, ju
+st 
#continue duplicating the middle two lines of the array below...

  @colors=("blue.gif","red.gif","green.gif","yellow.gif","cherry.gif",
           "navy.gif","pink.gif","black.gif","teal.gif","purple.gif","
+sky.gif",
           "blue.gif","red.gif","green.gif","yellow.gif","cherry.gif",
           "navy.gif","pink.gif","black.gif","teal.gif","purple.gif","
+sky.gif");
}

sub decode_vars
 {
 $i=0;
  if ( $ENV{'REQUEST_METHOD'} eq "GET")
   {
     $temp=$ENV{'QUERY_STRING'};
   }
   else
    {
      read(STDIN,$temp,$ENV{'CONTENT_LENGTH'});
    }
  @pairs=split(/&/,$temp);
  foreach $item(@pairs)
   {
    ($key,$content)=split(/=/,$item,2);
    $content=~tr/+/ /;
    $content=~s/%(..)/pack("c",hex($1))/ge;
    $content=~s/\0//g;
    $key=~s/\0//g;
    $content=~s/\012//gs;
    $content=~s/\015/ /gs;
    $fields{$key}=$content;
   }
  if ($fields{'survey_name'}=~/^([-\@\w.]+)$/){
    $SURVEY_NAME=$fields{'survey_name'};
  }
  else {exit;}
  $fields{'comments'}=~s/\t/ /g;
  $fields{'email'}=&valid_address($fields{'email'});
}

sub valid_address
 {
 my ($testmail) = @_;
  if ($testmail =~/ /)
   { return ""; }
  if ($testmail =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/ ||
  $testmail !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,4}|[0-9]{1,3})
+(\]?)$/)
   { return ""; }
   else { return $testmail; }
}

sub get_the_lock
{
  if ($MODE ne "VOTE"){return;}
  my $lockfile="$DATA_PATH/$SURVEY_NAME\.lkk";
  local ($endtime);
  $endtime = 40;
  $endtime = time + $endtime;
  while (-e $lockfile && time < $endtime)
   {
    # Do Nothing
   }
   open(LOCK_FILE, ">$lockfile");
}

sub drop_the_lock
{
  if ($MODE ne "VOTE"){return;}
  $lockfile="$DATA_PATH/$SURVEY_NAME\.lkk";
  close(LOCK_FILE);
  unlink($lockfile);
}

sub already_voted{
 print "Content-type: text/html\n\n";
 print<<__END_ALREADY_VOTED__;
 <h2 align=center><FONT FACE="$FONT" COLOR="$FONTCOLOR" size="3">You'v
+e Already Voted for your 2009 Xmas Charity Choice</h2>
 <BR><A HREF="$JUMP_URL"><B>Back to Intranet Home Page</B>

__END_ALREADY_VOTED__
}


#
# This routine takes (name,value,hours,path,domain) as arguments
# to set a cookie.
#
# 0 hours means a current browser session cookie life
#
sub set_cookie() {

  my ($name,$value,$expires) = @_;
  $name=&cookie_scrub($name);
  $value=&cookie_scrub($value);

  $expires=$expires * 3600;
  $expires=int($expires);

  my $expire_at=&cookie_date($expires);
  my $namevalue="$name=$value";

  my $COOKIE="";

  if ($expires != 0) {
     $COOKIE= "Set-Cookie: $namevalue; path=$path; expires=$expire_at;
+ ";
  }
   else {
     $COOKIE= "Set-Cookie: $namevalue; ";   #current session cookie if
+ 0
   }
  return $COOKIE;
}

#
# This routine removes cookie of (name) by setting the expiration
# to a date/time GMT of (now - 24hours)
#
sub remove_cookie() {
  my ($name) = @_;
  $name=&cookie_scrub($name);
  my $value="";
  my $cookie="";
  my $expires=&cookie_date(-86400);
  my $namevalue="$name=$value";
  my $COOKIE= "Set-Cookie: $namevalue; expires=$expires; ";
  return $COOKIE;
}


#
# given a cookie name, this routine returns the value component
# of the name=value pair
# a returned value of 0 means no cookie
#
sub get_cookie() {
  my ($name) = @_;
  $name=&cookie_scrub($name);
  my $temp=$ENV{'HTTP_COOKIE'};
  @pairs=split(/\; /,$temp);
  foreach my $sets (@pairs) {
    my ($key,$value)=split(/=/,$sets);
    $clist{$key} = $value;
  }
  if ($clist{$name} eq "") {$clist{$name}="0";}
  my $retval=$clist{$name};
  return $retval;
}

#
# this routine accepts the number of seconds to add to the server
# time to calculate the expiration string for the cookie. Cookie
# time is ALWAYS GMT!
#
sub cookie_date() {
  my ($seconds) = @_;
  my %mn = ('Jan','01', 'Feb','02', 'Mar','03', 'Apr','04',
            'May','05', 'Jun','06', 'Jul','07', 'Aug','08',
            'Sep','09', 'Oct','10', 'Nov','11', 'Dec','12' );
  my $sydate=gmtime(time+$seconds);
  my ($day, $month, $num, $time, $year) = split(/\s+/,$sydate);
  my    $zl=length($num);
  if ($zl == 1) { 
    $num = "0$num";
  }
  my $retdate="$day $num-$month-$year $time GMT";
  return $retdate;
}


#
# don't allow = or ; as valid elements of name or data
#
sub cookie_scrub() {
  my($retval) = @_;
  $retval=~s/\;//g;
  $retval=~s/\=//g;
  return $retval;
}

#
# check to see if the IP of this client has been logged.
# if so, return 1 to indicate client should be blocked.
# only called if $USE_LOGGING and $BLOCK_IP are set to 1.
# added 02/10/2002
#
# Modified on 02/16/2002 so that if $HOURS are not equal
# to 0, you can control the time between votes based on
# IP address the same way as with cookies.
#

sub is_blocked{
 my $current_time=time;
 my @solog=();
 open(OLOGS,"<$LOG_FILE");
 my @logs=<OLOGS>;
 close(OLOGS);
 my $lcounter=@logs;
 for ($lcounter; $lcounter >= 0; $lcounter--){
   if (-1 > index $logs[$lcounter], $ENV{'REMOTE_ADDR'} ){
  # if ( $logs[$lcounter]=~/^$ENV{'REMOTE_ADDR'}/){
     if ($HOURS == 0){
       return 1;
     }
     @solog=split(/\t/,@logs[$lcounter]);
     if ( ($solog[3] + ($HOURS * 3600)) > $current_time ){
       return 1;
     }
   }
 }
 return 0;
}


sub sys_date{
 my %mn = ('Jan','01', 'Feb','02', 'Mar','03', 'Apr','04',
        'May','05', 'Jun','06', 'Jul','07', 'Aug','08',
        'Sep','09', 'Oct','10', 'Nov','11', 'Dec','12' );
 my $sydate=localtime(time);
 my ($day, $month, $num, $time, $year) = split(/\s+/,$sydate);
 my $zl=length($num);
    if ($zl == 1) { $num = "0$num";}
 my $retval="$year\-$mn{$month}\-$num\t$time";
 return $retval;
}

sub check_files{
  $DATA_FILE="$DATA_PATH/$SURVEY_NAME\.srv";
  $LOG_FILE="$DATA_PATH/$SURVEY_NAME\.log";
  if ( !-e $DATA_FILE){
   print "Content-type: text/html\n\n Data File is Missing!\n";
   exit;
  }
  if ( !-w $DATA_FILE){
   print "Content-type: text/html\n\n Data File Cannot be Written to!\
+n";
   exit;
  }
  if ( !-e "$LOG_FILE" && $USE_LOGGING == 1){
   open(OP,">>$LOG_FILE");
   close(OP);
  }
  if ( !-w "$DATA_PATH/$SURVEY_NAME\.log" && $USE_LOGGING == 1){
   print "Content-type: text/html\n\n Log File Cannot be Written to!\n
+";
   exit;
  }
}

######################## COSMETIC SECTION ##########################
#
# The following subroutines contain the HTML text (and some logic
# so be careful editing!) that is presented when viewing the survey
# results.
#

sub set_page_header{
 my $PAGEHEAD=<<__END_PAGE_HEAD__;
 
 <BODY BGCOLOR="#FFFFFF">
 <CENTER>
 <TABLE BORDER=0 BGCOLOR="$BORDERCOLOR" WIDTH="100%">
  <TR>
  <TD ALIGN=CENTER>
 <TABLE BORDER=0 BGCOLOR="$TABLECOLOR" WIDTH="100%">
  <TR>
  <TD COLSPAN=4>
  <CENTER>
  <FONT FACE="$HEADINGFONT" COLOR="#000080">
   <FONT SIZE=5>2009 Xmas Charity Poll</FONT>
  </FONT>
  <CENTER>
 </TR>
__END_PAGE_HEAD__
 return $PAGEHEAD;
}
#below can be added back in to line 509 if ever desired
#  <CENTER>
#  <FONT FACE="$HEADINGFONT" COLOR="$HEADINGCOLOR">
#   <FONT SIZE=5>BigNoseBird Survey Script</FONT>
#  <BR>
#  <FONT FACE="$FONT" COLOR="$FONTCOLOR">
#   <B>Click</B>
#  <A HREF="http://bignosebird.com/carchive/survey.shtml"><B>HERE</B><
+/A>
#  <B>to Download!</B>
#  </FONT>
#  <CENTER>
#  <P>

sub set_group_header{
 my ($GROUP_HEADING)=@_;
 my $GROUP_HEADER=<<__END_GROUP_HEADER__;

 <TR>
 <TD COLSPAN=4 ALIGN=LEFT bgcolor="#000080">
  <FONT FACE="$HEADINGFONT" COLOR="$HEADINGCOLOR"><B>$GROUP_HEADING</B
+></FONT>
 </TD>
 </TR> 
 <TR>
  <TD WIDTH="60%"><FONT FACE="$FONT" COLOR="$FONTCOLOR" size="2"><b>Re
+sponse</b></TD>
  <TD WIDTH="10%" ALIGN=RIGHT><FONT FACE="$FONT" COLOR="$FONTCOLOR" si
+ze="2"><b>Number</b></TD>
  <TD WIDTH="10%" ALIGN=RIGHT><FONT FACE="$FONT" COLOR="$FONTCOLOR" si
+ze="2"><b>Percent</b></TD>
  <TD WIDTH="20%"><FONT FACE="$FONT" COLOR="$FONTCOLOR" size="2"><b>Gr
+aph</b></TD>
 </TR>

__END_GROUP_HEADER__
return $GROUP_HEADER;
}

sub set_question{
 my ($respitem,$count,$pct,$giffile) = @_;
 my $factor = $pct * 2.50;
 my $SCALE=int($factor);
 my $RESPONSE=<<__END_RESPONSE_LINE__;

<TR>
  <TD VALIGN=TOP><FONT FACE="$FONT" COLOR="$FONTCOLOR"><small>$respite
+m</small></FONT></TD>
  <TD VALIGN=TOP ALIGN=RIGHT><FONT FACE="$FONT" COLOR="$FONTCOLOR"><sm
+all>$count</small></FONT></TD>
  <TD VALIGN=TOP ALIGN=RIGHT><FONT FACE="$FONT" COLOR="$FONTCOLOR"><sm
+all>$pct\%</small></FONT></TD>
  <TD><IMG SRC="http://$DOMAIN/$GRAPHICSDIR/$giffile" HEIGHT=5 WIDTH=$
+SCALE BORDER=0></TD>
</TR>

__END_RESPONSE_LINE__
 return $RESPONSE;
}

sub set_footer{
 my ($tot) = @_;
 my $FOOTGROUP=<<__END_GROUP_FOOTER__;

 <TR>
 <TD COLSPAN=4 ALIGN=RIGHT><FONT FACE="$FONT" COLOR="$FONTCOLOR"><smal
+l>Total Number of Responses: $tot</small><br></FONT></TD>
 </TR>

__END_GROUP_FOOTER__
return $FOOTGROUP;
}

sub set_page_footer{
my $PAGEFOOT=<<__END_PAGE_FOOT__;
 </TD>
 </TR>
 <TR>
 <TD COLSPAN=4 ALIGN=CENTER>
  <FONT FACE="$FONT" COLOR="#000080" size="2">The top 3 chosen will be
+ asked to present to the Trustees and the decision will be announced 
+as soon as possible<br>
  <A HREF="$JUMP_URL"><B>Back to Intranet Home Page</B>
  </FONT>
 </TD>
 </TR>
</TABLE>
 </TD>
 </TR>
</TABLE>
</CENTER>
__END_PAGE_FOOT__
 return $PAGEFOOT;
}

    [download]
    Never knowingly obfuscated
[reply]
[d/l]
[select]
      Here is an idea...
      This gets the first 4 space separated things and the 5th thing is left all together. Parsing that last thing will be the most difficult.

      #!usr/bin/perl -w
use strict;

while ( my $line =(<DATA>) )
{

  my @tokens = my ($ip,$date,$time,$number,$text)= 
     $line =~ m/^(\S+)\s*(\S+)\s*(\S+)\s*(\S+)\s*(.*)$/;
  print "Line =\t$line";
  foreach my $token (@tokens)
  {
     print "\t$token\n";
  }
}
###########   Output  ###################
#Line =    10.30.147.23    2009-06-15    09:04:47    1245053087    Hel
+p for Hospices    no-email    no-comment
#    10.30.147.23
#    2009-06-15
#    09:04:47
#    1245053087
#    Help for Hospices    no-email    no-comment
#Line =    192.9.200.49    2009-06-15    09:04:50    1245053090    Alz
+heimer's Society/Alzheimer Scotland    no-email    no-comment
#    192.9.200.49
#    2009-06-15
#    09:04:50
#    1245053090
#    Alzheimer's Society/Alzheimer Scotland    no-email    no-comment
#Line =    10.30.117.36    2009-06-15    09:04:50    1245053090    Hel
+p for Hospices    no-email    no-comment
#    10.30.117.36
#    2009-06-15
#    09:04:50
#    1245053090
#    Help for Hospices    no-email    no-comment
#Line =    10.30.135.9    2009-06-15    09:04:50    1245053090    NSPC
+C Childline    no-email    no-comment
#       10.30.135.9
#    2009-06-15
#    09:04:50
#    1245053090
#    NSPCC Childline    no-email    no-comment
#Line =    10.30.198.18    2009-06-15    09:04:59    1245053099    Hel
+p for Hospices    no-email    no-comment
#    10.30.198.18
#    2009-06-15
#    09:04:59
#    1245053099
#    Help for Hospices    no-email    no-comment
__DATA__
10.30.147.23    2009-06-15    09:04:47    1245053087    Help for Hospi
+ces    no-email    no-comment
192.9.200.49    2009-06-15    09:04:50    1245053090    Alzheimer's So
+ciety/Alzheimer Scotland    no-email    no-comment
10.30.117.36    2009-06-15    09:04:50    1245053090    Help for Hospi
+ces    no-email    no-comment
10.30.135.9    2009-06-15    09:04:50    1245053090    NSPCC Childline
+    no-email    no-comment
10.30.198.18    2009-06-15    09:04:59    1245053099    Help for Hospi
+ces    no-email    no-comment

      [download]
[reply]
[d/l]

In Section Seekers of Perl Wisdom