ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cvsroot/Coro/myhttpd/diridx.pl
(Generate patch)

Comparing cvsroot/Coro/myhttpd/diridx.pl (file contents):
Revision 1.8 by root, Sat Aug 25 15:14:03 2001 UTC vs.
Revision 1.9 by root, Sun Aug 26 14:55:46 2001 UTC

1use PApp::SQL;
2use Storable (); 1use Storable ();
3 2
4my $SD_VERSION = 1; 3my $SD_VERSION = 1;
5 4
6my $ignore = qr/ ^(?:robots.txt$|\.) /x; 5my $ignore = qr/ ^(?:robots.txt$|\.) /x;
6
7our %diridx;
8
9if ($::DIRIDX) {
10 require GDBM_File;
11 my $dbm = tie %diridx, GDBM_File, $::DIRIDX,
12 &GDBM_File::GDBM_WRCREAT, # | &GDBM_File::GDBM_FAST,
13 0600;
14 $dbm->setopt(&GDBM_File::GDBM_CACHESIZE, (pack "i", 1_000), length (pack "i", 1_000));
15}
7 16
8sub conn::gen_statdata { 17sub conn::gen_statdata {
9 my $self = shift; 18 my $self = shift;
10 my $data; 19 my $data;
11 20
… …
36 } while $path ne ""; 45 } while $path ne "";
37 } 46 }
38 47
39 local *DIR; 48 local *DIR;
40 if (opendir DIR, $self->{path}) { 49 if (opendir DIR, $self->{path}) {
41 my $stat;
42
43 my (@files, @dirs);
44 my $dlen = 0; 50 my $dlen = 0;
45 my $flen = 0; 51 my $flen = 0;
46 my $slen = 0; 52 my $slen = 0;
47 for (sort readdir DIR) { 53 for (sort readdir DIR) {
48 next if /$ignore/; 54 next if /$ignore/;
49 stat "$self->{path}$_"; 55 stat "$self->{path}$_";
50 next unless -r _; 56 next unless -r _;
51 if (-d _) { 57 if (-d _) {
52 $dlen = length $_ if length $_ > $dlen; 58 $dlen = length $_ if length $_ > $dlen;
53 push @dirs, "$_/"; 59 push @{$data->{d}}, $_;
54 } else { 60 } else {
55 my $s = -s _; 61 my $s = -s _;
56 $flen = length $_ if length $_ > $dlen; 62 $flen = length $_ if length $_ > $dlen;
57 $slen = length $s if length $s > $dlen; 63 $slen = length $s if length $s > $dlen;
58 push @files, [$_, $s]; 64 push @{$data->{f}}, [$_, $s];
59 } 65 }
60 } 66 }
61 if (@dirs) { 67 $data->{dlen} = $dlen;
62 $stat .= "<table><tr><th>Directories</th></tr>"; 68 $data->{flen} = $flen;
63 $dlen += 1;
64 my $cols = int ((79 + $dlen) / $dlen);
65 my $col = $cols;
66 $cols = @dirs if @dirs < $cols;
67 for (@dirs) {
68 if (++$col >= $cols) {
69 $stat .= "<tr>";
70 $col = 0;
71 }
72 $stat .= "<td><a href='".escape_uri($_)."'>$_</a> ";
73 }
74 $stat .= "</table>";
75 }
76 if (@files) {
77 $flen = $flen + 1 + $slen + 1 + 3;
78 my $cols = int ((79 + $flen) / $flen);
79 my $col = $cols;
80 $cols = @files if @files < $cols;
81 $stat .= "<table><tr>". ("<th align='left'>File<th>Size<th>&nbsp;" x $cols);
82 for (@files) {
83 if (++$col >= $cols) {
84 $stat .= "<tr>";
85 $col = 0;
86 }
87 $stat .= "<td><a href='".escape_uri($_->[0])."'>$_->[0]</a><td align='right'>$_->[1]<td>&nbsp;";
88 }
89 $stat .= "</table>";
90 }
91 $data->{stat} = $stat; 69 $data->{slen} = $slen;
92 } else {
93 $data->{stat} = "Unable to index $uri: $!<br>";
94 } 70 }
95 71
96 $data; 72 $data;
97} 73}
98
99use Tie::Cache;
100tie %statdata_cache, Tie::Cache::, 70;
101 74
102sub conn::get_statdata { 75sub conn::get_statdata {
103 my $self = shift; 76 my $self = shift;
104 77
105 my $mtime = $self->{stat}[9]; 78 my $mtime = $self->{stat}[9];
106 79
107 my $statdata = \$statdata_cache{$self->{path}, $mtime}; 80 $statdata = $diridx{$self->{path}};
108 81
109 return $$statdata if $$statdata; 82 if (defined $statdata) {
110
111 my $st = sql_exec $statdata,
112 "select statdata from diridx where mtime = ? and path = ?",
113 $mtime, $self->{path};
114
115 if ($st->fetch) {
116 $$statdata = Storable::thaw $$statdata; 83 $$statdata = Storable::thaw $statdata;
84 return $$statdata
117 return $$statdata if $$statdata->{version} == $SD_VERSION; 85 if $$statdata->{version} == $SD_VERSION
86 && $$statdata->{mtime} == $mtime;
118 } 87 }
119 88
120 $self->slog(8, "creating index cache for $self->{path}"); 89 $self->slog(8, "creating index cache for $self->{path}");
121 90
122 $$statdata = $self->gen_statdata; 91 $$statdata = $self->gen_statdata;
123 $$statdata->{version} = $SD_VERSION; 92 $$statdata->{version} = $SD_VERSION;
93 $$statdata->{mtime} = $mtime;
124 94
125 sql_exec "delete from diridx where path = ?", $self->{path};
126 sql_exec "insert into diridx (path, mtime, statdata) values (?, ?, ?)",
127 $self->{path}, $mtime, Storable::freeze $$statdata; 95 $diridx{$self->{path}} = Storable::freeze $$statdata;
128 96
129 $$statdata; 97 $$statdata;
130} 98}
131 99
132sub conn::diridx { 100sub conn::diridx {
… …
138 $uptime = sprintf "%02dd %02d:%02d", 106 $uptime = sprintf "%02dd %02d:%02d",
139 int ($uptime / (60 * 60 * 24)), 107 int ($uptime / (60 * 60 * 24)),
140 int ($uptime / (60 * 60)) % 24, 108 int ($uptime / (60 * 60)) % 24,
141 int ($uptime / 60) % 60; 109 int ($uptime / 60) % 60;
142 110
111 my $stat;
112 if ($data->{dlen}) {
113 $stat .= "<table><tr><th>Directories</th></tr>";
114 $data->{dlen} += 1;
115 my $cols = int ((79 + $data->{dlen}) / $data->{dlen});
116 $cols = @{$data->{d}} if @{$data->{d}} < $cols;
117 my $col = $cols;
118 for (@{$data->{d}}) {
119 if (++$col >= $cols) {
120 $stat .= "<tr>";
121 $col = 0;
122 }
123 if ("$self->{path}$_" =~ $conn::blockuri{$self->{country}}) {
124 $stat .= "<td>$_ ";
125 } else {
126 $stat .= "<td><a href='".escape_uri("$_/")."'>$_</a> ";
127 }
128 }
129 $stat .= "</table>";
130 }
131 if ($data->{flen}) {
132 $data->{flen} += 1 + $data->{slen} + 1 + 3;
133 my $cols = int ((79 + $data->{flen}) / $data->{flen});
134 $cols = @{$data->{f}} if @{$data->{f}} < $cols;
135 my $col = $cols;
136 $stat .= "<table><tr>". ("<th align='left'>File<th>Size<th>&nbsp;" x $cols);
137 for (@{$data->{f}}) {
138 if (++$col >= $cols) {
139 $stat .= "<tr>";
140 $col = 0;
141 }
142 $stat .= "<td><a href='".escape_uri($_->[0])."'>$_->[0]</a><td align='right'>$_->[1]<td>&nbsp;";
143 }
144 $stat .= "</table>";
145 }
146
143 <<EOF; 147 <<EOF;
144<html> 148<html>
145<head><title>$self->{uri}</title></head> 149<head><title>$self->{uri}</title></head>
146<body bgcolor="#ffffff" text="#000000" link="#0000ff" vlink="#000080" alink="#ff0000"> 150<body bgcolor="#ffffff" text="#000000" link="#0000ff" vlink="#000080" alink="#ff0000">
147<h1>$data->{path}</h1> 151<h1>$data->{path}</h1>
148$data->{top} 152$data->{top}
149<small><div align="right"><tt>$self->{remote_id}/$self->{country} - $::conns connection(s) - uptime $uptime - myhttpd/$VERSION</tt></div></small> 153<small><div align="right"><tt>$self->{remote_id}/$self->{country} - $::conns connection(s) - uptime $uptime - myhttpd/$VERSION</tt></div></small>
150<hr> 154<hr>
151$data->{stat} 155$stat
152$data->{bot} 156$data->{bot}
153</body> 157</body>
154</html> 158</html>
155EOF 159EOF
156} 160}

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines