#!/usr/local/bin/perl

#######################################################################
# Multicount                             Version 2.1                  #
# Copyright 1998-2000 by Matt Riffle     All Rights Reserved.         #
# Initial Full Release: 7/4/98           This Release: 4/28/00        #
# pingPackets Script Archive             http://www.pingpackets.com/  # 
#######################################################################
# 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.  It is included in     #
# this distribution in the file "license.txt".                        #
#                                                                     #
# 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.                                                    #
#######################################################################

## Set the variables below accordingly ##

# This is the directory in which the script will keep its data files.
# It should be chmod 777, or what is needed to ensure the server can write 
# to it.
$data_dir = './user';

# If your system can use "flock" to lock data files, set this to 1.
# Otherwise, set it to zero. If you are unsure, try 1 first, and if
# the script is failing try setting it to 0.  If, and only if, you
# are having counter reset problems, set this to 2.  See the manual
# for more details on the alternate locking scheme (the server must be
# able to create subdirectories in your data directory for it to work).
$locking = 1;

# The counts can be reported in various styles.  To use normal numbers,
# specify 'numeric' or do not set this variable.  To use numbers with 
# commas inserted at the correct points, specify 'commas'.  To use
# Roman numerals, specify 'roman'.  For hexadecimal numbers, specify
# 'hex'.  For binary, use 'binary'.
$style = 'numeric';

# This is the format in which the output will be result.  Put
# OVERALL where you want the total count, DAILY where you want the
# daily count, and WEEKLY where the weekly count should go, MONTHLY
# for monthly count, and YEARLY for yearly count.  If you
# don't want a certain count, just omit its keyword.
$format = '
<META http-equiv=Content-Type content="text/html; charset=windows-874">
<table width=100%>
  <tr> 
    <td align="center" height="16"><font face="MS Sans Serif" size="1"><img src="User2.gif" width="11" height="12" border="0" alt=""></font></td>
    <td align="left"><font face="MS Sans Serif" size="1">วันนี้</font></td>
    <td colspan="2" valign="top" align="right"><font face="MS Sans Serif" size="1">DAILY&nbsp;คน</font></td>
  </tr>
  <tr> 
    <td align="center"><font face="MS Sans Serif" size="1"><img src="User3.gif" width="12" height="12" border="0" alt=""></font></td>
    <td align="left"><font face="MS Sans Serif" size="1">สัปดาห์นี้</font></td>
    <td align="right" width="54"><font face="MS Sans Serif" size="1">WEEKLY&nbsp;คน</font></td>
  </tr>
  <tr> 
    <td align="center"><font face="MS Sans Serif" size="1"><img src="User4.gif" width="12" height="12" border="0" alt=""></font></td>
    <td align="left"><font face="MS Sans Serif" size="1">เดือนนี้</font></td>
    <td align="right"><font face="MS Sans Serif" size="1">MONTHLY&nbsp;คน</font></td>
  </tr>
  <tr> 
    <td align="center"><font face="MS Sans Serif" size="1"><img src="User5.gif" width="15" height="12" border="0" alt=""></font></td>
    <td align="left"><font face="MS Sans Serif" size="1">ปีนี้</font></td>
    <td align="right"><font face="MS Sans Serif" size="1">YEARLY&nbsp;คน</font></td>
  </tr>
  <tr> 
    <td align="center"><font face="MS Sans Serif" size="1"><img src="User5.gif" width="15" height="12" border="0" alt=""></font></td>
    <td align="left"><font face="MS Sans Serif" size="1">รวมทั้งหมด</font></td>
    <td align="right"><font face="MS Sans Serif" size="1">OVERALL&nbsp;คน</font></td>
  </tr><table>';

# If this is set to 1, the last IP address to access the counter will be
# cached to prevent one person from repeatedly updating the counter.  If
# it is set to 0, one person can increment the counter multiple times in
# succession.
$ip_caching = 0;

###### DO NOT EDIT BELOW THIS LINE ######

&init;
exit;

sub init {
  my ($name,$file,$dstamp,$wstamp);
  if ((!$ENV{'DOCUMENT_URI'}) && (!$ENV{'REQUEST_URI'})) { 
    &error('Web Server Missing Vital ENV Vars!'); # hopeless
  }
  if (!$ENV{'DOCUMENT_URI'}) { 
    $ENV{'DOCUMENT_URI'} = $ENV{'REQUEST_URI'}; # catch weird cases
  }
  $ENV{'DOCUMENT_URI'} =~ s/[^\w]/_/g; 
  $ENV{'DOCUMENT_URI'} =~ s/[\0]//g;
  if (length($ENV{'DOCUMENT_URI'}) > 240) {
    $name = substr($ENV{'DOCUMENT_URI'},0,240);
  } else {
    $name = $ENV{'DOCUMENT_URI'};
  }
  $name .= '.cnt';
  $file = "$data_dir/$name";
  if (!-e $file) {
    open (FILE,">$file") || &error('creating file'); 
    if ($locking == 2) { &lock($file) || &error('locking file'); }
    elsif ($locking) { flock(FILE,2) || &error('locking file'); }
    $dstamp = &dstamp;
    $wstamp = &wstamp;
    print FILE "1:1:1:1:1:$dstamp:$wstamp:$ENV{'REMOTE_ADDR'}";
    if ($locking == 1) { flock(FILE,8) || &error('unlocking file'); }
    close (FILE) || &error('closing file'); 
    if ($locking == 2) { &unlock($file) || &error('unlocking file'); }
    return &init_report;
  } else {
    return &update($file);
  }
}

sub update {
  my $file = shift; 
  if ($locking == 2) { &lock($file) || &error("locking file $!"); }
  open (FILE,"<$file") || &error('reading file');
  if ($locking == 1) { flock(FILE,2) || &error('locking file'); }
  my $line = <FILE>;
  if ($locking == 1) { flock(FILE,8) || &error('unlocking file'); }
  close(FILE);
  if ($locking == 2) { &unlock($file) || &error('unlocking file'); }
  my ($overall,$daily,$weekly,$monthly,$yearly,$fdstamp,$fwstamp,$ip) 
    = split(/:/,$line);
  my $dstamp = &dstamp;
  my $wstamp = &wstamp;
  my ($y,$m) = ($dstamp =~ /^(\d\d\d\d)(\d\d)/);
  my ($fy,$fm) = ($fdstamp =~ /^(\d\d\d\d)(\d\d)/);
  if ($fy < $y) { $yearly = 0; }
  if ($fm < $m) { $monthly = 0; }
  if ($fdstamp < $dstamp) { $daily = 0; $fdstamp = $dstamp; }
  if ($fwstamp < $wstamp) { $weekly = 0; $fwstamp = $wstamp; }
  if ((!$ip_caching) || ($ENV{'REMOTE_ADDR'} ne $ip)) { 
    $overall++; $daily++; $weekly++; $monthly++; $yearly++;
  }
  if ($locking == 2) { &lock($file) || &error('locking file'); }
  open (FILE,">$file") || &error("writing file");
  if ($locking == 1) { flock(FILE,2) || &error('locking file'); }
  print FILE "$overall:$daily:$weekly:$monthly:$yearly";
  print FILE ":$fdstamp:$fwstamp:$ENV{'REMOTE_ADDR'}";
  if ($locking == 1) { flock(FILE,8) || &error('unlocking file'); }
  close (FILE) || &error("closing file");
  if ($locking == 2) { &unlock($file) || &error('unlocking file'); }
  &report($overall,$daily,$weekly,$monthly,$yearly);
}
  
sub dstamp {
  local($day,$mon,$year,$z1,$z2);
  $z1 = $z2 = ""; 
  (undef,undef,undef,$day,$mon,$year,undef,undef,undef) = localtime(time);
  $mon++; $year += 1900;
  if ($mon < 10) { $z1 = '0'; }
  if ($day < 10) { $z2 = '0'; }
  return "$year$z1$mon$z2$day";
}

sub wstamp {
  local($check,$jump,$day,$mon,$year,$z1,$z2);
  (undef,undef,undef,undef,undef,undef,$check,undef,undef) = localtime(time);
  $check = 7 - $check;
  $jump = $check * 86400;
  $z1 = $z2 = "";
  (undef,undef,undef,$day,$mon,$year,undef,undef,undef) = localtime(time+$jump);
  $mon++; $year += 1900;
  if ($mon < 10) { $z1 = '0'; }
  if ($day < 10) { $z2 = '0'; }
  return "$year$z1$mon$z2$day";
}

sub report {
  my ($overall,$daily,$weekly,$monthly,$yearly);
  if ($style) {
    if ($style eq 'commas') {
      ($overall,$daily,$weekly,$monthly,$yearly) = &commas(@_);
    } elsif ($style eq 'roman') {
      ($overall,$daily,$weekly,$monthly,$yearly) = &roman(@_);
    } elsif ($style eq 'hex') {
      ($overall,$daily,$weekly,$monthly,$yearly) = &hex(@_);
    } elsif ($style eq 'binary') {
      ($overall,$daily,$weekly,$monthly,$yearly) = &binary(@_);
    } else {
      ($overall,$daily,$weekly,$monthly,$yearly) = @_;
    }
  } else {
    ($overall,$daily,$weekly,$monthly,$yearly) = @_;
  }
  print 'Content-type: text/html',"\n\n";
  $format =~ s/OVERALL/$overall/ig;
  $format =~ s/DAILY/$daily/ig;
  $format =~ s/WEEKLY/$weekly/ig;
  $format =~ s/MONTHLY/$monthly/ig;
  $format =~ s/YEARLY/$yearly/ig;
  print $format;
  exit;
}

sub init_report {
  if ($style eq 'roman') { $one = "I"; }
  else { $one = 1; }
  print 'Content-type: text/html',"\n\n";
  $format =~ s/(OVERALL|DAILY|WEEKLY|MONTHLY|YEARLY)/$one/ig;
  print $format;
}

sub error {
  my $error = shift; 
  print 'Content-type: text/html',"\n\n";
  print "[Error : $error]";
  exit;
}

sub commas {
  my ($num,@result);
  foreach $num (@_) {
    $num = reverse $num;
    $num =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
    push(@result,scalar reverse $num);
  }
  return @result; 
}

sub hex {
  my ($num,@result);
  foreach $num (@_) {
    $num = sprintf("%x",$num);
    $num =~ tr/a-f/A-F/;
    push (@result,$num);
  }
  return @result;
}

sub binary {
  my ($num,@result); 
  foreach $num (@_) {
    $num = unpack("B32", pack("N",$num));
    $num =~ s/^0+(?=\d)//;
    push (@result,$num);  
  }
  return @result;
}


sub roman {
  my ($num,@result);
  @roman1 = ('I','II','III','IV','V','VI','VII','VIII','IX');
  @roman10 = ('X','XX','XXX','XL','L','LX','LXX','LXXX','XC');
  @roman100 = ('C','CC','CCC','CD','D','DC','DCC','DCCC','CM');
  foreach $num (@_) {
    my $rnum = '';
    my $n1 = $num % 10; $num = ($num-$n1) / 10;
    my $n10 = $num % 10; $num = ($num-$n10) / 10;   
    my $n100 = $num % 10; $num = ($num-$n100) / 10;
    my $c = 0;
    while ($c < $num) { $rnum .= 'M'; $c++; }
    if ($n100) { $rnum .= @roman100[$n100-1]; }
    if ($n10) { $rnum .= @roman10[$n10-1]; }
    if ($n1) { $rnum .= @roman1[$n1-1]; } 
    push (@result,$rnum);
  }
  return @result;
}

sub lock {
  my $file = shift;
  $file .= ".lock";
  if (mkdir($file,0755)) { return 1; }
  for ($i = 0; $i < 5; $i++) {
    sleep(1);
    if (mkdir($file,0755)) { return 1; }
  }
  return 0;
}

sub unlock {
  my $file = shift;
  $file .= ".lock"; 
  return rmdir($file);
}