1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
#!/usr/bin/perl
use strict;
use warnings;
# I have no idea how long this will take...
# Should probably run it with a nice of 10 or something.
# Sample usage: ./nao_wishes.pl ttyrec oldttyrec
# I could modify it to work on a player-by-player basis
# easy to add caching too
# One problem with this is that it'll take so long that it can never be
# perfectly accurate unless people just stop playing (or at least, wishing)
# TODO: make it understand wishes better
# (i.e. "The Orb of Fate" == "Orb of Fate"
# could probably just get rid of "greased" and "fixed" too
my $output_with_numbers = 'wishes.html';
my $output_without_numbers = 'wishes-n.html';
my %wishes;
my %wishes_n;
my $total = 0;
while (@ARGV)
{
my $file = shift @ARGV;
next if $file =~ m{(?:^|/)\.+$};
if (-d $file)
{
print STDERR "Recursing into $file\n";
opendir(my $dirhandle, $file) or next;
push @ARGV, map {"$file/$_"} readdir($dirhandle);
close $dirhandle;
}
else
{
next unless $file =~ /\.ttyrec(\.bz2)?$/;
print STDERR "Working on $file\n";
my $output;
if (defined($1))
{
$output = `bzcat $file | ttywish`;
}
else
{
$output = `cat $file | ttywish`;
}
foreach my $wish (split /\n/, $output)
{
$wish =~ s/^[^ ]+ //;
$wish =~ s/ (?:named|called).*$//;
$wishes{$wish}++;
$wish =~ s/\d+/N/g;
$wishes_n{$wish}++;
}
}
}
foreach my $count (values %wishes)
{
$total += $count;
}
foreach my $file ($output_with_numbers, $output_without_numbers)
{
open(my $handle, '>', $file) or die "Unable to open '$file': $!";
my $numbers = $file eq $output_with_numbers;
my $title = $numbers ? "NetHack wishes" : "NetHack wishes without numbers";
print {$handle} << "EOHD";
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
"http://www.w3.org/TR/html4/loose.dtd">
<HTML><HEAD><TITLE>alt.org - $title</TITLE>
<link rel="icon" href="http://alt.org/nethack/alt_favicon.png"><link rel="shortcut icon" href="http://alt.org/nethack/alt_favicon.png"><link rel="stylesheet" type="text/css" href="http://alt.org/nethack/altorg.css">
</HEAD>
<BODY>
<DIV class="headerbar">
<A class="header" href="/"><IMG src="http://alt.org/images/altorgheader.png" class="header" alt="alt.org"></A>
</DIV>
<DIV class="body">
<H1>$title</H1>
<BR>
<TABLE>
<TR>
<TH>Rank</TH>
<TH align="right">Number</TH>
<TH>Percentage</TH>
<TH> Wish</TH>
</TR>
EOHD
my $rank = 0;
my %w = $numbers ? %wishes : %wishes_n;
foreach my $wish (sort {$w{$b} <=> $w{$a} || $a cmp $b} keys %w)
{
printf $handle "<TR class=\"%s\"><TD>%d</TD><TD align=\"RIGHT\">%d </TD><TD> %.2f</TD><TD> %s</TD></TR>\n", ($rank % 2 ? 'odd' : 'even'), ++$rank, $w{$wish}, 100 * $w{$wish} / $total, $wish;
}
# not quite the same format as the rest of NAO, but close enough
my $time = localtime;
print {$handle} << "EOHD2";
</TABLE><P class="lastupdate">This page last updated on $time</P></DIV>
<DIV class="footertxt">All original content on this site is
copyright (c)2000-2113 M. Drew Streib and licensed under the
<A href="http://www.opencontent.org/opl.shtml">OpenContent
License</A> unless otherwise noted.</DIV>
<DIV class="footerbar"></DIV>
</BODY>
</HTML>
EOHD2
}
|
