#!/usr/local/bin/perl5
#
# $Id: report.pl,v 1.13 2009/02/01 04:49:12 winter Exp $
use Data::Dumper;
use HTML::Entities;
use Cfg;
sub
strip_html {
$_ = decode_entities(shift);
$_ =~ s/\s*\<[^\>]+\>\s*//g;
$_ =~ s/[\.\!\?\,]+//g; # errant punctuation
return $_;
}
sub
extract_number {
$_ = strip_html(shift);
if (/=.*[[:digit:]]+/) {
(undef, $_) = split(/=/)
}
if (/([[:digit:]]+)/) {
$i = int($1);
if ($i > 0 && $i < 2001) {
return int($1);
}
}
# if (/one/) {
# return 1;
# }
return undef;
}
sub
detect_comments {
$_ = shift;
$_ =~ s/Posted Via AR15\.Com Mobile//g;
$_ =~ s/
//g; # hard breaks
$_ =~ s/
//g; # hard returns
$_ =~ s/\s*<\/*(a|b|font|i|span|div|img)[^\>]*>\s*//g; # Tags
$_ =~ s/:\)//g; # emoticons
$_ =~ s/\[.*\]//g; # emoticons
$_ =~ s/[\.!?,]+//g; # errant punctuation
$_ =~ s/\s+$//g; # trailing whitespace
$_ =~ s/^\s+//g; # leading whitespace
$_ =~ s/one/1/g;
return grep(/[^[:digit:]]+/, $_) ? 1 : 0;
}
while (<>) {
chop;
($page, $post, $pdate, $edate, $poster, $plevel, $message) = split(/\t/);
next if ($post == 0); # Skip the OP.
$number = extract_number($message);
$comments = detect_comments($message);
$edited = $edate != 0 ? 1 : 0;
push @{ $hash{$poster} },
{
page => int($page),
post => int($post),
level => $plevel,
post_date => int($pdate),
edit_date => int($edate),
edited => $edited,
comments => $comments,
message => $message,
number => $number
};
# Record number, if present
if (defined($number)) {
push @{ $numbers{ $number } }, $poster;
}
}
%posts = (
total => 0,
valid => 0,
dq => 0,
nonumber => 0,
nonteam => 0,
comments => 0,
multiple => 0,
edited => 0
);
foreach $poster ( sort {
$hash{$a}[0]->{page} <=> $hash{$b}[0]->{page}
||
$hash{$a}[0]->{post} <=> $hash{$b}[0]->{post}
} keys %hash ) {
$multiple = 0;
foreach $post ( @{ $hash{$poster} } ) {
if ($#{ $hash{$poster} }) {
if ($post->{message} ne $hash{$poster}[0]->{message}) {
$post->{multiple} = $#{ $hash{$poster} };
$multiple++;
}
} else {
$post->{multiple} = 0;
}
$posts{total}++;
# Record stats
# XXX: nonteam
# $posts{nonteam}++ if $post->{level} eq 'Member';
$posts{comments}++ if $post->{comments};
$posts{multiple}++ if $post->{multiple};
$posts{edited}++ if $post->{edited};
$posts{nonumber}++ if !defined($post->{number});
# # Record number, if present
# if (defined($post->{number})) {
# push @{ $numbers{ $post->{number} } }, $poster;
# }
# Tally valid/dq posts.
# XXX nonteam
# $post->{level} ne 'Member' &&
if (!$post->{comments} &&
!$post->{edited} &&
!$post->{multiple} &&
defined($post->{number})) {
$posts{valid}++;
} else {
$posts{dq}++;
}
}
if ($multiple > 0) {
$hash{$poster}[0]->{multiple} = $multiple;
}
}
@histogram = ( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
foreach $i ( keys %numbers ) {
$histogram[ scalar(@{$numbers{"$i"}}) ]++;
}
$histogram[0] = 2000 - scalar(keys %numbers);
if ($posts{total} != 0) {
$pct_dq = sprintf("%.2f", ($posts{dq} / $posts{total}) * 100.0);
} else {
$pct_dq = "0";
}
$posters = scalar(keys %hash);
$picked = scalar(keys %numbers);
$t = encode_entities($threadURL);
print <<__EOF__;
${title} - Report
Data for last whole page only.
Update checks every 10 minutes.
Last update: \@DATE\@
Last page: \@PAGE\@
See the raw data here.
(Hover mouse over table cell to show number.)
| |
__EOF__
for $i (1 .. 10) {
$t = ($i == 10) ? 0 : $i;
print "\t\t" . $t . " | \n";
}
print "\t
\n";
print "\t\n\t\t| 0 | \n";
$nl = 0;
for $i (1 .. 2000) {
if ($nl) {
$nl = 0;
print "\t
\n";
print "\t\n\t\t| " . ($i - 1) / 100 . " | \n";
}
$c = scalar(@{$numbers{"$i"}}) || 0;
if ($c > 5) { $c = 6; }
print "\t\t | \n";
if ($i % 100 == 0) { $nl = 1; }
}
print "\t
\n";
print "
\n";
print <<__EOF__;
Statistics
| Count |
Category |
| $posts{total} |
total posts. |
| $posts{valid} |
valid posts |
| $posts{dq} |
disqualified posts (${pct_dq}%) |
| $posts{nonumber} |
no number posts |
| $posts{nonteam} |
nonteam posts |
| $posts{comments} |
commented posts |
| $posts{multiple} |
multiple posts |
| $posts{edited} |
edited posts |
| ${posters} |
unique posters. |
| ${picked} |
Numbers picked |
Histogram
| Color |
Picks |
Count |
__EOF__
for $i ( 0 .. $#histogram ) {
$c = ($i % 2) ? "d" : "l";
$t = ($i > 5) ? 6 : $i;
print <<__EOF__;
| |
$i |
$histogram[$i] |
__EOF__
}
print <<__EOF__;
$posts{nonumber} Posts with no or invalid number
| Poster |
Page |
Post |
Membership |
Message |
__EOF__
$i = 1;
foreach $poster ( sort {
$hash{$a}[0]->{page} <=> $hash{$b}[0]->{page}
||
$hash{$a}[0]->{post} <=> $hash{$b}[0]->{post}
} keys %hash ) {
foreach $post ( @{ $hash{$poster} } ) {
next if (defined($post->{number}));
$c = ($i++ % 2) ? "l" : "d";
$t = encode_entities($post->{message}) || " ";
print <<__EOF__;
| $poster |
$post->{page} |
$post->{post} |
$post->{level} |
$t |
__EOF__
}
}
print <<__EOF__;
$posts{nonteam} Non Team Member posts
| Poster |
Page |
Post |
Number |
Membership |
__EOF__
$i = 1;
foreach $poster ( sort {
$hash{$a}[0]->{page} <=> $hash{$b}[0]->{page}
||
$hash{$a}[0]->{post} <=> $hash{$b}[0]->{post}
} keys %hash ) {
foreach $post ( @{ $hash{$poster} } ) {
next; # XXX nonteam
next if $post->{level} ne 'Member';
$c = ($i++ % 2) ? "l" : "d";
$n = $post->{number} || " ";
print <<__EOF__;
| $poster |
$post->{page} |
$post->{post} |
$n |
$post->{level} |
__EOF__
}
}
print <<__EOF__;
${posts{multiple}} Multiple posts
| Poster |
Page |
Post |
Number |
Membership |
__EOF__
$i = 1;
foreach $poster ( sort {
$hash{$a}[0]->{page} <=> $hash{$b}[0]->{page}
||
$hash{$a}[0]->{post} <=> $hash{$b}[0]->{post}
} keys %hash ) {
next if !$hash{$poster}[0]->{multiple};
foreach $post ( @{ $hash{$poster} } ) {
$c = ($i++ % 2) ? "l" : "d";
$n = $post->{number} || " ";
print <<__EOF__;
| $poster |
$post->{page} |
$post->{post} |
$n |
$post->{level} |
__EOF__
}
}
print <<__EOF__;
${posts{edited}} Edited posts
| Poster |
Page |
Post |
Number |
Membership |
__EOF__
$i = 1;
foreach $poster ( sort {
$hash{$a}[0]->{page} <=> $hash{$b}[0]->{page}
||
$hash{$a}[0]->{post} <=> $hash{$b}[0]->{post}
} keys %hash ) {
foreach $post ( @{ $hash{$poster} } ) {
next if !$post->{edited};
$c = ($i++ % 2) ? "l" : "d";
$n = $post->{number} || " ";
print <<__EOF__;
| $poster |
$post->{page} |
$post->{post} |
$n |
$post->{level} |
__EOF__
}
}
print <<__EOF__;
$posts{valid} Entries
| Number |
Picks |
Posters (valid, multiple, edited, , non-team) |
__EOF__
for $i ( 1 .. 2000 ) {
$c = ($i % 2) ? "l" : "d";
$n = scalar(@{$numbers{"$i"}}) || 0;
undef @list;
foreach $poster ( @{ $numbers{"$i"} } ) {
$_ = $hash{$poster}[0];
if ($_->{multiple}) {
push @list, "$poster";
$n--;
# XXX nonteam
# } elsif ($_->{level} eq 'Member') {
# push @list, "$poster";
# $n--;
} elsif ($_->{edited}) {
push @list, "$poster";
$n--;
} elsif ($_->{comments}) {
push @list, "";
$n--;
} else {
push @list, $poster;
}
}
$t = join(', ', @list) || " ";
print <<__EOF__;
| $i |
$n |
$t |
__EOF__
}
print <<__EOF__;
__EOF__