ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cfmaps/cfmapidx
Revision: 1.12
Committed: Thu Oct 22 08:19:16 2009 UTC (14 years, 7 months ago) by root
Branch: MAIN
Changes since 1.11: +8 -4 lines
Log Message:
*** empty log message ***

File Contents

# Content
1 #!/opt/bin/perl
2
3 # cfmap2idx - inverted index for deliantra maps
4 # Copyright (C) 2005,2007,2008 Marc Lehmann <cfmaps@schmorp.de>
5 #
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
8 # the Free Software Foundation; either version 2 of the License, or
9 # (at your option) any later version.
10 #
11 # This program is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License
17 # along with cfmaps; if not, write to the Free Software
18 # Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
19
20 our $VERSION = '0.923';
21
22 use Deliantra;
23 use Deliantra::Map;
24
25 use Fcntl;
26 use SDBM_File;
27
28 sub escape_html($) {
29 local $_ = shift;
30 s/([<>&])/sprintf "&#%d;", ord $1/ge;
31 $_
32 }
33
34 sub search {
35 my (@kw) = @_;
36
37 tie %idx, SDBM_File, ".index.dat", O_RDONLY, 0
38 or die ".index.dat: $!";
39
40 my $cnt;
41 my %res;
42 my @found;
43
44 for (map lc, @kw) {
45 if (exists $idx{$_}) {
46 $cnt++;
47 $res{$_}++ for unpack "n*", $idx{$_};
48 push @found, $_;
49 #warn "$_ found\n";#d#
50 } else {
51 #warn "$_ not found\n";#d#
52 }
53 }
54
55 my @paths;
56
57 while (my ($k, $v) = each %res) {
58 next unless $v == $cnt;
59 push @paths, $idx{"D" . pack "n", $k};
60 }
61
62 binmode STDOUT, ":utf8";
63
64 print "<?xml version='1.0' encoding='utf-8'?>",
65 '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">',
66 "<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='en'>",
67 "<head>",
68 "<title>Deliantra Keyword Search</title>",
69 "<link rel='stylesheet' type='text/css' media='all' href='/common.css'/>\n",
70 "</head>",
71 "<body>";
72
73 print "<h1>Search results for '", (join "' &amp; '", map escape_html $_, @found), "'</h1>",
74 "<p class='searchcount'>", (scalar @paths), " results found, up to 200 results shown.</p>",
75 "<p class='searchresult'><ul>";
76
77 pop @paths while @paths > 200;
78
79 for (sort @paths) {
80 print "<li><a href='$_.xhtml'>$_</a></li>";
81 }
82
83 print "</ul></p><p class='footer'>created by <a href='http://software.schmorp.de/pkg/cfmaps'>cfmapidx</a> version $VERSION</p>",
84 "</body></html>";
85 }
86
87 if ($ARGV[0] eq "-a") {
88 shift;
89
90 tie %idx, SDBM_File, ".index.dat~", O_RDWR|O_CREAT, 0644
91 or die ".index.dat~: $!";
92
93 my %idx2;
94
95 for my $path (@ARGV) {
96 (my $base = $path) =~ s/\.map$//;
97 my $docnum = pack "n", ++$idx{Vdocnum};
98 $idx{"D$docnum"} = $base;
99 my $meta = Deliantra::Map->new_from_file ("$base.map");
100
101 for my $x (0 .. $meta->{width} - 1) {
102 for my $y (0 .. $meta->{height} - 1) {
103 for my $a (@{ $meta->{map}[$x][$y] }) {
104 for my $v (values %$a) {
105 $v = lc $v;
106 $v =~ y/a-zA-Z0-9_\-.\// /c;
107 for (split /\s+/, $v) {
108 $idx2{$_} .= $docnum;
109
110 if (/[_\-\.\/]/) {
111 $idx2{$_} .= $docnum for (split /[_\-\.\/]/)
112 }
113 }
114 }
115 }
116 }
117 }
118 }
119
120 while (my ($k, $v) = each %idx2) {
121 $idx{$k} = pack "n*", keys %{ { map +($_ => 1), unpack "n*", $idx{$k}.$v } };
122 }
123
124 untie %idx;
125
126 } elsif ($ARGV[0] eq "-s") {
127 shift;
128
129 search @ARGV;
130 } else {
131 # assume CGI
132 # chdir "/var/www/maps.deliantra.net" or exit 69;
133
134 print <<EOF;
135 Content-Type: application/xhtml+xml
136
137 EOF
138 $ENV{QUERY_STRING} =~ s/^k=//;
139 search split /\s+|\++|(?:%20)+/, $ENV{QUERY_STRING};
140 }
141