add-counter

# counter.cgi

#!/usr/bin/perl

$| = 1; # don't buffer script output

use lib '/path/to/library';

use GD;

use SDBM_File;

use Fcntl;

use strict;

use vars qw(@HOSTS_ALLOW @DIRS_ALLOW

            $FIGURES $FONT $STATS @BG @FG);

# referring pages must come from one of these hosts

@HOSTS_ALLOW = ('www.yourhost.com'); # set to your host

# referring pages must be under one of these dirs

# DO NOT begin paths with /

@DIRS_ALLOW = (''); # leave blank for all

$FIGURES = 6; # size of counter

$FONT = gdGiantFont;

$STATS = '/path/to/stats'; # path to stats SDBM file

@BG = (0, 0, 0); # background color

@FG = (50, 200, 255); # digit color

&main();

sub main {

  my ($img, $x_size,$y_size,$string,

      $ref, %stats, $count,$bg,$fg);

  # calculate the image size, based on size of chosen font

  $x_size = ($FONT->width * $FIGURES) + 4;

  $y_size = $FONT->height +2;

  $img = new GD::Image($x_size,$y_size);

  $bg = $img->colorAllocate(@BG);

  $fg = $img->colorAllocate(@FG);

  $img->fill(0,0,$bg);

  # who's calling?

  $ref = $ENV{'HTTP_REFERER'};

  if (allowed_page($ref)) {

    tie(%stats, 'SDBM_File', $STATS, O_CREAT|O_RDWR, 0666)

      || die "no tie: $!";

    $stats{$ref}++;

    $count = $stats{$ref};

    untie %stats;

    # make the string, padded with 0's on the front

    $string = '0' x ($FIGURES - length("$count")) . $count;

    # add string to image

    $img->string($FONT,2,1,$string,$fg);

    # output to browser

    binmode STDOUT;

    print "Expires: now\n",

          "Content-type: image/gif\n\n", $img->gif;

  }

}

sub allowed_page {

  my $ref = shift;

  my ($host, $path, $h_ok, $p_ok);

  if ($ref =~ m|http://([^/]+)/(.*)|i) {

    $host = $1;

    $path = $2;

  }

  $h_ok = $p_ok = 0;

  foreach my $h(@HOSTS_ALLOW) {

    if ($h =~ /^$host$/i) {

      $h_ok = 1;

      last;

    }

  }

  foreach my $p(@DIRS_ALLOW) {

    if ($path =~ m|^$p|) {

      $p_ok = 1;

      last;

    }

  }

  return ($h_ok && $p_ok);

}