#-------------------------------------------
# counter.pm - a simple, fast, configurable web counter
# Copyright (C) 1999 Jonathan Anthony Field (jon@binadopta.com)
#
# Full documentation is available via perldoc
# 
# This program may be used, modified, and distributed under
# the same terms as Perl itself.  I request that the original
# copyright notice remain intact and that any modifications
# are noted here.
#-------------------------------------------
package counter;
use strict;          # for cleanliness
use GD;              # for making the gif
use Apache::Request; # for reading in arguments
use Apache::Constants qw(OK);

my $counter_data_dir = "/some_dir";

#-------------------------------------------
# purpose: prints a gif image "counter" to stdout
# usage  : called by mod_perl automatically
#          as counter::handler($r)
#-------------------------------------------
sub handler {

    # set up a request object
    my $r = Apache::Request->new(shift);

    # make sure the filename is safe
    my $filename = $r->param('name') || '';
    if (not $filename or $filename =~ /\W/) {
	$r->content_type('text/plain');
	$r->send_http_header;
        my $error = "Invalid Counter Name: '$filename'\n";
        warn $error;
        print $error;
	return OK;
    }

    # add the directory and host name name to the filename
    $filename = (
	$counter_data_dir .
	$r->server->server_hostname . "." . $filename
    );

    my $count = 0;

    # try to get the number from the file
    if (not open COUNT, "+<$filename") {
	# create the file if there wasn't one
	open COUNT, ">$filename" or die "$! : $filename";
    }

    # be thread-safe with the file
    flock COUNT, 2;
    $count = <COUNT> || 0;
    $count =~ s/\D//g; # clean out any corrupt data
    ++$count;
    seek COUNT, 0, 0;
    print COUNT $count;
    truncate COUNT, length($count);
    close COUNT;

    # create the image
    my $im = GD::Image->new(64, 16);
    $im->interlaced(1);

    # define the default colors
    my $bgcolor     = $im->colorAllocate(
	parse_color($r->param("bgcolor"), "#000000")
    );
    my $bordercolor = $im->colorAllocate(
	parse_color($r->param("bordercolor"), "#000000")
    );
    my $fontcolor   = $im->colorAllocate(
	parse_color($r->param("fontcolor"), "#FFFFFF")
    );

    # add the outline
    $im->rectangle(0, 0, 63, 15, $bordercolor);

    # add the number itself
    my $offset = 62 - (length($count) * 6);
    $im->string(gdSmallFont, $offset, 1, $count, $fontcolor);

    # print it out and we're done
    $r->content_type('image/gif');
    #$r->header_out('Expires' => 0);
    $r->send_http_header;
    print($im->gif);
    return OK;

}

#-------------------------------------------
# purpose: parse the color arguments
# usage  : parse_color($hexcolor, $default)
#          arguments are HTML style colors
#-------------------------------------------
sub parse_color {

    my ($color, $default) = @_;
    $color =~ s/^#//;
    if ($color and length $color == 6 and $color !~ /[^0123456789ABCDEF]/i) {
        my ($r, $g, $b) = $color =~ /(..)(..)(..)/;
	if ($r and $g and $b) {
	    return hex $r, hex $g, hex $b;
	}
    }
    return parse_color($default, "#000000")

}

#-------------------------------------------
1;

=head1 NAME

counter.pm - a simple, fast, configurable web counter

=head1 REQUIREMENTS

To run this handler you need to have Apache with mod_perl,
and two additional perl modules: GD-1.19 and Apache::Request.
The GD module should be no later than 1.19, because later
versions do not have support for GIF images.

=head1 USAGE

Assuming you have installed the required modules you need to
do three things.

First, create a special directory for the counter files, make
it writeable by all (chmod 777), and enter it into
$counter_data_dir.

Second, add the following lines to httpd.conf (replacing "mydirectory"
with the directory where you have placed counter.pm):

 PerlRequire /mydirectory/counter.pm
 <Location /counter>
     SetHandler perl-script
     PerlHandler counter
 </Location>

Third, and finally add the following to any html document:

 <IMG SRC="/counter?name=foo" WIDTH=64 HEIGHT=16>

You must provide a name for each count which you want to remain
distinct.  If you are running multiple virtual servers, the name
of the server will be prepended to the name of the counter
automatically.

The example above will get you a basic white on black counter.  The
colors are fully configurable by tacking arguments onto the query
string like so:

 /counter?name=foo&bgcolor=FFFFFF&bordercolor=FF0000&fontcolor=0000FF

The optional arguments are bgcolor, bordercolor, and fontcolor.  The
color definitions are, of course, normal HTML style hex colors.  Any
of these color arguments can be left out resulting in black for bgcolor
and bordercolor, and white for fontcolor.

=head1 BUGS

Don't know of any.  It's a little bit of a pain to set up, but you
probably won't ever have to worry about it again.

=head1 AUTHOR 

Copyright (C) 1999 Jonathan Anthony Field (jon@binadopta.com)
 
=head1 LICENSE

This program may be used, modified, and distributed under the same terms
as Perl itself.  I request that the original copyright notice remain intact
and any modifications are noted here.