note
mwah
<p>After coming back to this problem an reading [id://688518|tachyon-II's reply], I wondered if this couldn't simply be generalized away for every web file or script (from whatever source), with the goal of <font color="blue">inserting a small image with the number of hits for every single page link on a site</font>. The single Perl-Script (eg. in /cgi-bin/) behind this 'image-link' would simply find the link in question (to be counted up) in the $ENV{HTTP_REFERER} variable, handle the database stuff in the background and respond by creating an image (containing a number) on the fly.</p>
<p>This would imply:</p>
<p>1) generate an appropriate link scheme, like this:</p>
<c>
[any html or script here]
...
<img src="/cgi-bin/counter.pl/image.png" />
</body>
</html>
</c>
<p>where the appendix /image.png is a $ENV{PATH_INFO} to help Internet Explorer to "do the right thing" ;-)</p>
<p>2) we need an appropriate database scheme, for MySQL this would (assumed the database is named <c>'counting'</c>) read:</p>
<c>
...
$dbh->do( q{
CREATE TABLE counters
( pagename VARCHAR(640) NOT NULL
, pagecounter INT(11) DEFAULT 0
, PRIMARY KEY (pagename)
) Engine=InnoDB charset=latin1 COMMENT='pagecounter'
}
);
...
</c>
<p> ... so I chose the link (pagename) to be the PK of the table. This later enables MySQL to do an <c>INSERT IF NOT EXISTS</c> equivalent thing (its actually: <c>'INSERT IGNORE INTO counters (pagename) VALUES (?)'</c>, which is simply ignored if the page entry (PK!) exists.</p>
<p>3) The script, which is straightforward. First, the database is updated (my DBI is rusty, please correct my glitches), then the hit-number image is created (via Imager) and sent to the browser. Database access stuff and a font file path for number-output has to be modified. '/cgi-bin/counter.pl':</p>
<readmore>
<c>
#!/usr/bin/perl
use strict;
use warnings;
# 1) get actual referer path name (strip server part)
my ($pagename, $client) = ($ENV{HTTP_REFERER}, $ENV{REMOTE_ADDR});
$pagename = $1 if $pagename =~ m{ ^\w+:// [^/]+ / (.+)$ }x;
# 2) update db and get count value
my $count = handledb($pagename, $client);
# 3)write results
++$|; binmode STDOUT;
print counterimage(48, 15, $count, 'blue', 'white'); # expect 6x13 font
# Subroutine handledb()
# update database stuff, return number hits of a site (link)
#
sub handledb {
use DBI;
my ($page, $client) = @_;
my $dbhost = 'my.glory.host.com';
my ($dbn, $usr, $pw) =('counting', 'db-username', 'db-password');
my $ignoredreferer = '192.168.1.2';
my $dbh = DBI->connect("dbi:mysql:$dbn:$dbhost", $usr, $pw) || die "$DBI::errstr!";
my $item = $dbh->quote($page);
my $query = 'INSERT IGNORE INTO counters (pagename) VALUES (?)';
my $sth = $dbh->prepare($query); $sth->execute( $item );
if( $client ne $ignoredreferer ) { # don't count on this referer
$query = 'UPDATE counters SET pagecounter = pagecounter + 1 WHERE pagename = ?';
$sth = $dbh->prepare($query); $sth->execute( $item );
}
$query = 'SELECT pagecounter FROM counters WHERE pagename = ?';
$sth = $dbh->prepare($query); $sth->execute( $item );
my ($nhits) = $dbh->selectrow_array($sth);
$dbh->disconnect or warn "Disconnection failed: $DBI::errstr!\n";
return $nhits;
}
# Subroutine counterimage()
# returns a buffer containing an (binary) image of the number
# (in .png format) wanted plus it's corresponding http content header
sub counterimage {
use Imager;
my ($lx, $ly, $text, $color, $bgcolor) = @_;
my $img = Imager->new(xsize => $lx, ysize => $ly, channels => 3);
my $fnt = Imager::Font->new(file =>'/usr/share/fonts/misc/6x13B.pcf.gz');
$img->box(filled=>1, color=>$bgcolor);
$fnt->align(image => $img, x => $lx/2, y => $ly/2,
string => $text,
color => $color,
halign => 'center',
valign => 'center'
);
my $data;
$img->write(type=>'png', data=>\$data) or die $img->errstr;
return "Content-type: image/png\n"
. "Content-Length: " . length($data) . "\n\n"
. $data;
}
</c>
</readmore>
<p>I did set this up on my (Linux) Box and it works nice. So I decided to post it, maybe its of use for someone else.</p>
<p>Regards</p>
<p>mwa</p>
688512
688520