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; }