#!/usr/bin/perl -Tw
# YAC 0.6.3 (Yet Another Counter) - a web counter and logger
# Copyright (C) 2001-2002 Roland "Robelix" Obermayer
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
alarm(60);
use strict;
use CGI qw/ :standard/ ;
use Fcntl ':flock'; # import LOCK_* constants
$SIG{__DIE__} = $SIG{__WARN__} = sub { cgiprint(h1("@_")); exit 0 };
my $header_printed = 0;
# ---------------
# C O N F I G
# ---------------
# The only part you need to edit!
# the directory where the data-files are stored
# (the full unix-system-path!!)
my $data_dir = "/home/essayca/www/soft";
# the filenames
my $count_file = "count.txt";
my $latest_file = "latest.txt";
my $log_file = "log.txt";
# the path to the digit pictures (the url!)
my $graph_path = "./pix";
# the ending of the graphics
# will be .gif, .png or .jpg
my $graph_end = ".gif";
# ----------------
# End of Config
# ----------------
my $new_visit = 1;
my %latest = ();
my $mode = param('mode');
if (!$mode or (($mode ne 'text') and ($mode ne 'graphic'))) {$mode = 'quiet'}
my $min_length = param('length');
if ((!$min_length) or ($min_length =~ /\D/)) {$min_length = 1;}
my $IP = $ENV{'REMOTE_ADDR'};
# just for console-tests
if (!$IP) {$IP = "123.456.789.013";}
my $page = $ENV{'REQUEST_URI'};
# just for console-test
if (!$page) {$page = "console-test";}
my $browser = $ENV{'HTTP_USER_AGENT'};
# just for console-testing
if (!$browser) {$browser = "TestScape 1.0";}
my $reference = $ENV{'HTTP_REFERER'};
my $host = $ENV{'HTTP_HOST'};
# removing referer if it's the own host
# I'm just interested where my page is linked
if ($reference) {
if ($reference =~ /$host/) {$reference = undef;}
}
my $time_now = time();
my $time_1h = $time_now - 3600; #s
# check if a new visit
open(LATEST, "+<$data_dir/$latest_file") or die "Cannot open file";
flock(LATEST,LOCK_EX);
while () {
(my $ip_new, my $time_new) = split(/ /, $_);
chop $time_new if $time_new =~ /\n$/;
$latest{$ip_new} = $time_new;
}
# remove entries that are older than one hour
for (keys %latest) {
if ($time_1h > $latest{$_}) { delete $latest{$_};}
}
# check if the current IP is in the list
if (%latest) {
if ($latest{$IP}) {
$new_visit = 0;
}
}
# create new entry / update entry
$latest{$IP} = $time_now;
# and write %latest back to disk
seek(LATEST,0,0);
truncate(LATEST,0);
for (keys %latest) {
print LATEST "$_ $latest{$_}\n";
}
flock(LATEST,LOCK_UN);
close(LATEST);
# get the counter
open(COUNT, "+<$data_dir/$count_file") or die "Cannot open file";
flock(COUNT,LOCK_EX);
my $counter = ;
if (!$counter) {$counter=0;} # if the file is broken
# I have no idea how this happened, but it did one time!
chop $counter if $counter =~ /\n$/;
if ($new_visit) {
# increase the counter
$counter++;
# and write it back to disk
seek(COUNT,0,0);
truncate(COUNT,0);
print COUNT "$counter\n";
}
flock(COUNT,LOCK_UN);
close(COUNT);
# writing the log
open(LOG, ">>$data_dir/$log_file") or die "Cannot open file";
flock(LOG,LOCK_EX);
# if somebody is writing while we are waiting
seek(LOG, 0, 2);
print LOG "$new_visit\|$time_now\|$IP\|$page\|$browser\|";
if ($reference) {print LOG "$reference";}
print LOG "\n";
flock(LOG,LOCK_UN);
close(LOG);
print header();
$header_printed = 1;
if ($mode ne 'quiet') {
$counter = sprintf("%${min_length}.f", $counter);
$counter =~ s/ /0/g;
my @digit = split(//, $counter);
if ($mode eq 'text') {
# print "Text Mode!\n";
#print "$counter\n";
}
elsif ($mode eq 'graphic') {
# Print Counter
foreach (@digit) {
print "![](\"$graph_path/$_$graph_end\")
";
}
print "\n";
}
}
sub cgiprint {
print header() unless $header_printed;
print "@_";
$header_printed = 1;
}