4 min
My old perl script from 1998

my old perl script from 1998

hunting through archive.org

http://web.archive.org/web/20010930224603/http://jsawvel.hypermart.net:80/

http://web.archive.org/web/20010806110546/http://jsawvel.hypermart.net:80/ii.html

http://web.archive.org/web/20010810011105/http://jsawvel.hypermart.net:80/impint-pl.html





#!/usr/bin/perl

#  this program can be used and abused however you like. no license crapola. 
#
#
#  program: impint.pl
#  by: jrsawvel with help from C&B; Technologies (comet and beanie my two cats) 
#  email abuse to: jrkermit@primenet.com
#  date: 8-16-98
#  weather: partly cloudy at 3pm with temps in low 80's at most. darn nice out.
#           was at the 577 Foundation in P-burg this afternoon. neat place.
#  
#  description: program is "impression interval". a banner gif is diplayed at
#     regular intervals as specified in one of the args to the cgi program.
#     at little file on the web server hard drive contains the hit count and 
#     when the count divides evenly by the interval count then the gif
#     file is read and displayed to the user.
#
#  things to do:
#      1. add support to display an alternate gif file when not the interval
#          person to the page.
#
#      2. add support for keeping track of the total number of impressions or
#          hit count. this would be a number kept in a file like the total
#          count file. this would be for stat purposes to see how many times
#          the banner gif for the interval count was displayed.
#
#
#
#  usage in the html page:
#
#
#
#        cgi name=value pairs accepted
#
#    name1=   first part of counter file name 
#    name2=   second part of counter file name 
# interval=   number will mean every nth person
#      gif=   gif file to display for the nth person
# dotcolor=   if not a hit display 1 pixel with this color. don't use pound sign
#   altgif=   gif to display if NOT the nth person (not yet in place)
#


#
# build an associative array from the values contained in the url's query
# string
@cgiQueryPairs = split( "&", $ENV{ 'QUERY_STRING' } );
foreach $p ( @cgiQueryPairs ) {
    ( $var, $val ) = split( "=", $p );
    $val =~ s/\+/ /g;      # translate '+' to space
    $val =~ s/%(..)/pack("c",hex($1))/ge;    # undo '%HH' url encoding
    $cgiValues{ "$var" } = "$val";
}


$dot_array_elms=35;
$mod_op=5;
$prog_name="impint";
$dotcolor_len=6;


$home_dir="/data1/hypermart.net/jsawvel/ii";
$default_gif="survey.gif";

# default dotcolor is white */
# colors controlled by elements 13-15. first element starts with number 0
@blank=(0x47, 0x49, 0x46, 0x38, 0x37, 0x61, 0x1, 0x0, 0x1, 0x0, 0x80, 0x0, 0x0, 0xFF, 0xFF, 0xFF, 0x0, 0x0, 0x0, 0x2C, 0x0, 0x0, 0x0, 0x0, 0x1, 0x0, 0x1, 0x0, 0x0, 0x2, 0x2, 0x44, 0x1, 0x0, 0x3B);


    $i=0;
    $hitcount=0;
    $inthit=0;
    $wait_count = 0; 
    $interval_value = $mod_op; 
    $tmpnum = 0;
    $num=0;
    $MultiNumber = 0;
    $x=0;
    $len=0;
    $displaying_alt_gif_file=0;
    $bginc=0;

$td="[".localtime(time)."]";

print("Content-type: image/gif\n\n");

# pull out required form variables
$name1= $cgiValues{"name1"};
if ( $name1 eq "" ) 
{
    print STDERR "$td $prog_name: fatal - no name1 given as an arg!\n";
    exit(1);   
}
    
$name2= $cgiValues{"name2"};
if ( $name2 eq "" ) 
{
    print STDERR "$td $prog_name: fatal - no name2 given as an arg!\n";
    exit(1);   
}

$interval = $cgiValues{"interval"};
if ( $interval eq "" ) 
{
    print STDERR "$td $prog_name: fatal - no interval given as an arg!\n";
    exit(1);   
}

if ( $interval > 0 )
{
    $interval_value = $interval;
}

$giffile = $cgiValues{"gif"};
if ( $giffile eq "" ) 
{
    $gif_file_to_use = $default_gif;
}
else
{
    $gif_file_to_use = $giffile;
}

# if no dotcolor then will use white by default as above
$dotcolor = $cgiValues{"dotcolor"};
if ( $dotcolor ne "" ) 
{
    # check the strlen of dotcolor and if != dotcolor_len then use white

    $hex1 = substr($dotcolor, 0, 2);
    $hex2 = substr($dotcolor, 2, 2);
    $hex3 = substr($dotcolor, 4, 2);

    $blank[13] = hex("0x".$hex1);
    $blank[14] = hex("0x".$hex2);
    $blank[15] = hex("0x".$hex3);
}

$count_file = $home_dir . "/" . $name1 . "-" . name2 . ".cnt";
$hit_file   = $home_dir . "/" . $name1 . "-" . name2 . ".hit";
$gif_file   = $home_dir . "/" . $gif_file_to_use;


# open and read total count file. of course file locking should be used since
# unpredictable behavior could result when two users try to access the file
# at the same time. 

if ( ! -r $count_file )
{
    print STDERR "$td $prog_name: warning - missing count file for $name1 $name2! will create one.\n";
    
    $hitcount = 0;
}
else
{
    open(FPCNT, $count_file) || die "$td $prog_name: fatal - cannot read count file for $name1 $name2: $!";

    $hitcount = ;
    close(FPCNT);
}

open(FPCNT, ">$count_file") || die "$td $prog_name: fatal - cannot open count file for write for $name1 $name2: $!";

$hitcount++;
print FPCNT "$hitcount\n";
close(FPCNT);
 
# add the code to keep track of the number of impressions here...

# end impression count tracking code ...


# if a hit then display gif otherwise display single pixel

if ( ($hitcount % $interval_value) == 0 )
{
    open (GIFFILE, $gif_file) || die "can't open gif file for read: $!";
    while ( defined  ($record = ) )
    {
        print "$record";
    }
    close (GIFFILE) || die   "couldn't close gif file: $!";
}
else
{
    $i=0;
    foreach (@blank)
    {
        printf("%c", $blank[$i]);
        $i+=1;
    }
    print "\n";
}
From JR's : articles
841 words - 5708 chars - 4 min read
created on Jun 22, 2017 at 01:51:05 pm - #
source - versions