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
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;