#!/usr/bin/perl
#
# Usage:
#   <img src="http://example.com/counter.cgi" />
#
# Copyright (C) 2005 by Hiroshi Yuki.
# All rights reserved.
# http://www.hyuki.com/
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
use strict;

# Counter file name.
my $counter_file = "/var/www/sites/www.gakkai.ne.jp/htdoc-static/counter_jinrui.dat";

# GIF data.
my %image = (
    '[' => "\x08\x00\x18\x00\x00\x02\x17\x8C\x8F\xA9\x0A\xDD\x07\x56\x64\xB2\xD2\x9B\x66\xB6\x1B\x23\xFD\x71\x9F\x03\x2E\xE6\x89\x14\x00",
    '0' => "\x08\x00\x18\x00\x00\x02\x1A\x8C\x8F\xA9\x07\xED\xBD\xA2\x9C\x0E\x01\x86\xCD\xD5\x39\x6C\xDF\x7D\x1E\x34\x95\xE6\xF8\x90\xE7\x7A\x14\x00",
    '1' => "\x08\x00\x18\x00\x00\x02\x17\x8C\x8F\xA9\x07\xED\xBD\xA2\x9C\x01\x24\xB7\xAC\xD2\x37\xDF\x47\x85\xD4\x03\x8A\x26\x52\x00\x00",
    '2' => "\x08\x00\x18\x00\x00\x02\x17\x8C\x8F\xA9\x07\xED\xBD\xA2\x9C\x0E\x01\xB6\xAE\xD5\x38\xF1\x5D\x4D\xE2\xF8\x3C\xE3\xB9\x14\x00",
    '3' => "\x08\x00\x18\x00\x00\x02\x17\x8C\x8F\xA9\x07\xED\xBD\xA2\x9C\x0E\x01\xB6\xAE\xD5\x8A\xFB\xCD\x4D\xA2\xF8\x3C\xE3\xB9\x14\x00",
    '4' => "\x08\x00\x18\x00\x00\x02\x18\x8C\x8F\xA9\x07\xED\xBD\xA2\x9C\x06\x28\x88\xAC\x65\x35\xBF\x7B\x61\xD4\x28\x3D\x1F\x89\x22\x05\x00",
    '5' => "\x08\x00\x18\x00\x00\x02\x19\x8C\x8F\xA9\x07\xED\xBD\xA2\x94\x0F\xB0\x65\xD5\x8B\x39\xF4\xEE\x41\xD3\x48\x86\x15\x58\xA6\x41\x01\x00",
    '6' => "\x08\x00\x18\x00\x00\x02\x1A\x8C\x8F\xA9\x07\xED\xBD\xA2\x9C\x0E\x01\x86\xD5\xB3\x39\x5C\xF3\x81\xD0\x44\x96\xDE\x53\x99\x2A\x52\x00\x00",
    '7' => "\x08\x00\x18\x00\x00\x02\x17\x8C\x8F\xA9\x07\xED\xBD\xA2\x94\x0F\xB0\xAB\x6C\xD2\x88\xF7\xE5\x4D\xA2\x58\x39\xE3\xB9\x14\x00",
    '8' => "\x08\x00\x18\x00\x00\x02\x1A\x8C\x8F\xA9\x07\xED\xBD\xA2\x9C\x0E\x01\x86\xCD\x65\x30\x87\xFD\x79\x5F\x37\x95\xE6\xF3\x98\xEA\x52\x00\x00",
    '9' => "\x08\x00\x18\x00\x00\x02\x1A\x8C\x8F\xA9\x07\xED\xBD\xA2\x9C\x0E\x01\x86\xCD\x65\x55\xED\xF0\x7D\x20\x34\x95\xE6\xF8\x90\xE7\x7A\x14\x00",
    ']' => "\x08\x00\x18\x00\x00\x02\x17\x8C\x8F\xA9\x07\x0D\xFB\x54\x4C\x13\x55\x06\xB3\xD4\x94\x5B\x8F\x6D\x8C\xB3\x94\xE6\x69\x14\x00",
);

&main;
exit;
sub main {
    my $counter = &get_access_counter($counter_file);
    my $string = sprintf("[%06d]", $counter);
    print "Content-type: image/gif\n";
    print "\n";
    binmode(STDOUT);
    print &concat_gif($string);
}

sub get_access_counter {
    my ($fname) = @_;

    if (!-e($fname)) {
        open(FILE, "> $fname");
        close(FILE);
    }

    if (open(FILE, "+< $fname")) {
        flock(FILE, 2); # 2=LOCK_EX
        seek(FILE, 0, 0);
        my $count = <FILE> + 1;
        seek(FILE, 0, 0);
        print FILE "$count\n";
        flock(FILE, 8); # 8=LOCK_UN
        close(FILE);
        return $count;
    } else {
        # File open error.
        return 99;
    }
}

sub concat_gif {
    my ($string) = @_;
    my $result = '';
    $result .= &make_header(8 * length($string), 24);
    $result .= &make_image($string);
    $result .= &make_footer;
    return $result;
}
# Create a GIF header according to given width, height.
sub make_header {
    my ($width, $height) = @_;
    my $result = "GIF89a";                  # signature
    $result .= &pack_xy($width, $height);   # local screen width, logical screen height
    $result .= "\x80";                      # monochrome
    $result .= "\x00";                      # bgindex
    $result .= "\x00";                      # no aspect ratio
    $result .= "\x00\x00\x00";              # black color
    $result .= "\xFF\xFF\xFF";              # white color
    return $result;
}

# Footer (trailer).
sub make_footer {
    return "\x3B";
}

# Create images.
sub make_image {
    my ($string) = @_;
    my $step = 8;
    my $result = '';
    my $top = 0;
    my $left = 0;
    foreach (split(//, $string)) {
        $result .= &make_control();
        $result .= &make_subimage($left, $top, $_);
        $left += $step;
    }
    return $result;
}

# Create a Graphic Control Extension.
sub make_control {
    my $result = "\x21";                # introducer
    $result .= "\xF9";                  # Label
    $result .= "\x04";                  # size
    $result .= "\x00\x00\x00\x00";      #
    $result .= "\x00";
    return $result;
}
# Create a GIF subimage.
sub make_subimage {
    my ($left, $top, $name) = @_;
    my $result = "\x2C";                # introducer
    $result .= &pack_xy($left, $top);   # image left position, top position
    $result .= $image{$name};
    return $result;
}

# Return packed 2 bytes according to given x, y
sub pack_xy {
    my ($x, $y) = @_;
    my $result = '';
    $result .= chr($x % 256);
    $result .= chr(($x / 256) % 256);
    $result .= chr($y % 256);
    $result .= chr(($y / 256) % 256);
    return $result;
}

1;

