#!/usr/local/bin/perl -w
# counter2.pl -- Ein DBI-basierter Webcounter mit Tie::RDBM

use strict;

use CGI qw(:standard);                       # Unser CGI.pm Modul
use CGI::Carp qw(fatalsToBrowser);           # Fehlermeldungen zum Browser
use GD;                                      # Zum Erzeugen von GIFs
use Tie::RDBM;                               # Datenbankzugriffe

# Konfigurationsdaten fuer die verwendete DBI-Datenbank
use constant DB_DSN   => 'mysql:www';        # Welche Datenbank?
use constant DB_USER  => $ENV{'user'};       # User-Login
use constant DB_PASS  => 'wwwpass';          # User-Passwort
use constant DB_TABLE => 'counter_hits';     # Tabelle mit Zaehlerdaten

# Fuer welche Seite soll der Zaehler inkrementiert werden?
my $sessionid = $ENV{'PATH_INFO'};
$sessionid =~ s!/!_!g;
my $query = new CGI;
error("Usage: Set PATH_INFO first!") if (!$sessionid);

# Wir stellen eine Verbindung zur DBI-Datenbank her.
my %counter;
tie %counter, 'Tie::RDBM', DB_DSN, { user  => DB_USER, password => DB_PASS,
                     table => DB_TABLE, create  => 1 }
    or die "Can't tie to database: $!\n";

# Hier wird der Zaehler atomar erhoeht.
my $newvalue = ++$counter{$sessionid};

output_as_gif($newvalue);
untie %counter;

sub output_as_gif {
    my $message = shift;    # Die auszugebende Nachricht
    my ($x,$y) = (length($message) * gdLargeFont->width() + 10,
          gdLargeFont->height() + 10);
    my $im = new GD::Image($x, $y);

    $im->transparent();
    $im->interlaced('true');
    $im->rectangle(0,0,$x,$y,$im->colorAllocate(0,0,0));

    $im->string(gdLargeFont,5,5,
        $message,$im->colorAllocate(255,255,255));
    my $gif = $im->gif();

    # GIF-Bild zum Browser senden:
    print
    $query->header(-type => 'image/gif', -expires => '-1d'),
    $gif;
}

sub error {
    my $message = shift;
    output_as_gif($message);
    exit 0;
}