root/lang/perl/tiarra/module/Tools/LinedDB.pm @ 3004

Revision 3004, 6.2 kB (checked in by topia, 6 years ago)

lang/perl/tiarra: import.

  • Property svn:mime-type set to text/x-perl; charset=EUC-JP
  • Property svn:eol-style set to LF
  • Property svn:keywords set to Id URL Date Rev Author
Line 
1# -*- cperl -*-
2# -----------------------------------------------------------------------------
3# $Id$
4# -----------------------------------------------------------------------------
5# copyright (C) 2003 Topia <topia@clovery.jp>. all rights reserved.
6package Tools::LinedDB;
7use strict;
8use warnings;
9use IO::File;
10use File::stat;
11use Tiarra::Encoding;
12use Mask;
13use Carp;
14
15sub new {
16  my ($class, %arg) = @_;
17
18  foreach my $key qw(Parse Build Compare Update Hash) {
19    croak($key . ' should be undef or code reference!')
20      unless !defined($arg{$key}) || (ref($arg{$key}) eq 'CODE');
21  }
22
23  # Compare も Hash も既定を使う場合は、 Hash には _do_nothing を使う。
24  $arg{'Hash'} = \&_do_nothing if !defined($arg{'Compare'}) && !defined($arg{'Hash'});
25
26  my $this =
27    {
28     database => [],
29     fpath => $arg{'FilePath'},
30     charset => $arg{'Charset'} || 'utf8',
31     parse_func => $arg{'Parse'} || \&_do_nothing,
32     build_func => $arg{'Build'} || \&_do_nothing,
33     compare_func => $arg{'Compare'} || \&_do_compare_default,
34     update_callback => $arg{'Update'} || \&_do_nothing,
35     hash_func => $arg{'Hash'},
36     time => undef, # ファイルの最終読み込み時刻
37    };
38
39  # Build が指定されているのに Compare が既定のときは build してから compare する。
40  if (defined($arg{'Build'}) && !defined($arg{'Compare'})) {
41    $this->{compare_func} = sub {
42      return _do_compare_default(map {
43        $this->{build_func}->($_);
44      } @_);
45    };
46  }
47
48  bless $this, $class;
49
50  return $this->_load;
51}
52
53sub _load {
54  my ($this) = @_;
55  if (defined $this->{fpath} && $this->{fpath} ne '') {
56    $this->{database} = [];
57    my $fh = IO::File->new($this->{fpath},'r');
58    if (defined $fh) {
59      my $unicode = Tiarra::Encoding->new;
60      foreach my $line (<$fh>) {
61        chomp $line;
62        map {
63          push @{$this->{database}}, $_;
64        } $this->{parse_func}->($unicode->set($line,$this->{charset})->get);
65      }
66      $this->{time} = time();
67    }
68  }
69
70  $this->{update_callback}->();
71  return $this;
72}
73
74sub synchronize {
75  my ($this) = @_;
76  if (defined $this->{fpath} && $this->{fpath} ne '') {
77    my $fh = IO::File->new($this->{fpath},'w');
78    if (defined $fh) {
79      my $unicode = Tiarra::Encoding->new;
80      foreach my $line (@{$this->{database}}) {
81        map {
82          $fh->print($unicode->set($_ . "\n")->conv($this->{charset}));
83        } $this->{build_func}->($line);
84      }
85      $this->{time} = time();
86    }
87  }
88
89  $this->{update_callback}->();
90  return $this;
91}
92
93sub checkupdate {
94  my ($this) = @_;
95
96  if (defined $this->{fpath} && $this->{fpath} ne '') {
97    my $stat = stat($this->{fpath});
98
99    if (defined($stat) && ($stat->mtime > $this->{time})) {
100      $this->_load();
101    }
102  }
103}
104
105sub length {
106  my ($this) = @_;
107
108  $this->checkupdate();
109  return scalar(@{$this->{database}});
110}
111
112sub index {
113  my ($this, $index) = @_;
114
115  return $this->indexes($index);
116}
117
118sub indexes {
119  my ($this, @indexes) = @_;
120
121  $this->checkupdate();
122  if (wantarray) {
123    return map {
124      $this->{database}->[$_];
125    } @indexes;
126  } else {
127    return undef unless @indexes;
128    return $this->{database}->[$indexes[0]];
129  }
130}
131
132sub get_value {
133  my ($this) = @_;
134
135  $this->checkupdate();
136  if (@{$this->{database}} == 0) {
137    return undef;
138  } else {
139    my $idx = int(rand() * hex('0xffffffff')) % @{$this->{database}};
140    return $this->index($idx);
141  }
142}
143
144sub get_array {
145  my ($this) = @_;
146
147  $this->checkupdate();
148  return @{$this->{database}};
149}
150
151sub set_value {
152  my ($this, $index, $value) = @_;
153
154  $this->checkupdate();
155  $this->{database}->[$index] = $value;
156  $this->synchronize();
157  return $this;
158}
159
160sub set_array {
161  my ($this, @array) = @_;
162
163  $this->checkupdate();
164  @{$this->{database}} = @array;
165  $this->synchronize();
166  return 0;
167}
168
169sub find_index {
170  my ($this, $value) = @_;
171
172  return $this->find_indexes($value, 1);
173}
174
175sub find_indexes {
176  my ($this, $value, $count) = @_;
177  my (@indexes) = ();
178
179  my ($return) = sub {
180    if (wantarray) {
181      return @indexes;
182    } else {
183      return $indexes[0] || undef;
184    }
185  };
186
187  my $raw_value = $value;
188  $this->checkupdate();
189  for ( my $i = (@{$this->{database}} - 1) ; $i >= 0 ; --$i ) {
190    if ($this->{compare_func}->($this->{database}->[$i], $raw_value) == 0) {
191      push(@indexes, $i);
192      if (defined($count) && @indexes >= $count) {
193        return $return->();
194      }
195    }
196  }
197
198  return $return->();
199}
200
201sub find_value {
202  my ($this, $value) = @_;
203
204  return $this->find_values($value, 1);
205}
206
207sub find_values {
208  my ($this, $value, $count) = @_;
209
210  return $this->indexes($this->find_indexes($value, $count));
211}
212
213sub add_value {
214  my ($this, $value) = @_;
215
216  $this->checkupdate();
217  push(@{$this->{database}}, $value);
218  $this->synchronize();
219
220  return 1;
221}
222
223sub add_value_unique {
224  my ($this, $value) = @_;
225
226  if (!defined($this->find_value($value))) {
227    return $this->add_value($value);
228  }
229
230  return 0;
231}
232
233sub del_value {
234  my ($this, $value, $count) = @_;
235
236  my $raw_value = $value;
237  $this->checkupdate();
238  my ($deleted_count) = 0;
239  for ( my $i = (@{$this->{database}} - 1) ; $i >= 0 ; --$i ) {
240    if ($this->{compare_func}->($this->{database}->[$i], $raw_value) == 0) {
241      # equal. delete.
242      splice(@{$this->{database}}, $i, 1);
243      ++$deleted_count;
244      if (defined($count) && $deleted_count >= $count) {
245        $this->synchronize();
246        return $deleted_count;
247      }
248    }
249  }
250
251  $this->synchronize();
252  return $deleted_count;
253}
254
255sub del_value_single {
256  my ($this, $value) = @_;
257
258  return $this->del_value($value, 1);
259}
260
261sub simplify {
262  my ($this) = @_;
263
264  $this->checkupdate();
265  if (defined($this->{hash_func})) {
266    # hash mode.
267    my (%buf);
268    @{$this->{database}} = grep {
269      if (defined($buf{$this->{hash_func}->($_)})) {
270        # not found past.
271        $buf{$this->{hash_func}->($_)} = 1;
272        1;
273      } else {
274        0;
275      }
276    } @{$this->{database}};
277  } else {
278    # compare mode.
279
280    # hash_func が登録されてない場合、hash を使った整理は compare_func の定義に依るので不可。
281    # 単純に比較することになるため、非常に重くなるであろう。
282
283    # 未実装。
284    croak('not specified hash function. this mode hasn\'t implemented yet.');
285  }
286
287  $this->synchronize();
288  return $this;
289}
290
291sub _do_nothing {
292  # なにもせずただ値を返す
293  return wantarray ? @_ : $_[0];
294}
295
296sub _do_compare_default {
297  # デフォルトの比較関数。
298  my ($a, $b) = @_;
299
300  return ($a cmp $b);
301}
302
3031;
Note: See TracBrowser for help on using the browser.