ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cfmaps/cfmapidx
Revision: 1.3
Committed: Wed Nov 23 09:07:21 2005 UTC (18 years, 6 months ago) by root
Branch: MAIN
Changes since 1.2: +68 -160 lines
Log Message:
*** empty log message ***

File Contents

# Content
1 #!/opt/bin/perl
2
3 # cfmap2idx - inverted index for crossfire maps
4 # Copyright (C) 2005 Marc Lehmann <gvpe@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 gvpe; 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.91';
21
22 use Storable;
23 use DB_File;
24
25 sub escape_html($) {
26 local $_ = shift;
27 s/([<>&])/sprintf "&#%d;", ord $1/ge;
28 $_
29 }
30
31 sub search {
32 my (@kw) = @_;
33
34 tie %idx, DB_File, ".index.dat", O_RDONLY, 0, $DB_HASH
35 or die ".index.dat: $!";
36
37 my $cnt;
38 my %res;
39 my @found;
40
41 for (map lc, @kw) {
42 if (exists $idx{$_}) {
43 $cnt++;
44 $res{$_}++ for unpack "n*", $idx{$_};
45 push @found, $_;
46 #warn "$_ found\n";#d#
47 } else {
48 #warn "$_ not found\n";#d#
49 }
50 }
51
52 my @paths;
53
54 while (my ($k, $v) = each %res) {
55 next unless $v == $cnt;
56 push @paths, $idx{"D" . pack "n", $k};
57 }
58
59 binmode STDOUT, ":utf8";
60
61 print "<?xml version='1.0' encoding='utf-8'?>",
62 '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">',
63 "<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='en'>",
64 "<head>",
65 "<title>Crossfire Keyword Search</title>",
66 "<link rel='stylesheet' type='text/css' media='all' href='/common.css'/>\n",
67 "</head>",
68 "<body>";
69
70 print "<h1>Search results for '", (join "' &amp; '", map escape_html $_, @found), "'</h1>",
71 "<p class='searchcount'>", (scalar @paths), " results found, up to 200 results shown.</p>",
72 "<p class='searchresult'><ul>";
73
74 pop @paths while @paths > 200;
75
76 for (sort @paths) {
77 print "<li><a href='$_.xhtml'>$_</a></li>";
78 }
79
80 print "</ul></p><p class='footer'>created by <a href='http://software.schmorp.de/#crossfire'>cfmapidx</a> version $VERSION</p>",
81 "</body></html>";
82 }
83
84 if ($ARGV[0] eq "-a") {
85 shift;
86
87 tie %idx, DB_File, ".index.dat~", O_RDWR|O_CREAT, 0644, $DB_HASH
88 or die ".index.dat~: $!";
89
90 my %idx2;
91
92 for my $path (@ARGV) {
93 my $docnum = pack "n", ++$idx{Vdocnum};
94 $idx{"D$docnum"} = $path;
95 my $meta = Storable::retrieve "$path.pst";
96
97 for my $x (0 .. $meta->{width} - 1) {
98 for my $y (0 .. $meta->{height} - 1) {
99 for my $a (@{ $meta->{map}[$x][$y] }) {
100 for my $v (values %$a) {
101 $v = lc $v;
102 $v =~ y/a-zA-Z0-9_\-.\// /c;
103 for (split /\s+/, $v) {
104 $idx2{$_} .= $docnum;
105
106 if (/[_\-\.\/]/) {
107 $idx2{$_} .= $docnum for (split /[_\-\.\/]/)
108 }
109 }
110 }
111 }
112 }
113 }
114 }
115
116 while (my ($k, $v) = each %idx2) {
117 $idx{$k} = pack "n*", keys %{ { map +($_ => 1), unpack "n*", $idx{$k}.$v } };
118 }
119
120 } elsif ($ARGV[0] eq "-s") {
121 shift;
122
123 search @ARGV;
124 } else {
125 # assume CGI
126 chdir "/var/www/cfmaps.schmorp.de" or exit 69;
127
128 print <<EOF;
129 Content-Type: application/xhtml+xml
130
131 EOF
132 $ENV{QUERY_STRING} =~ s/^k=//;
133 search split /\s+|\++|(?:%20)+/, $ENV{QUERY_STRING};
134 }
135