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
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
package Echolot::Thesaurus;
# (c) 2002 Peter Palfrader <peter@palfrader.org>
# $Id: Thesaurus.pm,v 1.16 2003/11/04 04:15:00 weasel Exp $
#
=pod
=head1 Name
Echolot::Thesaurus - build thesaurus pages
=head1 DESCRIPTION
This package provides necessary functions for the thesaurus.
=cut
use strict;
use English;
use Echolot::Log;
sub save_thesaurus($$$) {
my ($otype, $oid, $data) = @_;
return 1 unless Echolot::Config::get()->{'thesaurus'};
my ($type) = $otype =~ /^([a-z-]+)$/;
Echolot::Log::cluck("type '$otype' is not clean in save_thesaurus."), return 0 unless defined $type;
my ($id) = $oid =~ /^([0-9]+)$/;
Echolot::Log::cluck("id '$oid' is not clean in save_thesaurus."), return 0 unless defined $id;
my $file = Echolot::Config::get()->{'thesaurusdir'}.'/'.$id.'.'.$type;
open (F, ">$file") or
Echolot::Log::warn ("Cannot open '$file': $!."),
return 0;
print F $data;
close (F);
return 1;
};
sub build_thesaurus() {
return 1 unless Echolot::Config::get()->{'thesaurus'};
my $dir = Echolot::Config::get()->{'thesaurusdir'};
opendir(DIR, $dir) or
Echolot::Log::warn ("Cannot open '$dir': $!."),
return 0;
my @files = grep { ! /^\./ } readdir(DIR);
closedir(DIR);
my $expire_date = time() - Echolot::Config::get()->{'expire_thesaurus'};
my $data;
for my $filename (@files) {
my ($id, $what) = $filename =~ /^(\d+)\.(adminkey|conf|help|key|stats)$/;
next unless (defined $id && defined $what);
my $remailer = Echolot::Globals::get()->{'storage'}->get_address_by_id($id);
next unless defined $remailer;
next unless $remailer->{'showit'};
my $caps = Echolot::Globals::get()->{'storage'}->get_capabilities($remailer->{'address'});
next unless defined $caps;
next unless $caps !~ m/\btesting\b/i;
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks)
= stat($dir.'/'.$filename);
if ($mtime < $expire_date) {
unlink ($dir.'/'.$filename) or
Echolot::Log::warn("Cannot unlink expired $filename.");
Echolot::Log::info("Expired thesaurus file $filename.");
next;
};
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday)
= gmtime($mtime);
my $date = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday);
my $time = sprintf("%02d:%02d", $hour, $min);
$data->{$remailer->{'address'}}->{$what.'_href'} = $filename;
$data->{$remailer->{'address'}}->{$what.'_date'} = $date;
$data->{$remailer->{'address'}}->{$what.'_time'} = $time;
$data->{$remailer->{'address'}}->{'id'} = $id;
};
for my $addr (keys (%$data)) {
my $nick = Echolot::Globals::get()->{'storage'}->get_nick($addr);
if (defined $nick) {
$data->{$addr}->{'nick'} = $nick;
$data->{$addr}->{'address'} = $addr;
} else {
delete $data->{$addr};
};
};
my @data = map {$data->{$_}} (sort { $data->{$a}->{'nick'} cmp $data->{$b}->{'nick'} } keys (%$data));
Echolot::Tools::write_HTML_file(
Echolot::Config::get()->{'thesaurusindexfile'},
'thesaurusindexfile',
Echolot::Config::get()->{'buildthesaurus'},
remailers => \@data);
open(F, ">$dir/index.txt") or
Echolot::Log::warn ("Cannot open '$dir/index.txt': $!."),
return 0;
for my $remailer (@data) {
printf F "%s\t%s\t%s\n", $remailer->{'nick'}, $remailer->{'id'}, $remailer->{'address'};
};
close(F) or
Echolot::Log::warn ("Cannot close '$dir/index.txt': $!."),
return 0;
};
1;
# vim: set ts=4 shiftwidth=4:
|
