ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cfmaps/cfmapidx
(Generate patch)

Comparing cfmaps/cfmapidx (file contents):
Revision 1.2 by root, Tue Nov 22 17:54:41 2005 UTC vs.
Revision 1.14 by root, Sat Oct 31 17:26:44 2009 UTC

1#!/opt/bin/perl 1#!/opt/bin/perl
2 2
3# cfmap2idx - inverted index for crossfire maps 3# cfmapidx - inverted index for deliantra maps
4# Copyright (C) 2005 Marc Lehmann <gvpe@schmorp.de> 4# Copyright (C) 2005,2007,2008,2009 Marc Lehmann <cfmaps@schmorp.de>
5# 5#
6# CFMAPIDX is free software; you can redistribute it and/or modify 6# CFMAPIDX is free software; you can redistribute it and/or modify
7# it under the terms of the GNU General Public License as published by 7# it under the terms of the GNU General Public License as published by
8# the Free Software Foundation; either version 2 of the License, or 8# the Free Software Foundation; either version 2 of the License, or
9# (at your option) any later version. 9# (at your option) any later version.
… …
12# but WITHOUT ANY WARRANTY; without even the implied warranty of 12# but WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14# GNU General Public License for more details. 14# GNU General Public License for more details.
15# 15#
16# You should have received a copy of the GNU General Public License 16# You should have received a copy of the GNU General Public License
17# along with gvpe; if not, write to the Free Software 17# along with cfmaps; if not, write to the Free Software
18# Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 18# Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
19 19
20our $VERSION = '0.0'; 20our $VERSION = '2.0';
21 21
22use Storable; 22use common::sense;
23
24use Deliantra;
25use Deliantra::Map;
26
27use Fcntl;
23use DB_File; 28use GDBM_File;
29
30sub FAST () { 1 } # skip stopwords, skip duplicate-management
31
32our $RESULTS = 200;
33our %idx; # the database
24 34
25sub escape_html($) { 35sub escape_html($) {
26 local $_ = shift; 36 local $_ = shift;
27 s/([<>&])/sprintf "&#%d;", ord $1/ge; 37 s/([<>&])/sprintf "&#%d;", ord $1/ge;
28 $_ 38 $_
29} 39}
30 40
31if ($ARGV[0] eq "-a") { 41sub find {
32 shift; 42 my @kw = @_;
33 43
34 tie %idx, DB_File, ".index.dat~", O_RDWR|O_CREAT, 0644, $DB_HASH
35 or die ".index.dat~: $!";
36
37 my %idx2;
38
39 for my $path (@ARGV) {
40 my $docnum = pack "n", ++$idx{Vdocnum};
41 $idx{"D$docnum"} = $path;
42 my $meta = Storable::retrieve "$path.pst";
43
44 for my $x (0 .. $meta->{width} - 1) {
45 for my $y (0 .. $meta->{height} - 1) {
46 for my $a (@{ $meta->{map}[$x][$y] }) {
47 for my $v (values %$a) {
48 $v = lc $v;
49 $v =~ y/a-zA-Z0-9_\-./ /c;
50 for (split /\s+/, $v) {
51 $idx2{$_} .= $docnum;
52
53 if (/_\-\./) {
54 $idx2{$_} .= $docnum for (split /[_\-\.]/)
55 }
56 }
57 }
58 }
59 }
60 }
61 }
62
63 while (my ($k, $v) = each %idx2) {
64 $idx{$k} = pack "n*", keys %{ { map +($_ => 1), unpack "n*", $idx{$k}.$v } };
65 }
66
67} elsif ($ARGV[0] eq "-s") {
68 shift;
69
70 tie %idx, DB_File, ".index.dat", O_RDONLY, 0, $DB_HASH 44 tie %idx, "GDBM_File", ".index.dat", O_RDONLY, 0
71 or die ".index.dat: $!"; 45 or die ".index.dat: $!";
72 46
73 my $cnt; 47 my $cnt;
74 my %res; 48 my %res;
49 my @found;
75 50
76 for (map lc, @ARGV) { 51 for (@kw) {
77 if (exists $idx{$_}) { 52 if (exists $idx{$_}) {
78 $cnt++; 53 $cnt++;
79 $res{$_}++ for unpack "n*", $_; 54 $res{$_}++ for unpack "(A4)*", $idx{$_};
55 push @found, $_;
56 #warn "$_ found\n";#d#
80 } else { 57 } else {
81 warn "$_ not found\n";#d# 58 #warn "$_ not found\n";#d#
82 } 59 }
83 } 60 }
61
62 my @res;
84 63
85 while (my ($k, $v) = each %res) { 64 while (my ($k, $v) = each %res) {
86 next unless $v == $cnt; 65 next unless $v == $cnt;
87 my $path = $idx{"D" . pack "n", $k};
88 warn "found in doc $path\n";
89 }
90 66
91# print STDERR "$path\n"; 67 my ($docnum, $x, $y) = unpack "nCC", $k;
92 die; 68 my ($path, $mtime) = split /\x00/, $idx{"D" . pack "n", $docnum};
93 69
94 open my $fh, ">:utf8", "$path.xhtml" 70 push @res, [$path, $x, $y];
95 or die "$path.xhtml: $!"; 71 }
96 72
97 select $fh; 73 (\@res, \@found)
74}
98 75
99 my $W = $meta->{width} * $T; 76sub dotag {
100 my $H = $meta->{height} * $T; 77 my ($tag) = @_;
101 78
102 my $W2 = $W + 600; 79 my ($res) = find "T$tag";
103 80
104 my (@path) = split /\//, $path; 81 use Data::Dumper; warn Dumper $res;
82 print <<EOF;
83Content-Type: application/xhtml+xml
84
85EOF
105 86
106 print "<?xml version='1.0' encoding='utf-8'?>", 87 print "<?xml version='1.0' encoding='utf-8'?>",
107 '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">', 88 '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">',
108 "<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='en'>", 89 "<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='en'>",
109 "<head>", 90 "<head>",
110 "<title>Crossfire Map \"$path\"</title>", 91 "<title>Deliantra Tag Search</title>",
111 "<link rel='stylesheet' type='text/css' media='all' href='/common.css'/>\n", 92 "<link rel='stylesheet' type='text/css' media='all' href='/common.css'/>\n",
112 "<link rel='stylesheet' type='text/css' media='all' href='/overlay.css' title='Show Overlays'/>\n",
113 "<link rel='alternate stylesheet' type='text/css' media='all' href='/plain.css' title='Hide Overlays'/>\n",
114 "<style type='text/css'>\n",
115 ".map { width: ${W}px; height: ${H}px; background-image: url($path[-1].png); }\n",
116 ".enlarge { width: ${W2}px; height: 600px; }\n",
117 "</style>",
118 "</head>", 93 "</head>",
119 "<body>"; 94 "<body>";
120 95
121 print "<table class='nav'>", 96 print "<h1>Search results for tag '", (escape_html $tag), "'</h1>",
122 "<tr class='center'><td class='title' rowspan='3'>", 97 "<p class='searchresult'><ul>";
123 "Crossfire Map<br/>",
124 "<span class='big'>";
125 print "<a href='/'>/</a> ";
126 for (0 .. $#path - 1) {
127 print "<a href='/", (join "/", @path[0..$_]), "/'>$path[$_]</a> / ";
128 }
129 98
130 my @dir = qw(none up right down left); 99 for (sort { $a->[0] cmp $b->[0] } @$res) {
131 my @tile = map { 100 print "<li><a href='$_->[0].xhtml'>$_->[0] ($_->[1]|$_->[2])</a></li>";
132 $meta->{info}{"tile_path_$_"}
133 ? "<a href='$meta->{info}{\"tile_path_$_\"}.xhtml'><img class='tile' src='$meta->{info}{\"tile_path_$_\"}.jpg' alt='$dir[$_]'/></a>"
134 : ""
135 } 1..4;
136 #"}"# vim misparses without this comment
137 101 }
138 print "$path[-1]", 102
103 print "</ul></p><p class='footer'>created by <a href='http://software.schmorp.de/pkg/cfmaps'>cfmapidx</a> version $VERSION</p>",
104 "</body></html>";
105}
106
107sub search {
108 my (@kw) = @_;
109
110 my ($res, $found) = find map lc, @kw;
111
112 binmode STDOUT, ":utf8";
113
114 print <<EOF;
115Content-Type: application/xhtml+xml
116
117EOF
118
119 print "<?xml version='1.0' encoding='utf-8'?>",
120 '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">',
121 "<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='en'>",
139 "</span>", 122 "<head>",
140 "<p class='about'><a href='/about.txt'>[more about cfmaps.schmorp.de]</a></p>", 123 "<title>Deliantra Keyword Search</title>",
124 "<link rel='stylesheet' type='text/css' media='all' href='/common.css'/>\n",
141 "</td>", 125 "</head>",
142 "<td/><td>$tile[0]</td><td/></tr>",
143 "<tr><td>$tile[3]</td>",
144 "<td><img class='thumb' src='@path[-1].jpg' width='$meta->{width}' height='$meta->{height}' alt='map thumbnail'/></td>",
145 "<td>$tile[1]</td></tr>",
146 "<tr><td/><td>$tile[2]</td><td/></tr>",
147 "</table>";
148
149 my $W1 = $W + 600;
150
151 print "<p class='m'>",
152 escape_html $meta->{info}{msg},
153 "</p>"; 126 "<body>";
154 127
155 print "<table class='map'>"; 128 print "<h1>Search results for '", (join "' &amp; '", map escape_html $_, @$found), "'</h1>",
129 "<p class='searchcount'>", (scalar @$res), " results found, up to $RESULTS results shown.</p>",
130 "<p class='searchresult'><ul>";
156 131
157 my %ignore = map +($_ => 1), qw(name _name x y); 132 pop @$res while @$res > $RESULTS;
158 my %is_exit = map +($_ => 1), 41, 57, 66;
159 133
160 for my $y (0.. $meta->{height} - 1) { 134 for (sort { $a->[0] cmp $b->[0] } @$res) {
161 print "<tr>"; 135 print "<li><a href='$_->[0].xhtml'>$_->[0] ($_->[1]|$_->[2])</a></li>";
162 for my $x (0.. $meta->{width} - 1) { 136 }
163 if (my $as = $meta->{map}[$x][$y]) {
164 my @class;
165 137
166 push @class, "fishy" if grep $_->{invisible} || $_->{face} || exists $_->{no_pass}, @$as; 138 print "</ul></p><p class='footer'>created by <a href='http://software.schmorp.de/pkg/cfmaps'>cfmapidx</a> version $VERSION</p>",
167 push @class, "exit" if grep $is_exit{$arch->{$_->{_name}}{type}} && $_->{slaying}, @$as; 139 "</body></html>";
168 push @class, "dialog" if grep $_->{msg} =~ /^\@match/m, @$as; 140}
169 141
170 print "<td", (@class ? " class='" . (join " ", @class) . "'" : ""), ">"; 142if ($ARGV[0] eq "-a") {
171 print "<div>"; 143 shift;
172 144
173 print join "\n", map "<span class='c'>$_</span>", 145 tie %idx, "GDBM_File", ".index.dat~", O_RDWR | O_CREAT, 0644
174 reverse sort { (length $a) <=> (length $b) or $b <=> $a } 146 or die ".index.dat~: $!";
175 grep $_, map $_->{connected}, @$as;
176 147
177 print "<div>($x|$y)"; 148 if ($ARGV[0] eq "-r") {
149 (tied %idx)->reorganize;
150 untie %idx;
151 exit 0;
152 }
178 153
179 sub print_archs { 154 my %stop = map +($_ => undef), split /\x00/, $idx{Vstopwords};
180 print "<ul>"; 155
156 for my $path (@ARGV) {
157 next if $path =~ m%^world-precomposed/%;
158
159 my %idx2;
160
161 (my $base = $path) =~ s/\.map$//;
162 my $docnum = ++$idx{Vdocnum};
163 my $meta = eval { Deliantra::Map->new_from_file ("$base.map") }
164 or next;
165
166 $idx{"D" . pack "n", $docnum} = join "\x00", $base, (stat "$base.map")[9];
167
168 my ($x, $y, $pos);
169
170 my $add; $add = sub {
181 for my $a (@{$_[0]}) { 171 for my $a (@{ $_[0] }) {
182 my $o = $arch->{$a->{_name}}; 172 # delete "obvious" crap elements
183 my $type = $a->{type} || $o->{type}; 173 delete @$a{qw(elevation x y move_block move_slow move_allow)};
184 my $aname = escape_html $a->{_name};
185 my $name = escape_html $a->{name} || $o->{name};
186 174
187 print "<li><a href='/arc.xhtml#", (lc $a->{_name}), "'>$aname \"$name\"</a>\n"; 175 $add->(delete $a->{inventory})
188 for (sort keys %$a) { 176 if $a->{inventory};
189 next if $ignore{$_};
190 my $v = escape_html $a->{$_};
191 177
192 if ($_ eq "slaying" && $is_exit{$type}) { # door, teleporter, player_changer 178 $idx2{"T$a->{tag}"} ||= $pos
193 $a->{msg} =~ /^final_map\s*(\S+)\s*$/m, $v = $1 179 if exists $a->{tag};
194 if $v eq "/!"; # random map
195 180
196 print "slaying => <a href='$v.xhtml'>$v</a>\n"; 181 for my $v (values %$a) {
197 } elsif ($_ eq "other_arch") { 182 $v = lc $v;
198 print "$_ => <a href='/arc.xhtml#", (lc $a->{$_}), "'>$v</a>\n"; 183 $v =~ y/a-zA-Z0-9_\-.\// /c; #/ vim
199 } elsif ($_ eq "inventory") { 184
200 print "inventory =>\n"; 185 for (split /\s+/, $v) {
201 print_archs ($a->{$_}); 186 next if !FAST && exists $stop{$_};
202 } elsif ($_ eq "msg") { 187
203 print "<p class='m'>$v</p>"; 188 $idx2{$_} ||= $pos;
204 } else { 189
205 print "$_ => $v\n"; 190 if (/[_\-\.\/]/) {
206 } 191 $idx2{$_} ||= $pos for split /[_\-\.\/]/;
207 } 192 }
208 print "</li>";
209 } 193 }
210 print "</ul>";
211 } 194 }
212
213 print_archs $as;
214 print "</div></div></td>";
215 } else {
216 print "<td/>";
217 } 195 }
196 };
197
198 for $x (0 .. $meta->{width} - 1) {
199 my $col = $meta->{map}[$x];
200 for $y (0 .. $meta->{height} - 1) {
201 $pos = pack "nCC", $docnum, $x, $y;
202
203 $add->($col->[$y]);
204 }
218 } 205 }
219 print "</tr>";
220 }
221 206
222 print "</table><p class='footer'>created by <a href='http://software.schmorp.de/#crossfire'>cfmap2html</a> version $VERSION</p>", 207 if (FAST) {
223 "<p class='enlarge'/></body></html>"; 208 while (my ($k, $v) = each %idx2) {
209 $idx{$k} .= $v;
210 }
211 } else {
212 while (my ($k, $v) = each %idx2) {
213 my @val = keys %{ { map +($_ => undef), unpack "(A4)*", $idx{$k}.$v } };;
224 214
225 close $fh; 215 if ($RESULTS >= @val) {
226} 216 $idx{$k} = join "", @val;
217 } else {
218 delete $idx{$k};
219 undef $stop{$k};
220 }
221 }
222 }
223 }
227 224
225 $idx{Vstopwords} = join "\x00", keys %stop;
226
227 untie %idx;
228
229} elsif ($ARGV[0] eq "-s") {
230 shift;
231
232 search @ARGV;
233} else {
234 # assume CGI
235# chdir "/var/www/maps.deliantra.net" or exit 69;
236
237 $ENV{QUERY_STRING} =~ s/^([kt])=//;
238
239 if ($1 eq "t") {
240 dotag $ENV{QUERY_STRING};
241 } else {
242 search split /\s+|\++|(?:%20)+/, $ENV{QUERY_STRING};
243 }
244}
245

Diff Legend

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