1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
# -*- cperl -*-
# -----------------------------------------------------------------------------
# $Id: EachFile.pm 11365 2008-05-10 14:58:28Z topia $
# -----------------------------------------------------------------------------
# copyright (C) 2003 Topia <topia@clovery.jp>. all rights reserved.
package Tools::FileCache::EachFile;
use strict;
use warnings;
use Carp;
use Module::Use qw(Tools::LinedDB);
use Tools::LinedDB;
use Tiarra::Utils;
our $AUTOLOAD;
my $timeout = 2.5 * 60;
sub new {
my ($class, $parent, $fpath, $mode, $charset) = @_;
my ($this) = {
parent => $parent,
mode => undef,
database => undef,
refcount => 0,
expire => undef,
};
if ($mode =~ /raw/i) {
$this->{mode} = 'raw';
$this->{database} =
Tools::LinedDB->new(
FilePath => $fpath,
Charset => $charset,
);
} elsif ($mode =~ /std/i) {
$this->{mode} = 'std';
$this->{database} =
Tools::LinedDB->new(
FilePath => $fpath,
Charset => $charset,
Parse => sub {
my ($line) = @_;
$line =~ s/^\s+//;
return () if $line =~ /^[\#\;]/;
$line =~ s/\s+$//;
return () if $line eq '';
return $line;
},
);
} else {
croak 'can\'t understand type "' . $mode . '"';
}
bless $this, $class;
return $this;
}
sub register {
my $this = shift;
$this->add_ref;
$this;
}
sub unregister {
my $this = shift;
$this->release;
$this;
}
Tiarra::Utils->define_attr_getter(0, qw(refcount expire));
sub add_ref { ++(shift->{refcount}); }
sub release { --(shift->{refcount}); }
sub can_remove { (shift->refcount <= 0); }
sub set_expire {
my ($this) = @_;
$this->{expire} = time() + $timeout;
return $this;
}
sub clean {
my ($this) = @_;
$this->{database} = undef;
}
sub AUTOLOAD {
my ($this, @args) = @_;
if ($AUTOLOAD =~ /::DESTROY$/) {
# DESTROYは伝達させない。
return;
}
(my $method = $AUTOLOAD) =~ s/.+?:://g;
# define method
eval "sub $method { shift->{database}->$method(\@_); }";
no strict 'refs';
goto &$AUTOLOAD;
}
1;
|
