diff options
Diffstat (limited to 'bin/htmlwish')
| -rwxr-xr-x | bin/htmlwish | 126 |
1 files changed, 126 insertions, 0 deletions
diff --git a/bin/htmlwish b/bin/htmlwish new file mode 100755 index 0000000..e8eb662 --- /dev/null +++ b/bin/htmlwish @@ -0,0 +1,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 + +} + |