##
##
##
use CGI;
use CGI::Carp qw(fatalsToBrowser);
#use warnings;
use strict;
my $CountFile = "PMCounter.txt";
my $query = new CGI;
my $User = $query->param('U') || 'unknown';
my $Loc = $query->param('L') || 'unknown';
if ($User eq 'unknown') {
my %cookie = $query->cookie('PerlMonks');
if ($cookie{'UserName'}) { $User = $cookie{'UserName'} }
}
my $cookie = $query->cookie( -name => 'PerlMonks',
-value => { UserName => $User },
-expires => '+10y',
-domain => '.anapraxis.net',
) or die "Could not build cookie. $!";
my $header = $query->header( -type=>'image/gif',
-nph=>1,
-expires=>'now',
-cookie=>$cookie,
) or die "Could not send header. $!";
print $header;
my ($C_Total, $C_Comb, $C_Loc, $C_User) = Get_Count ($User, $Loc, $CountFile);
my $Image = Get_Counter_Image($C_Total, $C_Comb, $C_Loc, $C_User);
print $Image;
####################################################################
# GET COUNT
####################################################################
sub Get_Count {
my $User = shift;
my $Loc = shift;
my $File = shift;
my $C_Total = 0;
my $C_Comb = 0;
my $C_Loc = 0;
my $C_User = 0;
my $Write = "";
open COUNT, "$File" or die "Could not open $File. $!";
while (my $line = ) {
if ( $line =~ /^\s+(\d+)\s+Total Hits\s+([\w\d\: ]+?) \#\s+[\w\d\: ]+$/ ) {
$C_Total = $1 + 1;
$Write .= sprintf ( "%8d %42s %20s # %s\n", $1 + 1, 'Total Hits', $2, "" . localtime());
} elsif ( $line =~ /^\s+(\d+)\s+$User\s+$Loc\s+([\w\d\: ]+?) \#\s+[\w\d\: ]+$/ ) {
$C_Comb = $1 + 1;
$Write .= sprintf ( "%8d %20s %20s %20s # %s\n", $1 + 1, $User, $Loc, $2, "" . localtime());
} elsif ( $line =~ /^\s+(\d+)\s+Location\s+$Loc\s+([\w\d\: ]+?) \#\s+[\w\d\: ]+$/ ) {
$C_Loc = $1 + 1;
$Write .= sprintf ( "%8d Location %32s %20s # %s\n", $1 + 1, $Loc, $2, "" . localtime());
} elsif ( $line =~ /^\s+(\d+)\s+User\s+$User\s+([\w\d\: ]+?) \#\s+[\w\d\: ]+$/ ) {
$C_User = $1 + 1;
$Write .= sprintf ( "%8d User %36s %20s # %s\n", $1 + 1, $User, $2, "" . localtime());
} else { $Write .= $line }
}
if ($C_Total == 0) {
$Write .= sprintf ( "%8d %42s %20s # %s\n", $1 + 1, 'Total Hits', localtime(), "" . localtime());
$C_Comb = 1;
}
if ($C_Comb == 0) {
$Write .= sprintf ("%8d %20s %20s %20s # %s\n", 1, $User, $Loc, "" . localtime(), "" . localtime());
$C_Comb = 1;
}
if ($C_Loc == 0) {
$Write .= sprintf ("%8d Location %32s %20s # %s\n", 1, "$Loc", "" . localtime(), "" . localtime());
$C_Loc = 1;
}
if ($C_User == 0) {
$Write .= sprintf ("%8d User %36s %20s # %s\n", 1, "$User", "" . localtime(), "" . localtime());
$C_User = 1;
}
close COUNT or die "Count not close $File. $!";
open COUNT, ">$File" or die "Could not open $File. $!";
print COUNT $Write or die "Could not print to $File. $!";
close COUNT or die "Could not close $File. $!";
return ($C_Total, $C_Comb, $C_Loc, $C_User);
}
####################################################################
# GET COUNTER IMAGE
####################################################################
sub Get_Counter_Image {
my $C_Total = shift; # Number of hits
my $C_Comb = shift;
my $C_Loc = shift;
my $C_User = shift;
my @BitArray = ();
my $Image = '';
for (1..32) {
if ($C_User & 1) { unshift @BitArray, '1.gif' }
else { unshift @BitArray, '0.gif' }
$C_User >>= 1;
}
for (1..32) {
if ($C_Loc & 1) { unshift @BitArray, '1.gif' }
else { unshift @BitArray, '0.gif' }
$C_Loc >>= 1;
}
for (1..32) {
if ($C_Comb & 1) { unshift @BitArray, '1.gif' }
else { unshift @BitArray, '0.gif' }
$C_Comb >>= 1;
}
for (1..32) {
if ($C_Total & 1) { unshift @BitArray, '1.gif' }
else { unshift @BitArray, '0.gif' }
$C_Total >>= 1;
}
my @montage = ( 'montage',
'background', 'white',
'fill', 'white',
'-mode', 'unframe',
'+display',
'-monocrome',
'-tile', '128x1',
'-geometry', '1x2+0+0!',
@BitArray, 'output.gif');
system @montage;
{
open IMAGE, 'output.gif' or die "Couldn't open output.gif. $!";
binmode IMAGE;
local $/;
$Image = ;
close IMAGE or die "Couldn't close output.gif. $!";
}
return $Image;
}