lib/Data/Count.pm


=pod

Data::Count;
Data file for Counter.

Copyright wakaba 2001, GNU GPL2.
Change:

2001-08-07  wakaba <wakaba@suika.fam.cx>

        * (_init(), namelist(), list()):  New.

2001-06-05  wakaba
        - New File.  Taken from Suika::CGI::Counter.

=cut

package Data::Count;
$VERSION = '1.01';

sub open {
  my $class = shift;
  my $file = shift;
  my $name = shift || 'default';  $name =~ tr/\x0d\x0a\x1f//d;
  my $self = bless {file => $file, name => $name, error => \&error, count => {}}, $class;
  $self->_init();
  $self;
}
sub error {}

sub _init {
  my $self = shift;
  open COUNT, $self->{file} or &{$self->{error}}('open', file => $self->{file});
    while (<COUNT>) {
      if (/^([^\x1F\x0D\x0A]+)\x1f(\d+)/) {
        $self->{count}->{$1} = $2;
      }
    }
  close COUNT;
  $self;
}

sub namelist {
  my $self = shift;
  keys %{$self->{count}};
}

sub list {
  my $self = shift;
  %{$self->{count}};
}

sub get {
  my $self = shift;
  my ($id) = shift || $self->{name};  $id =~ tr/\x0d\x0a\x1f//d;
  return $self->{count}->{$id} if $self->{count}->{$id};
  my ($ret);
  open COUNT, $self->{file} or &{$self->{error}}('open', file => $self->{file});
    while (<COUNT>) {
      if (/^${id}\x1f(\d+)/) {
        $ret = $1;
        last;
      }
    }
  close COUNT;
  $self->{count}->{$id} = $ret; $ret;
}

sub up {
  my $self = shift;  my ($f, @COUNT) = 0;
  my ($id) = shift || $self->{name};  $id =~ tr/\x0d\x0a\x1f//d;
  if (open COUNT, $self->{file}) {
    @COUNT = <COUNT>;
  close COUNT}
  
  my $ret;
  open COUNT, '> '.$self->{file}
    or &{$self->{error}}('write', file => $self->{file});
    for (@COUNT) {
      if (/^\Q${id}\E\x1f(\d+)/) {
        $_ = $id."\x1f".($1+1)."\n";
        $ret = $1+1; $f = 1;
      }
      print COUNT $_;
    }
    unless ($f) {
      print COUNT $id."\x1f1\n";
      $ret = 1;
    }
  close COUNT;
  $self->{count}->{$id} = $ret; $self;
}

1;
1	wakaba	1.1
2			=pod
3
4			Data::Count;
5			Data file for Counter.
6
7			Copyright wakaba 2001, GNU GPL2.
8			Change:
9
10			2001-08-07 wakaba <wakaba@suika.fam.cx>
11
12			* (_init(), namelist(), list()): New.
13
14			2001-06-05 wakaba
15			- New File. Taken from Suika::CGI::Counter.
16
17			=cut
18
19			package Data::Count;
20			$VERSION = '1.01';
21
22			sub open {
23			my $class = shift;
24			my $file = shift;
25			my $name = shift \|\| 'default'; $name =~ tr/\x0d\x0a\x1f//d;
26			my $self = bless {file => $file, name => $name, error => \&error, count => {}}, $class;
27			$self->_init();
28			$self;
29			}
30			sub error {}
31
32			sub _init {
33			my $self = shift;
34			open COUNT, $self->{file} or &{$self->{error}}('open', file => $self->{file});
35			while (<COUNT>) {
36			if (/^([^\x1F\x0D\x0A]+)\x1f(\d+)/) {
37			$self->{count}->{$1} = $2;
38			}
39			}
40			close COUNT;
41			$self;
42			}
43
44			sub namelist {
45			my $self = shift;
46			keys %{$self->{count}};
47			}
48
49			sub list {
50			my $self = shift;
51			%{$self->{count}};
52			}
53
54			sub get {
55			my $self = shift;
56			my ($id) = shift \|\| $self->{name}; $id =~ tr/\x0d\x0a\x1f//d;
57			return $self->{count}->{$id} if $self->{count}->{$id};
58			my ($ret);
59			open COUNT, $self->{file} or &{$self->{error}}('open', file => $self->{file});
60			while (<COUNT>) {
61			if (/^${id}\x1f(\d+)/) {
62			$ret = $1;
63			last;
64			}
65			}
66			close COUNT;
67			$self->{count}->{$id} = $ret; $ret;
68			}
69
70			sub up {
71			my $self = shift; my ($f, @COUNT) = 0;
72			my ($id) = shift \|\| $self->{name}; $id =~ tr/\x0d\x0a\x1f//d;
73			if (open COUNT, $self->{file}) {
74			@COUNT = <COUNT>;
75			close COUNT}
76
77			my $ret;
78			open COUNT, '> '.$self->{file}
79			or &{$self->{error}}('write', file => $self->{file});
80			for (@COUNT) {
81			if (/^\Q${id}\E\x1f(\d+)/) {
82			$_ = $id."\x1f".($1+1)."\n";
83			$ret = $1+1; $f = 1;
84			}
85			print COUNT $_;
86			}
87			unless ($f) {
88			print COUNT $id."\x1f1\n";
89			$ret = 1;
90			}
91			close COUNT;
92			$self->{count}->{$id} = $ret; $self;
93			}
94
95			1;