Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Re^2: Can i call a handmade perl module within a php file?

by mwah (Hermit)
on May 26, 2008 at 18:35 UTC ( #688545=note: print w/replies, xml ) Need Help??


in reply to Re: Can i call a handmade perl module within a php file?
in thread Can i call a handmade perl module within a php file?

After coming back to this problem an reading 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 inserting a small image with the number of hits for every single page link on a site. 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.

This would imply:

1) generate an appropriate link scheme, like this:

[any html or script here] ... <img src="/cgi-bin/counter.pl/image.png" /> </body> </html>

where the appendix /image.png is a $ENV{PATH_INFO} to help Internet Explorer to "do the right thing" ;-)

2) we need an appropriate database scheme, for MySQL this would (assumed the database is named 'counting') read:

... $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' } ); ...

... so I chose the link (pagename) to be the PK of the table. This later enables MySQL to do an INSERT IF NOT EXISTS equivalent thing (its actually: 'INSERT IGNORE INTO counters (pagename) VALUES (?)', which is simply ignored if the page entry (PK!) exists.

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':

#!/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 fon +t # 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; }

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.

Regards

mwa

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://688545]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (2)
As of 2021-04-17 05:53 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?