[ViewVC] Annotation of: cvs/cvsroot/cfmaps/cfmapidx

#!/opt/bin/perl

# cfmap2idx - inverted index for crossfire maps
# Copyright (C) 2005,2007 Marc Lehmann <cfmaps@schmorp.de>
#
# CFMAPIDX is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with cfmaps; if not, write to the Free Software
# Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

our $VERSION = '0.912';

use Crossfire;
use DB_File;

sub escape_html($) {
   local $_ = shift;
   s/([<>&])/sprintf "&#%d;", ord $1/ge;
   $_
}

sub search {
   my (@kw) = @_;

   tie %idx, DB_File, ".index.dat", O_RDONLY, 0, $DB_HASH
      or die ".index.dat: $!";

   my $cnt;
   my %res;
   my @found;

   for (map lc, @kw) {
      if (exists $idx{$_}) {
         $cnt++;
         $res{$_}++ for unpack "n*", $idx{$_};
         push @found, $_;
         #warn "$_ found\n";#d#
      } else {
         #warn "$_ not found\n";#d#
      }
   }

   my @paths;

   while (my ($k, $v) = each %res) {
      next unless $v == $cnt;
      push @paths, $idx{"D" . pack "n", $k};
   }

   binmode STDOUT, ":utf8";

   print "<?xml version='1.0' encoding='utf-8'?>",
         '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">',
         "<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='en'>",
         "<head>",
            "<title>Crossfire Keyword Search</title>",
            "<link rel='stylesheet' type='text/css' media='all' href='/common.css'/>\n",
         "</head>",
         "<body>";

   print "<h1>Search results for '", (join "' &amp; '", map escape_html $_, @found), "'</h1>",
         "<p class='searchcount'>", (scalar @paths), " results found, up to 200 results shown.</p>",
         "<p class='searchresult'><ul>";

   pop @paths while @paths > 200;

   for (sort @paths) {
      print "<li><a href='$_.xhtml'>$_</a></li>";
   }

   print "</ul></p><p class='footer'>created by <a href='http://software.schmorp.de/pkg/cfmaps'>cfmapidx</a> version $VERSION</p>",
         "</body></html>";
}

if ($ARGV[0] eq "-a") {
   shift;

   tie %idx, DB_File, ".index.dat~", O_RDWR|O_CREAT, 0644, $DB_HASH
      or die ".index.dat~: $!";

   my %idx2;

   for my $path (@ARGV) {
      (my $base = $path) =~ s/\.map$//;
      my $docnum = pack "n", ++$idx{Vdocnum};
      $idx{"D$docnum"} = $base;
      my $meta = read_arch "$base.map";

      for my $x (0 .. $meta->{width} - 1) {
         for my $y (0 .. $meta->{height} - 1) {
            for my $a (@{ $meta->{map}[$x][$y] }) {
               for my $v (values %$a) {
                  $v = lc $v;
                  $v =~ y/a-zA-Z0-9_\-.\// /c;
                  for (split /\s+/, $v) {
                     $idx2{$_} .= $docnum;

                     if (/[_\-\.\/]/) {
                        $idx2{$_} .= $docnum for (split /[_\-\.\/]/) 
                     }
                  }
               }
            }
         }
      }
   }

   while (my ($k, $v) = each %idx2) {
      $idx{$k} = pack "n*", keys %{ { map +($_ => 1), unpack "n*", $idx{$k}.$v } };
   }

} elsif ($ARGV[0] eq "-s") {
   shift;

   search @ARGV;
} else {
   # assume CGI
   chdir "/var/www/cfmaps.schmorp.de" or exit 69;

   print <<EOF;
Content-Type: application/xhtml+xml

EOF
   $ENV{QUERY_STRING} =~ s/^k=//;
   search split /\s+|\++|(?:%20)+/, $ENV{QUERY_STRING};
}

Revision:	1.8
Committed:	Thu Jun 21 12:30:10 2007 UTC (19 years, 3 months ago) by root
Branch:	MAIN
Changes since 1.7:	+2 -2 lines
Log Message:	get rid of .pst files, they are actually slower to read than read_arch'ing the map files directly. maybe json...
#	User	Rev	Content
1	root	1.1	#!/opt/bin/perl
2
3			# cfmap2idx - inverted index for crossfire maps
4	root	1.5	# Copyright (C) 2005,2007 Marc Lehmann <cfmaps@schmorp.de>
5	root	1.1	#
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	root	1.6	# along with cfmaps; if not, write to the Free Software
18	root	1.1	# Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
19
20	root	1.5	our $VERSION = '0.912';
21	root	1.1
22	root	1.8	use Crossfire;
23	root	1.1	use DB_File;
24
25			sub escape_html($) {
26			local $_ = shift;
27			s/([<>&])/sprintf "&#%d;", ord $1/ge;
28			$_
29			}
30
31	root	1.3	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 "' & '", 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	root	1.5	print "</ul></p><p class='footer'>created by <a href='http://software.schmorp.de/pkg/cfmaps'>cfmapidx</a> version $VERSION</p>",
81	root	1.3	"</body></html>";
82			}
83
84	root	1.1	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	root	1.7	(my $base = $path) =~ s/\.map$//;
94	root	1.1	my $docnum = pack "n", ++$idx{Vdocnum};
95	root	1.7	$idx{"D$docnum"} = $base;
96	root	1.8	my $meta = read_arch "$base.map";
97	root	1.1
98			for my $x (0 .. $meta->{width} - 1) {
99			for my $y (0 .. $meta->{height} - 1) {
100			for my $a (@{ $meta->{map}[$x][$y] }) {
101			for my $v (values %$a) {
102			$v = lc $v;
103	root	1.3	$v =~ y/a-zA-Z0-9_\-.\// /c;
104	root	1.1	for (split /\s+/, $v) {
105			$idx2{$_} .= $docnum;
106
107	root	1.3	if (/[_\-\.\/]/) {
108			$idx2{$_} .= $docnum for (split /[_\-\.\/]/)
109	root	1.1	}
110			}
111			}
112			}
113			}
114			}
115			}
116
117			while (my ($k, $v) = each %idx2) {
118			$idx{$k} = pack "n", keys %{ { map +($_ => 1), unpack "n", $idx{$k}.$v } };
119			}
120
121			} elsif ($ARGV[0] eq "-s") {
122			shift;
123
124	root	1.3	search @ARGV;
125			} else {
126			# assume CGI
127			chdir "/var/www/cfmaps.schmorp.de" or exit 69;
128
129			print <<EOF;
130			Content-Type: application/xhtml+xml
131
132			EOF
133			$ENV{QUERY_STRING} =~ s/^k=//;
134			search split /\s+\|\++\|(?:%20)+/, $ENV{QUERY_STRING};
135	root	1.1	}
136