print pure check details to IRC
[divverent/nexuiz.git] / server / rcon2irc / rbiserver.pl
1 sub out($$@);
2
3 sub markmap($$$$;$)
4 {
5         my ($state, $map, $pro, $total, $who) = @_;
6         open my $fh, '>>', "$ENV{HOME}/.nexuiz/__votelog.$config{irc_nick}.txt"
7                 or die "votelog open: $!";
8         print $fh "@{[time()]} $config{irc_nick} $state $map $pro $total" . (defined $who ? " $who" : "") . "\n";
9         close $fh;
10 }
11
12 # the AOL calendar
13 [ dp => q{\001(.*?)\^7: d} => sub {
14         my $aoltime = time() - 746748000;
15         my $day = int($aoltime / 86400);
16         my $wday = [qw[Tue Wed Thu Fri Sat Sun Mon]]->[$day % 7];
17         my $hour = int($aoltime / 3600) % 24;
18         my $minute = int($aoltime / 60) % 60;
19         my $second = int($aoltime / 1) % 60;
20         out dp => 0, sprintf 'rcon2irc_say_as "AOL service" "The time is %3s Sep %2d %02d:%02d:%02d 1993"',
21                 $wday, $day, $hour, $minute, $second;
22         return 1;
23 } ],
24
25 # map vote logging
26 [ dp => q{:vote:suggestion_accepted:(.*)} => sub {
27         my ($map) = @_;
28         markmap suggestion_accepted => $map, $store{rbi_winvotes}, $store{rbi_totalvotes};
29         return 0;
30 } ],
31 [ dp => q{:vote:suggested:(.*?):\d+:(.*)} => sub {
32         my ($map, $who) = @_;
33         markmap suggested => $map, 1, 1, $who;
34         return 0;
35 } ],
36 [ dp => q{\001\^2\* .*'s vote for \^1gotomap (.*)\^2 was accepted} => sub {
37         my ($map) = @_;
38         markmap voted => $map, 1, 1;
39         return 0;
40 } ],
41 [ dp => q{\001\^2\* .*'s vote for \^1timelimit -1\^2 was accepted} => sub {
42         markmap cancelled => $store{map}, 1, 1;
43         return 0;
44 } ],
45 [ dp => q{:vote:(keeptwo|finished):(.*)} => sub {
46         my ($status, $result) = @_;
47         my @result = split /:/, $result;
48         my $totalvotes = 0;
49         my $cutoff = -1;
50         my @allmaps = map
51         {
52                 $cutoff = $_ if $result[2*$_] eq '';
53                 $totalvotes += int($result[2*$_+1] || 0);
54                 [$result[2*$_], int($result[2*$_+1] || 0)]
55         } 0..((@result-1)/2);
56         die "Invalid vote result: $result" unless $cutoff >= 0;
57         my @winners = @allmaps[0..($cutoff-1)];
58         my @losers = @allmaps[($cutoff+1)..(@allmaps-1)];
59         my $winvotes = 0;
60         $winvotes += $_->[1] for @winners;
61         if($status eq 'keeptwo')
62         {
63                 markmap irrelevant_relative => $_->[0], $winvotes, $totalvotes
64                         for @losers;
65         }
66         elsif($status eq 'finished')
67         {
68                 markmap((@losers == 1 ? 'duel_winner' : 'winner_absolute') => $_->[0], $_->[1], $totalvotes)
69                         for @winners;
70                 markmap((@losers == 1 ? 'duel_loser' : 'irrelevant_absolute') => $_->[0], $winvotes, $totalvotes)
71                         for @losers;
72         }
73         $store{rbi_winvotes} = $winvotes;
74         $store{rbi_totalvotes} = $totalvotes;
75         return 0;
76 } ],
77 [ dp => q{pure: -(\S+) (.*)} => sub {
78         my ($status, $nick) = @_;
79         $nick = color_dp2irc $nick;
80         out irc => 0, "PRIVMSG $config{irc_channel} :\001ACTION thinks $nick is $status\001";
81         return 0;
82 } ],
83 [ dp => q{pure: \*DETAIL_MISMATCH (.*) (\S+)$} => sub {
84         my ($nick, $file) = @_;
85         $nick = color_dp2irc $nick;
86         out irc => 0, "PRIVMSG $config{irc_channel} :\001ACTION thinks $nick has a modified $file\001";
87         return 0;
88 } ],
89 [ dp => q{pure: \*DETAIL_TIMEOUT (.*)} => sub {
90         my ($nick) = @_;
91         $nick = color_dp2irc $nick;
92         out irc => 0, "PRIVMSG $config{irc_channel} :\001ACTION thinks $nick refuses to tell us which file is modified\001";
93         return 0;
94 } ],
95 [ dp => q{:recordset:(\d+):.*} => sub {
96         my ($id) = @_;
97         my $ip = $store{"playerip_byid_$id"};
98         my $slot = $store{"playerslot_byid_$id"};
99         my $name = $config{irc_nick};
100         $name =~ s/Nex//; # haggerNexCTF -> haggerCTF
101         my $map = $store{map};
102         $map =~ s/^[a-z]*_//;
103         $ip =~ s/\./-/g;
104         my $pattern = "/home/nexuiz/home-$name/data/sv_autodemos/????-??-??_??-??_${map}_${slot}_${ip}-*.dem";
105         if(my @result = glob $pattern)
106         {
107                 for(@result)
108                 {
109                         my @l = stat $_;
110                         next if $l[9] < time() - 60; # too old
111                         print "Cleaning up demos: protecting $_\n";
112                         chmod 0444, $_;
113                         open my $fh, ">", "$_.nick";
114                         printf $fh "%s\n", color_dp2none($store{"playernickraw_byid_$id"});
115                         close $fh;
116                         chmod 0444, "$_.nick";
117                 }
118         }
119         else
120         {
121                 print "Record set but could not find the demo using $pattern\n";
122         }
123         return 0;
124 } ],
125 # delete demos at the end of the match
126 [ dp => q{:end} => sub {
127         my $name = $config{irc_nick};
128         $name =~ s/Nex//; # haggerNexCTF -> haggerCTF
129         my $pattern = "/home/nexuiz/data/home-$name/data/sv_autodemos/*.dem";
130         print "Checking $pattern...\n";
131         for(glob $pattern)
132         {
133                 next if not -w $_;   # protected demo (by record, or other markers)
134                 my @l = stat $_;
135                 next if $l[9] >= time() - 60; # too new
136                 print "Cleaning up demos: deleting $_\n";
137                 unlink $_;
138         }
139         return 0;
140 } ],