WebSVN - LCARS - Diff - Rev 11 and 13 - /trunk/tools/network/news/newsstat/newsstat.pl


#!/usr/bin/env perl
use strict;
use warnings;
use diagnostics;
use utf8;
 
use Encode;

## Print out all text to STDOUT UTF-8 encoded
binmode STDOUT, ':encoding(UTF-8)';

############################
## newsstat.pl version 0.4.3

###########################################################################
## Collect statistics about a newsgroup (specified by first argument)
## in the local news spool. Check all articles in the last 30-day period.
## Rank posters by number of posts and by volume of posts, report on top
## and bottom 20 posters. Show their name, number of posts, size of posts,
## percentage of quoted lines. Rank user-agents used, by poster rather
## than by post. Rank top 20 threads. Rank top 10 cross-posted groups.
##
## Numbers and paths can be configured below.  See ChangeLog and TODO
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
## for more.  -- PE
###########################################################################

###################### USER CONFIGURATIONS ############################

## The name of the group to do stats for
my $newsgroup_name = $ARGV[0];
$newsgroup_name or &usage;

## Check for removal flags
my $ix;
my $j;
my %skipSec;
my @skiplist;
my $args = @ARGV;
for ( $ix = 1 ; $ix < $args ; $ix++ )
{
  $j = $ix + 1;
  if ( $ARGV[$ix] eq "-x" )
  {
    @skiplist = split( ",", $ARGV[$j] );
  }
  elsif ( $ARGV[$ix] =~ /-x(\d.*)/ )
  {
    @skiplist = split( ",", $1 );
  }
}
foreach (@skiplist)
{
  $skipSec{$_} = 1;
}

## Leafnode users will want /var/spool/news for this variable.
my $news = "/var/spool/news/";

## How many days are we doing statistics for?
my $numdays = 30;

## Number of agents we list
my $topagents = 10;

## Number of threads we want to know about
my $topthreads = 20;

## Number of top or bottom posters to show
my $topposters = 20;

## Number of cross-posted threads to show
my $topcrossposts = 10;

## Number of time zones to show
my $toptz = 10;

###################### DATA STRUCTURES ######################
my $group = $newsgroup_name;
$group =~ s!\.!/!g;
my %data;          # name, count, agent, total, orig, quoted
my %threads;       # subject, count
my %crossposts;    # group, count
my %tz;            # timezones by count
my %headers;       # holds header of current article
my %lcheader;      # holds lowercase headers
my @body;          # holds body of current article
my @sig;           # holds sig text;
my $totalposts;    # total no. of posts considered
my $filename;      # name of current article file
my $filesize;      # size of current article file
my $earliest;      # earliest article we have found
my $latest;        # latest article we have found
my $poster;        # poster we are dealing with
my $totsize   = 0; # holds total sizes of all files
my $totheader = 0; # total size of header material
my $totbody   = 0; # total size of body material
my $totsig    = 0; # total size of sig material
my $totorig   = 0; # total size of original material
my $totquoted = 0; # total size of quoted material
my $origposts = 0; # total no. of original posts
my $replies   = 0; # total no. of replies
my $i;             # general purpose
my %distinct_agent;
 

## Used to hold counts of User Agents used
 
my %agents = (
  "Compuserver"               => 0,
  "Foorum"                    => 0,
  "Forte Agent"               => 0,
  "Forte Free Agent"          => 0,
  "Gnus"                      => 0,
  "KNode"                     => 0,
  "MacSOUP"                   => 0,
  "MT-NewsWatcher"            => 0,
  "MicroPlanet Gravity"       => 0,
  "Microsoft Outlook Express" => 0,
  "Microsoft Windows Mail"    => 0,
  "Mozilla"                   => 0,
  "News Rover"                => 0,
  "NN"                        => 0,
  "Pan"                       => 0,
  "rn"                        => 0,
  "slrn"                      => 0,
  "Sylpheed"                  => 0,
  "tin"                       => 0,
 
 
 
  "VSoup"                     => 0,
 
 
  "WebTV"                     => 0,
 
  "Xnews"                     => 0
);

######################## MAIN CODE ########################
$! = 1;

chdir("$news$group") or die "Can't cd to $news$group: $!\n";
opendir( DIR, "." ) or die "Can't open $news$group directory: $!\n";
while ( defined( $filename = readdir(DIR) ) )
{
  %lcheader = ();
  next unless -f $filename;               # only want real files
  next if ( $filename eq ".overview" );   # real articles only
  next if ( -M $filename > $numdays );    # only want articles <= a certain age
  $earliest = ( stat $filename )[9] unless defined($earliest);
  $latest   = ( stat $filename )[9] unless defined($latest);
  &get_article($filename);                 # read in the article
  &get_data;                               # grab the data from the article
  $totalposts++;                          # bump count of articles considered
}
closedir(DIR);                            # finished with the directory

## Post-processing
&count_agents;    # count agents, collapsing versions
&fix_percent;     # check percentages orig/total for posters

&write_data;

#################### DISPLAY RESULTS #####################
print "=" x 76, "\n";
printf "%s\n", &centred( "Analysis of posts to $newsgroup_name", 76 );
print "=" x 76, "\n";
printf "%s\n",
  &centred( "(stats compiled with a script by Garry Knight et al.)", 76 );
print "\n\n";
printf "Total posts considered: %s over %d days\n", commify($totalposts),
  $numdays;
printf "Earliest article: %s\n",               scalar localtime($earliest);
printf "Latest article:   %s\n",               scalar localtime($latest);
printf "Original articles: %s, replies: %s\n", commify($origposts),
  commify($replies);
printf "Total size of posts: %s bytes (%s KiB) (%.2f MiB)\n", commify($totsize),
  commify( int( $totsize / 1024 ) ), $totsize / 1048576;    #
printf "Average %s articles per day, %.2f MiB per day, %s bytes per article\n",
  commify( int( $totalposts / $numdays ) ), $totsize / $numdays / 1048576,
  commify( int( $totsize / $totalposts ) );
my $count = keys %data;
printf "Total headers: %s KiB  bodies: %s KiB\n",
  commify( int( $totheader / 1024 ) ), commify( int( $totbody / 1024 ) );
printf "Body text - quoted: %s KiB,  original: %s KiB = %02.2f%%, sigs: %s KiB\n",
  commify( int( $totquoted / 1024 ) ), commify( int( $totorig / 1024 ) ),
  ( $totorig * 100 ) / ( $totorig + $totquoted ),
  commify( int( $totsig / 1024 ) );
printf "Total number of posters: %s, average %s bytes per poster\n",
  commify($count), commify( int( $totsize / $count ) );     #/
$count = keys %threads;
printf "Total number of threads: %s, average %s bytes per thread\n",
  commify($count), commify( int( $totsize / $count ) );     #/
printf "Total number of user agents: %d\n", scalar keys %agents;
print "\n", "=" x 76, "\n";

########################################
## Show posters by article count  Sec 1;
########################################
unless ( $skipSec{1} )
{
  if ( keys %data < $topposters )
  {
    $count = keys %data;
  }
  else
  {
    $count = $topposters;
  }
  printf "%s\n", &centred( "Top $count posters by number of articles", 76 );
  print "=" x 76, "\n";
  $i = 0;
  foreach
    my $poster ( sort { $data{$b}{count} <=> $data{$a}{count} } keys %data )
  {
    my $name = substr( $poster, 0, 65 );
    printf "%2d: %-63s : %6d\n", $i + 1, rpad( $poster, 63, "." ),
      $data{$poster}{count};
    last if ( ++$i == $count );
  }
  print "\n", "=" x 76, "\n";
}

######################################
## Show posters by size in KiB  Sec 2;
######################################
unless ( $skipSec{2} )
{
  if ( keys %data < $topposters )
  {
    $count = keys %data;
  }
  else
  {
    $count = $topposters;
  }
  printf "%s\n", &centred( "Top $count posters by article size in KiB", 76 );
  print "=" x 76, "\n";
  $i = 0;
  foreach my $poster ( sort { $data{$b}{size} <=> $data{$a}{size} } keys %data )
  {
    my $name = substr( $poster, 0, 62 );
    printf "%2d: %-63s : %6d\n", $i + 1, rpad( $poster, 63, "." ),
      $data{$poster}{size} / 1024;    #/
    last if ( ++$i == $count );
  }
  print "\n", "=" x 76, "\n";
}

#####################################
## Show top posters for original text
#####################################
unless ( $skipSec{3} )
{
  if ( keys %data < $topposters )
  {
    $count = keys %data;
  }
  else
  {
    $count = $topposters;
  }
  printf "%s\n",
    &centred( "Top $count responders by original text (> 5 posts)", 76 );
  print "=" x 76, "\n";
  $i = 0;
  foreach my $poster (
    sort { $data{$b}{percent} <=> $data{$a}{percent} }
    keys %data
    )
  {
    next if $data{$poster}{quoted} == 0;
    next if $data{$poster}{count} < 5;
    my $name = substr( $poster, 0, 63 );
    printf "%2d: %-63s : %02.2f%%\n", $i + 1, rpad( $poster, 63, "." ),
      $data{$poster}{percent};
    last if ( ++$i == $count );
  }
  print "\n", "=" x 76, "\n";
}

########################################
## Show bottom posters for original text
########################################
unless ( $skipSec{4} )
{
  if ( keys %data < $topposters )
  {
    $count = keys %data;
  }
  else
  {
    $count = $topposters;
  }
  printf "%s\n",
    &centred( "Bottom $count responders by original text  (> 5 posts)", 76 );
  print "=" x 76, "\n";
  $i = 0;
  foreach my $poster (
    sort { $data{$a}{percent} <=> $data{$b}{percent} }
    keys %data
    )
  {
    next if $data{$poster}{quoted} == 0;
    next if $data{$poster}{count} < 5;
    my $name = substr( $poster, 0, 63 );
    printf "%2d: %-63s : %02.2f%%\n", $i + 1, rpad( $poster, 63, "." ),
      $data{$poster}{percent};
    last if ( ++$i == $count );
  }
  print "\n", "=" x 76, "\n";
}

#####################################
## Show threads by number of articles
#####################################
unless ( $skipSec{5} )
{
  if ( keys %threads < $topthreads )
  {
    $count = keys %threads;
  }
  else
  {
    $count = $topthreads;
  }
  printf "%s\n", &centred( "Top $count threads by no. of articles", 76 );
  print "=" x 76, "\n";
  $i = 0;
  foreach my $thread (
    sort { $threads{$b}{count} <=> $threads{$a}{count} }
    keys %threads
    )
  {
    my $name = substr( $thread, 0, 65 );
    printf "%2d: %-63s : %6d\n", $i + 1, rpad( $name, 63, "." ),
      $threads{$thread}{count};
    last if ( ++$i == $count );
  }
  print "\n", "=" x 76, "\n";
}

##############################
## Show threads by size in KiB
##############################
unless ( $skipSec{6} )
{
  if ( keys %threads < $topthreads )
  {
    $count = keys %threads;
  }
  else
  {
    $count = $topthreads;
  }
  printf "%s\n", &centred( "Top $count threads by size in KiB", 76 );
  print "=" x 76, "\n";
  $i = 0;
  foreach my $thread (
    sort { $threads{$b}{size} <=> $threads{$a}{size} }
    keys %threads
    )
  {
    my $name = substr( $thread, 0, 65 );
    printf "%2d: %-63s : %6d\n", $i + 1, rpad( $name, 63, "." ),
      $threads{$thread}{size} / 1024;    #/
    last if ( ++$i == $count );
  }
  print "\n", "=" x 76, "\n";
}

##################################
## Show top 10 cross-posted groups
##################################
unless ( $skipSec{7} )
{
  delete $crossposts{"$newsgroup_name"};    # don't include ours
  if ( keys %crossposts < $topcrossposts )
  {
    $count = keys %crossposts;
  }
  else
  {
    $count = $topcrossposts;
  }
  printf "%s\n", &centred( "Top $count cross-posted groups", 76 );
  print "=" x 76, "\n";
  $i = 0;
  foreach
    my $name ( sort { $crossposts{$b} <=> $crossposts{$a} } keys %crossposts )
  {
    printf "%2d: %-63s : %6d\n", $i + 1, rpad( $name, 63, "." ),
      $crossposts{$name};
    last if ( ++$i == $count );
  }
  print "\n", "=" x 76, "\n";
}

#########################
## Show agents and counts
#########################
unless ( $skipSec{8} )
{
  if ( keys %agents < $topagents )
  {
    $count = keys %agents;
  }
  else
  {
    $count = $topagents;
  }
  printf "%s\n", &centred( "Top $count User Agents by poster", 76 );
  print "=" x 76, "\n";
  $i = 0;
  foreach my $agent ( sort { $agents{$b} <=> $agents{$a} } keys %agents )
  {
    printf "%2d: %-63s : %6d\n", $i + 1, rpad( $agent, 63, "." ),
      $agents{$agent};
    last if ( ++$i == $count );
  }
  print "\n", "=" x 76, "\n";
}

#######################
## Show distinct agents
#######################
unless ( $skipSec{9} )
{
  if ( keys %distinct_agent < $topagents )
  {
    $count = keys %distinct_agent;
  }
  else
  {
    $count = $topagents;
  }
  printf "%s\n", &centred( "Top $count User Agents by number of posts", 76 );
  print "=" x 76, "\n";
  $i = 0;
  foreach my $agent (
    sort { $distinct_agent{$b} <=> $distinct_agent{$a} }
    keys %distinct_agent
    )
  {
    printf "%2d: %-58s : %5d (%2.f%%)\n", $i + 1, rpad( $agent, 58, "." ),
      $distinct_agent{$agent},
      ( ( $distinct_agent{$agent} / $totalposts ) * 100 );
    last if ( ++$i == $count );
  }
  print "\n", "=" x 76, "\n";
}

############################
## Show timezones and counts
############################
unless ( $skipSec{10} )
{
  if ( keys %tz < $toptz )
  {
    $count = keys %tz;
  }
  else
  {
    $count = $toptz;
  }
  printf "%s\n", &centred( "Top 10 time zones", 76 );
  print "=" x 76, "\n";
  $i = 0;
  foreach my $zone ( sort { $tz{$b} <=> $tz{$a} } keys %tz )
  {
    printf "%2d: %-63s : %6d\n", $i + 1, rpad( $zone, 63, "." ), $tz{$zone};
    last if ( ++$i == $count );
  }
  print "\n", "=" x 76, "\n";
}

################################ SUBROUTINES ################################

########################################
## Get current article's header and body
########################################
sub get_article
{
  %headers = ();    # dump old headers
  my $filename = shift;    # get the name of the file

  ## get stats about the file itself
  $filesize = -s $filename;    # get total size of file
  $totsize += $filesize;       # bump total sizes of all files

  my $mtime = ( stat $filename )[9];
  if ( $mtime < $earliest )
  {
    $earliest = $mtime;
  }
  elsif ( $mtime > $latest )
  {
    $latest = $mtime;
  }

  ## now read the file
  open( my $FILE, '<', $filename ) or die "Can't open $filename: $!\n";
  while (<$FILE>)
  {
    $totheader += length($_);    # bump total header size
    last if (/^\s*$/);           # end of header?
    if (/^([^:\s]*):\s*(.*)/)
    {
      my ( $key, $val ) = ( $1, $2 );
      $headers{$key} = decode( 'MIME-Header', $val );
      $lcheader{ clean( lc($key) ) } = clean($val);
    }
  }
  @body = <$FILE>;               # slurp up body
  close($FILE);
}    # get_article

####################################
## Get data from the current article
####################################
sub get_data
{
#### First, analyse header fields ####

  ## Set up this poster if not defined, get counts, sizes
  my $poster = $headers{From};    # get the poster's name
 
  # Convert old to new format
  $poster =~ s/^\s*(.+?\@.+?)\s*\((.+?)\)\s*$/$2 <$1>/;
 
  # Collapse whitespace
  $poster =~ s/\s+/ /;
 
  # Remove outer quotes
  $poster =~ s/^["'](.+?)["']\s+(.*)/$1 $2/;
 
  if ( !defined( $data{$poster} ) )
  {                               # seen this one before?
    $data{$poster}{agent}  = 'Unknown';    # comes after For: field
    $data{$poster}{orig}   = 0;
    $data{$poster}{quoted} = 0;
  }
  $data{$poster}{count}++;                 # bump count for this poster
  $data{$poster}{size} += $filesize;       # total size of file

  ## The User-Agent and/or X-Newsreader fields
  ## for User-Agent by poster
  if ( defined $lcheader{"user-agent"} )
  {
    $data{$poster}{agent} = $lcheader{"user-agent"};
  }
  if ( defined $lcheader{"x-newsreader"} )
  {
    $data{$poster}{agent} = $lcheader{"x-newsreader"};
  }

  ## The User Agent for User-Agent by number of posts
  my $UA = "unknown";
  foreach my $keys ( keys %lcheader )
  {
    if ( defined $lcheader{'user-agent'} )
    {
      $UA = $lcheader{'user-agent'};
    }
    elsif ( defined $lcheader{"x-newsreader"} )
    {
      $UA = $lcheader{"x-newsreader"};
    }
    elsif ( defined $lcheader{'x-mailer'} )
    {
      $UA = $lcheader{'x-mailer'};
    }
    elsif (
      ( defined $lcheader{'organization'} )
      && ( $lcheader{'organization'} =~
        /groups\.google|AOL|Supernews|WebTV|compuserve/ )
      )
    {
      $UA = $lcheader{'organization'};
    }
    elsif ( $lcheader{'message-id'} =~ /pine/i )
    {
      $UA = "Pine";
    }    ## Hopefully found UA, else set to unknown
  }

  $UA = clean($UA);
  $UA = get_agent($UA);

  sub get_agent
  {
    my $raw   = shift;
    my $agent = $raw;

    ## strip http
    if ( $raw =~ /.*http.*/ )
    {
      $raw =~ s!posted via!!i;
      $raw =~ s!http://!!g;
      $raw =~ s!/!!g;
      $raw =~ s! !!g;
    }

    ## Fix Outlook from Mac
    if ( $raw =~ /^microsoft/i ) { $raw =~ s/-/ /g; }

    ## Pick out the popular agents
    if (
           $raw =~ /(outlook express)/i
        || $raw =~ /(windows mail)/i
        || $raw =~ /(microplanet gravity)/i
        || $raw =~ /(news rover)/i
        || $raw =~ /(forte agent)/i
        || $raw =~ /(forte free agent)/i
      )
    {
      $agent = $1;
    }
    elsif (
      $raw =~ /^(
        pan
       |sylpheed
       |slrn
       |mozilla
       |knode
       |tin
       |hamster
       |xrn
       |xnews
       |aol
       |gnus
       |krn
       |macsoup
       |messenger
       |openxp
       |pine
       |thoth
       |turnpike
       |winvn
       |vsoup
       |google
       |supernews
       |nn
       |rn
       |007
       |webtv
       |compuserve
       )/ix
      )
    {
      $agent = $1;
    }
    else
    {
      ## Clean up unknown agents
      if ( $raw =~ m!^(.*?)/! )
      {
        $agent = $1;
      }
      elsif ( $raw =~ /^(\w*)\d.*/ )
      {
        $agent = $1;
      }
    }

    $distinct_agent{$agent}++;
    return $agent;
  }

  ## Get all cross-posted newsgroups
  for ( split /,/, $headers{"Newsgroups"} )
  {
    $crossposts{$_}++;    # bump count for each
  }

  ## Get threads
  my $thread = $headers{"Subject"};
  $thread =~ s/^re: //i;    # Remove Re: or re: at start
  $thread =~ s/\s+/ /g;     # collapse whitespace
  $threads{$thread}{count} += 1;            # bump count of this subject
  $threads{$thread}{size}  += $filesize;    # bump bytes for this thread

  ## Is this an original post or a reply?
  if ( defined $headers{"References"} )
  {
    $replies++;
  }
  else
  {
    $origposts++;
  }

  ## Get the time zone
  $_ = $headers{"Date"};
  my ($tz) = /\d\d:\d\d(?::\d\d)?\s+(.*)/;
  if ( ( $tz =~ /UTC/ ) or ( $tz =~ /GMT/ ) or ( $tz =~ /0000/ ) )
  {
    $tz = "UTC";
  }
  $tz{$tz}++;

#### Now analyse the body text ####
  my $insig = 0;
  for (@body)
  {
    $totbody += length($_);    # bump total body size
    next if (/^$>/);           # don't count blank lines in body
    if ( $insig == 1 )
    {
      $totsig += length($_);    # bump total sig size

      ## Bill Unruh uses ] quotes, and another poster uses ::
    }
    elsif ( /^\s*[>\]]/ or /^\s*::/ )
    {                           # are we in a quote line?
      $data{$poster}{quoted} += length($_);    # bump count of quoted chrs
      $totquoted += length($_);
    }
    elsif (/-- /)
    {
      $insig = 1;
    }
    else
    {

      ## We must be processing an original line
      $data{$poster}{orig} += length($_);      # bump count of original chrs
      $totorig += length($_);
    }
  }    # end for (@body)

}    # get_data

#########################################
## Count the User-Agents used, collapsing
## different versions into one per agent.
#########################################
sub count_agents
{
POSTER:
  foreach my $poster ( keys %data )
  {
    foreach my $agent_name ( keys %distinct_agent )
    {    # check against known ones
      if ( $data{$poster}{agent} =~ /\Q$agent_name\E/ )
      {
        $agents{$agent_name}++;
        next POSTER;
      }
    }
    $agents{ $data{$poster}{agent} }++;
  }
}    # count_agents

#############################################
## Set orig/total percentages for all posters
#############################################
sub fix_percent
{
  foreach my $poster ( keys %data )
  {
    my $percent = 100;
    if ( ( $data{$poster}{orig} != 0 ) and ( $data{$poster}{quoted} != 0 ) )
    {
      $percent =
        $data{$poster}{orig} * 100 /
        ( $data{$poster}{quoted} + $data{$poster}{orig} );    #/
    }
    elsif ( $data{$poster}{orig} == 0 )
    {
      $percent = 0;
    }
    $data{$poster}{percent} = $percent;
  }
}

###############################
## Right pad a string with '.'s
###############################
sub rpad
{
  ## Get text to pad, length to pad, pad chr
  my ( $text, $pad_len, $pad_chr ) = @_;

  ## DEBUG
#printf "|%s| = %d\n", $text, length($text);

  if ( length($text) > $pad_len )
  {
    $text = substr( $text, 0, $pad_len );
  }
  my $padded = $text . $pad_chr x ( $pad_len - length($text) );
  return $padded;
}

##################
## Centre a string
##################
sub centred
{
  my ( $text, $width ) = @_;    # text to centre, size of field to centre in
  my $pad_len = ( $width - length($text) ) / 2;    #/
  my $centred = " " x $pad_len . $text;
  return $centred;
}

###########################
## Put commas into a number
###########################
sub commify
{
  local $_ = shift;
  1 while s/^([-+]?\d+)(\d{3})/$1,$2/;
  return $_;
}

################################################################
## Returns a string with leading and trailing whitespace removed
################################################################
sub clean
{
  my $dirty = shift;
  my $clean = $dirty;
 
  $clean =~ s/^\s*|\s*$//g;

  return $clean;
}

sub usage
{
 
  print "usage: newstat.pl newsgroupname\n";
  exit 1;
}

##################################
## Write data structures to a file
##################################
sub write_data
{
  open my $OUTF, ">:encoding(UTF-8)", "/tmp/XDATA"
    or die "Can't create XDATA: $!\n";
  print $OUTF "Data collected from $newsgroup_name\n\n";
  print $OUTF
    "Poster Data\nname : agent : count : size: orig : quoted : per cent\n";
  foreach my $name ( keys %data )
  {
    print $OUTF
"$name : $data{$name}{agent} : $data{$name}{count} : $data{$name}{size} : $data{$name}{orig} : $data{$name}{quoted} : $data{$name}{percent}\n";
  }
  print $OUTF
"============================================================================\n";
  print $OUTF "Thread subjects\n";
  print $OUTF
"----------------------------------------------------------------------------\n";
  foreach my $thread ( sort { "\L$a" cmp "\L$b" } keys %threads )
  {
    print $OUTF
      "$thread : $threads{$thread}{count} : $threads{$thread}{size}\n";
  }
  print $OUTF
"============================================================================\n";
  print $OUTF "Cross-posts\n";
  print $OUTF
"----------------------------------------------------------------------------\n";
  foreach my $name ( sort keys %crossposts )
  {
    print $OUTF "$name : $crossposts{$name}\n";
  }
  print $OUTF
"============================================================================\n";
  print $OUTF "User agents\n";
  print $OUTF
"----------------------------------------------------------------------------\n";
  foreach my $name ( sort keys %agents )
  {
    print $OUTF "$name : $agents{$name}\n";
  }
  print $OUTF
"============================================================================\n";
  print $OUTF "Time zones\n";
  print $OUTF
"----------------------------------------------------------------------------\n";
  foreach my $name ( sort keys %tz )
  {
    print $OUTF "$name : $tz{$name}\n";
  }
  close $OUTF;
}    # write_data
 

Rev 11	Rev 13
1	#!/usr/bin/env perl	1	#!/usr/bin/env perl
2	use strict;	2	use strict;
3	use warnings;	3	use warnings;
-		4	use diagnostics;
4	use utf8;	5	use utf8;
5	use encoding 'utf-8';	-
6	use Encode;	6	use Encode;
7		7
-		8	## Print out all text to STDOUT UTF-8 encoded
-		9	binmode STDOUT, ':encoding(UTF-8)';
-		10
8	###########################	11	############################
9	# newsstat.pl version 0.4.2	12	## newsstat.pl version 0.4.3
10		13
11	############################################################################	14	###########################################################################
12	# Collect statistics about a newsgroup (specified by first argument) in	15	## Collect statistics about a newsgroup (specified by first argument)
13	# the local news spool. Check all articles in the last 30-day period.	16	## in the local news spool. Check all articles in the last 30-day period.
14	# Rank posters by number of posts and by volume of posts, report on top and	17	## Rank posters by number of posts and by volume of posts, report on top
15	# bottom 20 posters. Show their name, number of posts, size of posts,	18	## and bottom 20 posters. Show their name, number of posts, size of posts,
16	# percentage of quoted lines. Rank user-agents used, by poster rather than	19	## percentage of quoted lines. Rank user-agents used, by poster rather
17	# by post. Rank top 20 threads. Rank top 10 cross-posted groups.	20	## than by post. Rank top 20 threads. Rank top 10 cross-posted groups.
18	#	21	##
19	# (Numbers and paths can be configured below. -- PE)	22	## Numbers and paths can be configured below. See ChangeLog and TODO
20	############################################################################	-
21		-
22	############################################################################	-
23	# RECENT CHANGES #	-
24	# 2011-10-03 PE - Use more compatible shebang	-
25	# - Fixed some Perl::Critic-ized code	-
26	# - Fixed wrong indent for non-ASCII names	-
27	# - Formatted source code	-
28	# 2011-07-03 PE - Use Encode to decode/encode MIME encodings	-
29	# - Use warnings, utf8 (just in case)	-
30	# - Documentation update	-
31	# N/A NN - Take newsgroup name as argument	-
32	# 2004-06-19 NN - newsgroup name is $ARGV[0]	-
33	# - Allow command line flags for subtracting	-
34	# output if not pertinent for a group	-
35	# 2002-11-09 NN - Put Garry's writedata() function back in.	-
36	# - added "rn" to my list of UA's	-
37	# - Started using %distinct_agent for both User agent	-
38	# sections	-
39	# - named it newsstat.pl version 0.3	-
40	# 2002-11-06 NN - Fixed the earliest/latest file problem by using	-
41	# mtime rather than ctime, and simplifying the logic	-
42	# 2002-11-05 NN - moved user configurations to the top	-
43	# - fixed the cross-posting section	-
44	# - introduced the $newsgroup_name variable which	-
45	# later becomes $news$group	-
46	# - changed $name to $agent_name in countagents()	-
47	#	-
48	# Contributors	-
49	# -------------	-
50	# NN Nomen nominandum (name to be determined later)	-
51	# PE Thomas 'PointedEars' Lahn <startrek@PointedEars.de>	-
52		-
53	########### TODO #############	-
54	# Commas in bottom section of report	-
55	# Show date the figures were compiled	-
56	# No. of HTML articles (Content-Type: text/html)	-
57	# No. of quoted sigs (/>\s*-- /)	-
58	# Per cent of top-posted articles	-
59	# Top 10 cross-posters	-
60	# Top 20 news posting hosts (from Path)	-
61	# Count of certain subject words: newbie, kde, burner, sendmail, etc.	-
62	# Count all User Agents that each poster uses	-
63	# What do we do about Bill Unruh's ] quote style?	-
64	# Change the way dates/times are checked	-
65	# include % share in posters by no. of arts	-
66	# include % share in posters by size	-
67	# Total, orig & quoted lines by user agent with per cent	-
68	# Take more arguments	23	## for more. -- PE
69	#######################################################	24	###########################################################################
70		25
71	###################### USER CONFIGURATIONS ############################	26	###################### USER CONFIGURATIONS ############################
72		27
73	# The name of the group to do stats for	28	## The name of the group to do stats for
74	my $newsgroup_name = $ARGV[0];	29	my $newsgroup_name = $ARGV[0];
75	$newsgroup_name or &usage;	30	$newsgroup_name or &usage;
76		31
77	# Check for removal flags	32	## Check for removal flags
78	my $ix;	33	my $ix;
79	my $j;	34	my $j;
80	my %skipSec;	35	my %skipSec;
81	my @skiplist;	36	my @skiplist;
82	my $args = @ARGV;	37	my $args = @ARGV;
83	for ( $ix = 1 ; $ix < $args ; $ix++ )	38	for ( $ix = 1 ; $ix < $args ; $ix++ )
84	{	39	{
85	$j = $ix + 1;	40	$j = $ix + 1;
86	if ( $ARGV[$ix] eq "-x" )	41	if ( $ARGV[$ix] eq "-x" )
87	{	42	{
88	@skiplist = split( ",", $ARGV[$j] );	43	@skiplist = split( ",", $ARGV[$j] );
89	}	44	}
90	elsif ( $ARGV[$ix] =~ /-x(\d.*)/ )	45	elsif ( $ARGV[$ix] =~ /-x(\d.*)/ )
91	{	46	{
92	@skiplist = split( ",", $1 );	47	@skiplist = split( ",", $1 );
93	}	48	}
94	}	49	}
95	foreach (@skiplist)	50	foreach (@skiplist)
96	{	51	{
97	$skipSec{$_} = 1;	52	$skipSec{$_} = 1;
98	}	53	}
99		54
100	# Leafnode users will want /var/spool/news for this variable.	55	## Leafnode users will want /var/spool/news for this variable.
101	my $news = "/var/spool/news/";	56	my $news = "/var/spool/news/";
102		57
103	# How many days are we doing statistics for?	58	## How many days are we doing statistics for?
104	my $numdays = 30;	59	my $numdays = 30;
105		60
106	# no. of agents we list	61	## Number of agents we list
107	my $topagents = 10;	62	my $topagents = 10;
108		63
109	# no. of threads we want to know about	64	## Number of threads we want to know about
110	my $topthreads = 20;	65	my $topthreads = 20;
111		66
112	# no. of top or bottom posters to show	67	## Number of top or bottom posters to show
113	my $topposters = 20;	68	my $topposters = 20;
114		69
115	# no. of cross-posted threads to show	70	## Number of cross-posted threads to show
116	my $topcrossposts = 10;	71	my $topcrossposts = 10;
117		72
118	# no. of time zones to show	73	## Number of time zones to show
119	my $toptz = 10;	74	my $toptz = 10;
120		75
121	###################### DATA STRUCTURES ######################	76	###################### DATA STRUCTURES ######################
122	my $group = $newsgroup_name;	77	my $group = $newsgroup_name;
123	$group =~ s!\.!/!g;	78	$group =~ s!\.!/!g;
124	my %data; # name, count, agent, total, orig, quoted	79	my %data; # name, count, agent, total, orig, quoted
125	my %threads; # subject, count	80	my %threads; # subject, count
126	my %crossposts; # group, count	81	my %crossposts; # group, count
127	my %tz; # timezones by count	82	my %tz; # timezones by count
128	my %headers; # holds header of current article	83	my %headers; # holds header of current article
129	my %lcheader; # holds lowercase headers	84	my %lcheader; # holds lowercase headers
130	my @body; # holds body of current article	85	my @body; # holds body of current article
131	my @sig; # holds sig text;	86	my @sig; # holds sig text;
132	my $totalposts; # total no. of posts considered	87	my $totalposts; # total no. of posts considered
133	my $filename; # name of current article file	88	my $filename; # name of current article file
134	my $filesize; # size of current article file	89	my $filesize; # size of current article file
135	my $earliest; # earliest article we have found	90	my $earliest; # earliest article we have found
136	my $latest; # latest article we have found	91	my $latest; # latest article we have found
137	my $poster; # poster we are dealing with	92	my $poster; # poster we are dealing with
138	my $totsize = 0; # holds total sizes of all files	93	my $totsize = 0; # holds total sizes of all files
139	my $totheader = 0; # total size of header material	94	my $totheader = 0; # total size of header material
140	my $totbody = 0; # total size of body material	95	my $totbody = 0; # total size of body material
141	my $totsig = 0; # total size of sig material	96	my $totsig = 0; # total size of sig material
142	my $totorig = 0; # total size of original material	97	my $totorig = 0; # total size of original material
143	my $totquoted = 0; # total size of quoted material	98	my $totquoted = 0; # total size of quoted material
144	my $origposts = 0; # total no. of original posts	99	my $origposts = 0; # total no. of original posts
145	my $replies = 0; # total no. of replies	100	my $replies = 0; # total no. of replies
146	my $i; # general purpose	101	my $i; # general purpose
147	my %distinct_agent;	102	my %distinct_agent;
148	my %agents = # used to hold counts of User Agents used	-
149	(	103
150	"KNode" => 0,	104	## Used to hold counts of User Agents used
151	"Pan" => 0,	-
152	"Mozilla" => 0,	105	my %agents = (
153	"Sylpheed" => 0,	106	"Compuserver" => 0,
154	"Gnus" => 0,	107	"Foorum" => 0,
155	"Forte Agent" => 0,	108	"Forte Agent" => 0,
156	"Forte Free Agent" => 0,	109	"Forte Free Agent" => 0,
-		110	"Gnus" => 0,
-		111	"KNode" => 0,
-		112	"MacSOUP" => 0,
-		113	"MT-NewsWatcher" => 0,
157	"MicroPlanet Gravity" => 0,	114	"MicroPlanet Gravity" => 0,
158	"Microsoft Outlook Express" => 0,	115	"Microsoft Outlook Express" => 0,
-		116	"Microsoft Windows Mail" => 0,
-		117	"Mozilla" => 0,
-		118	"News Rover" => 0,
-		119	"NN" => 0,
-		120	"Pan" => 0,
159	"Xnews" => 0,	121	"rn" => 0,
160	"slrn" => 0,	122	"slrn" => 0,
-		123	"Sylpheed" => 0,
161	"tin" => 0,	124	"tin" => 0,
162	"rn" => 0,	-
163	"NN" => 0,	-
164	"MacSOUP" => 0,	-
165	"Foorum" => 0,	125	"VSoup" => 0,
166	"MT-NewsWatcher" => 0,	-
167	"News Rover" => 0,	-
168	"WebTV" => 0,	126	"WebTV" => 0,
169	"Compuserver" => 0,	-
170	"VSoup" => 0	127	"Xnews" => 0
171	);	128	);
172		129
173	######################## MAIN CODE ########################	130	######################## MAIN CODE ########################
174	$! = 1;	131	$! = 1;
175		132
176	chdir("$news$group") or die "Can't cd to $news$group: $!\n";	133	chdir("$news$group") or die "Can't cd to $news$group: $!\n";
177	opendir( DIR, "." ) or die "Can't open $news$group directory: $!\n";	134	opendir( DIR, "." ) or die "Can't open $news$group directory: $!\n";
178	while ( defined( $filename = readdir(DIR) ) )	135	while ( defined( $filename = readdir(DIR) ) )
179	{	136	{
180	%lcheader = ();	137	%lcheader = ();
181	next unless -f $filename; # only want real files	138	next unless -f $filename; # only want real files
182	next if ( $filename eq ".overview" ); # real articles only	139	next if ( $filename eq ".overview" ); # real articles only
183	next if ( -M $filename > $numdays ); # only want articles <= a certain age	140	next if ( -M $filename > $numdays ); # only want articles <= a certain age
184	$earliest = ( stat $filename )[9] unless defined($earliest);	141	$earliest = ( stat $filename )[9] unless defined($earliest);
185	$latest = ( stat $filename )[9] unless defined($latest);	142	$latest = ( stat $filename )[9] unless defined($latest);
186	&getarticle($filename); # read in the article	143	&get_article($filename); # read in the article
187	&getdata; # grab the data from the article	144	&get_data; # grab the data from the article
188	$totalposts++; # bump count of articles considered	145	$totalposts++; # bump count of articles considered
189	}	146	}
190	closedir(DIR); # finished with the directory	147	closedir(DIR); # finished with the directory
191		148
192	# post-processing	149	## Post-processing
193	&countagents; # count agents, collapsing versions	150	&count_agents; # count agents, collapsing versions
194	&fixpercent; # check percentages orig/total for posters	151	&fix_percent; # check percentages orig/total for posters
195		152
196	&writedata;	153	&write_data;
197		154
198	#################### DISPLAY RESULTS #####################	155	#################### DISPLAY RESULTS #####################
199	print "=" x 76, "\n";	156	print "=" x 76, "\n";
200	printf "%s\n", &centred( "Analysis of posts to $newsgroup_name", 76 );	157	printf "%s\n", &centred( "Analysis of posts to $newsgroup_name", 76 );
201	print "=" x 76, "\n";	158	print "=" x 76, "\n";
202	printf "%s\n",	159	printf "%s\n",
203	&centred( "(stats compiled with a script by Garry Knight et al.)", 76 );	160	&centred( "(stats compiled with a script by Garry Knight et al.)", 76 );
204	print "\n\n";	161	print "\n\n";
205	printf "Total posts considered: %s over %d days\n", commify($totalposts),	162	printf "Total posts considered: %s over %d days\n", commify($totalposts),
206	$numdays;	163	$numdays;
207	printf "Earliest article: %s\n", scalar localtime($earliest);	164	printf "Earliest article: %s\n", scalar localtime($earliest);
208	printf "Latest article: %s\n", scalar localtime($latest);	165	printf "Latest article: %s\n", scalar localtime($latest);
209	printf "Original articles: %s, replies: %s\n", commify($origposts),	166	printf "Original articles: %s, replies: %s\n", commify($origposts),
210	commify($replies);	167	commify($replies);
211	printf "Total size of posts: %s bytes (%sK) (%.2fM)\n", commify($totsize),	168	printf "Total size of posts: %s bytes (%s KiB) (%.2f MiB)\n", commify($totsize),
212	commify( int( $totsize / 1024 ) ), $totsize / 1048576; #	169	commify( int( $totsize / 1024 ) ), $totsize / 1048576; #
213	printf "Average %s articles per day, %.2f MB per day, %s bytes per article\n",	170	printf "Average %s articles per day, %.2f MiB per day, %s bytes per article\n",
214	commify( int( $totalposts / $numdays ) ), $totsize / $numdays / 1048576,	171	commify( int( $totalposts / $numdays ) ), $totsize / $numdays / 1048576,
215	commify( int( $totsize / $totalposts ) );	172	commify( int( $totsize / $totalposts ) );
216	my $count = keys %data;	173	my $count = keys %data;
217	printf "Total headers: %s KB bodies: %s KB\n",	174	printf "Total headers: %s KiB bodies: %s KiB\n",
218	commify( int( $totheader / 1024 ) ), commify( int( $totbody / 1024 ) );	175	commify( int( $totheader / 1024 ) ), commify( int( $totbody / 1024 ) );
219	printf "Body text - quoted: %s KB, original: %s KB = %02.2f%%, sigs: %s KB\n",	176	printf "Body text - quoted: %s KiB, original: %s KiB = %02.2f%%, sigs: %s KiB\n",
220	commify( int( $totquoted / 1024 ) ), commify( int( $totorig / 1024 ) ),	177	commify( int( $totquoted / 1024 ) ), commify( int( $totorig / 1024 ) ),
221	( $totorig * 100 ) / ( $totorig + $totquoted ),	178	( $totorig * 100 ) / ( $totorig + $totquoted ),
222	commify( int( $totsig / 1024 ) );	179	commify( int( $totsig / 1024 ) );
223	printf "Total number of posters: %s, average %s bytes per poster\n",	180	printf "Total number of posters: %s, average %s bytes per poster\n",
224	commify($count), commify( int( $totsize / $count ) ); #/	181	commify($count), commify( int( $totsize / $count ) ); #/
225	$count = keys %threads;	182	$count = keys %threads;
226	printf "Total number of threads: %s, average %s bytes per thread\n",	183	printf "Total number of threads: %s, average %s bytes per thread\n",
227	commify($count), commify( int( $totsize / $count ) ); #/	184	commify($count), commify( int( $totsize / $count ) ); #/
228	printf "Total number of User-Agents: %d\n", scalar keys %agents;	185	printf "Total number of user agents: %d\n", scalar keys %agents;
229	print "\n", "=" x 76, "\n";	186	print "\n", "=" x 76, "\n";
230		187
231	###############################	188	########################################
232	# show posters by article count Sec 1;	189	## Show posters by article count Sec 1;
233	###############################	190	########################################
234	unless ( $skipSec{1} )	191	unless ( $skipSec{1} )
235	{	192	{
236	if ( keys %data < $topposters )	193	if ( keys %data < $topposters )
237	{	194	{
238	$count = keys %data;	195	$count = keys %data;
239	}	196	}
240	else	197	else
241	{	198	{
242	$count = $topposters;	199	$count = $topposters;
243	}	200	}
244	printf "%s\n", &centred( "Top $count posters by number of articles", 76 );	201	printf "%s\n", &centred( "Top $count posters by number of articles", 76 );
245	print "=" x 76, "\n";	202	print "=" x 76, "\n";
246	$i = 0;	203	$i = 0;
247	foreach	204	foreach
248	my $poster ( sort { $data{$b}{count} <=> $data{$a}{count} } keys %data )	205	my $poster ( sort { $data{$b}{count} <=> $data{$a}{count} } keys %data )
249	{	206	{
250	my $name = substr( $poster, 0, 65 );	207	my $name = substr( $poster, 0, 65 );
251	printf "%2d: %-63s : %6d\n", $i + 1, rpad( $poster, 63, "." ),	208	printf "%2d: %-63s : %6d\n", $i + 1, rpad( $poster, 63, "." ),
252	$data{$poster}{count};	209	$data{$poster}{count};
253	last if ( ++$i == $count );	210	last if ( ++$i == $count );
254	}	211	}
255	print "\n", "=" x 76, "\n";	212	print "\n", "=" x 76, "\n";
256	}	213	}
257		214
258	################################	215	######################################
259	# show posters by size in Kbytes Sec 2;	216	## Show posters by size in KiB Sec 2;
260	################################	217	######################################
261	unless ( $skipSec{2} )	218	unless ( $skipSec{2} )
262	{	219	{
263	if ( keys %data < $topposters )	220	if ( keys %data < $topposters )
264	{	221	{
265	$count = keys %data;	222	$count = keys %data;
266	}	223	}
267	else	224	else
268	{	225	{
269	$count = $topposters;	226	$count = $topposters;
270	}	227	}
271	printf "%s\n", &centred( "Top $count posters by article size in Kbytes", 76 );	228	printf "%s\n", &centred( "Top $count posters by article size in KiB", 76 );
272	print "=" x 76, "\n";	229	print "=" x 76, "\n";
273	$i = 0;	230	$i = 0;
274	foreach my $poster ( sort { $data{$b}{size} <=> $data{$a}{size} } keys %data )	231	foreach my $poster ( sort { $data{$b}{size} <=> $data{$a}{size} } keys %data )
275	{	232	{
276	my $name = substr( $poster, 0, 62 );	233	my $name = substr( $poster, 0, 62 );
277	printf "%2d: %-63s : %6d\n", $i + 1, rpad( $poster, 63, "." ),	234	printf "%2d: %-63s : %6d\n", $i + 1, rpad( $poster, 63, "." ),
278	$data{$poster}{size} / 1024; #/	235	$data{$poster}{size} / 1024; #/
279	last if ( ++$i == $count );	236	last if ( ++$i == $count );
280	}	237	}
281	print "\n", "=" x 76, "\n";	238	print "\n", "=" x 76, "\n";
282	}	239	}
283		240
284	####################################	241	#####################################
285	# show top posters for original text	242	## Show top posters for original text
286	####################################	243	#####################################
287	unless ( $skipSec{3} )	244	unless ( $skipSec{3} )
288	{	245	{
289	if ( keys %data < $topposters )	246	if ( keys %data < $topposters )
290	{	247	{
291	$count = keys %data;	248	$count = keys %data;
292	}	249	}
293	else	250	else
294	{	251	{
295	$count = $topposters;	252	$count = $topposters;
296	}	253	}
297	printf "%s\n",	254	printf "%s\n",
298	&centred( "Top $count responders by original text (> 5 posts)", 76 );	255	&centred( "Top $count responders by original text (> 5 posts)", 76 );
299	print "=" x 76, "\n";	256	print "=" x 76, "\n";
300	$i = 0;	257	$i = 0;
301	foreach my $poster (	258	foreach my $poster (
302	sort { $data{$b}{percent} <=> $data{$a}{percent} }	259	sort { $data{$b}{percent} <=> $data{$a}{percent} }
303	keys %data	260	keys %data
304	)	261	)
305	{	262	{
306	next if $data{$poster}{quoted} == 0;	263	next if $data{$poster}{quoted} == 0;
307	next if $data{$poster}{count} < 5;	264	next if $data{$poster}{count} < 5;
308	my $name = substr( $poster, 0, 63 );	265	my $name = substr( $poster, 0, 63 );
309	printf "%2d: %-63s : %02.2f%%\n", $i + 1, rpad( $poster, 63, "." ),	266	printf "%2d: %-63s : %02.2f%%\n", $i + 1, rpad( $poster, 63, "." ),
310	$data{$poster}{percent};	267	$data{$poster}{percent};
311	last if ( ++$i == $count );	268	last if ( ++$i == $count );
312	}	269	}
313	print "\n", "=" x 76, "\n";	270	print "\n", "=" x 76, "\n";
314	}	271	}
315		272
316	#######################################	273	########################################
317	# show bottom posters for original text	274	## Show bottom posters for original text
318	#######################################	275	########################################
319	unless ( $skipSec{4} )	276	unless ( $skipSec{4} )
320	{	277	{
321	if ( keys %data < $topposters )	278	if ( keys %data < $topposters )
322	{	279	{
323	$count = keys %data;	280	$count = keys %data;
324	}	281	}
325	else	282	else
326	{	283	{
327	$count = $topposters;	284	$count = $topposters;
328	}	285	}
329	printf "%s\n",	286	printf "%s\n",
330	&centred( "Bottom $count responders by original text (> 5 posts)", 76 );	287	&centred( "Bottom $count responders by original text (> 5 posts)", 76 );
331	print "=" x 76, "\n";	288	print "=" x 76, "\n";
332	$i = 0;	289	$i = 0;
333	foreach my $poster (	290	foreach my $poster (
334	sort { $data{$a}{percent} <=> $data{$b}{percent} }	291	sort { $data{$a}{percent} <=> $data{$b}{percent} }
335	keys %data	292	keys %data
336	)	293	)
337	{	294	{
338	next if $data{$poster}{quoted} == 0;	295	next if $data{$poster}{quoted} == 0;
339	next if $data{$poster}{count} < 5;	296	next if $data{$poster}{count} < 5;
340	my $name = substr( $poster, 0, 63 );	297	my $name = substr( $poster, 0, 63 );
341	printf "%2d: %-63s : %02.2f%%\n", $i + 1, rpad( $poster, 63, "." ),	298	printf "%2d: %-63s : %02.2f%%\n", $i + 1, rpad( $poster, 63, "." ),
342	$data{$poster}{percent};	299	$data{$poster}{percent};
343	last if ( ++$i == $count );	300	last if ( ++$i == $count );
344	}	301	}
345	print "\n", "=" x 76, "\n";	302	print "\n", "=" x 76, "\n";
346	}	303	}
347		304
348	####################################	305	#####################################
349	# show threads by number of articles	306	## Show threads by number of articles
350	####################################	307	#####################################
351	unless ( $skipSec{5} )	308	unless ( $skipSec{5} )
352	{	309	{
353	if ( keys %threads < $topthreads )	310	if ( keys %threads < $topthreads )
354	{	311	{
355	$count = keys %threads;	312	$count = keys %threads;
356	}	313	}
357	else	314	else
358	{	315	{
359	$count = $topthreads;	316	$count = $topthreads;
360	}	317	}
361	printf "%s\n", &centred( "Top $count threads by no. of articles", 76 );	318	printf "%s\n", &centred( "Top $count threads by no. of articles", 76 );
362	print "=" x 76, "\n";	319	print "=" x 76, "\n";
363	$i = 0;	320	$i = 0;
364	foreach my $thread (	321	foreach my $thread (
365	sort { $threads{$b}{count} <=> $threads{$a}{count} }	322	sort { $threads{$b}{count} <=> $threads{$a}{count} }
366	keys %threads	323	keys %threads
367	)	324	)
368	{	325	{
369	my $name = substr( $thread, 0, 65 );	326	my $name = substr( $thread, 0, 65 );
370	printf "%2d: %-63s : %6d\n", $i + 1, rpad( $name, 63, "." ),	327	printf "%2d: %-63s : %6d\n", $i + 1, rpad( $name, 63, "." ),
371	$threads{$thread}{count};	328	$threads{$thread}{count};
372	last if ( ++$i == $count );	329	last if ( ++$i == $count );
373	}	330	}
374	print "\n", "=" x 76, "\n";	331	print "\n", "=" x 76, "\n";
375	}	332	}
-		333
376	################################	334	##############################
377	# show threads by size in Kbytes	335	## Show threads by size in KiB
378	################################	336	##############################
379	unless ( $skipSec{6} )	337	unless ( $skipSec{6} )
380	{	338	{
381	if ( keys %threads < $topthreads )	339	if ( keys %threads < $topthreads )
382	{	340	{
383	$count = keys %threads;	341	$count = keys %threads;
384	}	342	}
385	else	343	else
386	{	344	{
387	$count = $topthreads;	345	$count = $topthreads;
388	}	346	}
389	printf "%s\n", &centred( "Top $count threads by size in KB", 76 );	347	printf "%s\n", &centred( "Top $count threads by size in KiB", 76 );
390	print "=" x 76, "\n";	348	print "=" x 76, "\n";
391	$i = 0;	349	$i = 0;
392	foreach my $thread (	350	foreach my $thread (
393	sort { $threads{$b}{size} <=> $threads{$a}{size} }	351	sort { $threads{$b}{size} <=> $threads{$a}{size} }
394	keys %threads	352	keys %threads
395	)	353	)
396	{	354	{
397	my $name = substr( $thread, 0, 65 );	355	my $name = substr( $thread, 0, 65 );
398	printf "%2d: %-63s : %6d\n", $i + 1, rpad( $name, 63, "." ),	356	printf "%2d: %-63s : %6d\n", $i + 1, rpad( $name, 63, "." ),
399	$threads{$thread}{size} / 1024; #/	357	$threads{$thread}{size} / 1024; #/
400	last if ( ++$i == $count );	358	last if ( ++$i == $count );
401	}	359	}
402	print "\n", "=" x 76, "\n";	360	print "\n", "=" x 76, "\n";
403	}	361	}
404		362
405	#################################	363	##################################
406	# show top 10 cross-posted groups	364	## Show top 10 cross-posted groups
407	#################################	365	##################################
408	unless ( $skipSec{7} )	366	unless ( $skipSec{7} )
409	{	367	{
410	delete $crossposts{"$newsgroup_name"}; # don't include ours	368	delete $crossposts{"$newsgroup_name"}; # don't include ours
411	if ( keys %crossposts < $topcrossposts )	369	if ( keys %crossposts < $topcrossposts )
412	{	370	{
413	$count = keys %crossposts;	371	$count = keys %crossposts;
414	}	372	}
415	else	373	else
416	{	374	{
417	$count = $topcrossposts;	375	$count = $topcrossposts;
418	}	376	}
419	printf "%s\n", &centred( "Top $count cross-posted groups", 76 );	377	printf "%s\n", &centred( "Top $count cross-posted groups", 76 );
420	print "=" x 76, "\n";	378	print "=" x 76, "\n";
421	$i = 0;	379	$i = 0;
422	foreach	380	foreach
423	my $name ( sort { $crossposts{$b} <=> $crossposts{$a} } keys %crossposts )	381	my $name ( sort { $crossposts{$b} <=> $crossposts{$a} } keys %crossposts )
424	{	382	{
425	printf "%2d: %-63s : %6d\n", $i + 1, rpad( $name, 63, "." ),	383	printf "%2d: %-63s : %6d\n", $i + 1, rpad( $name, 63, "." ),
426	$crossposts{$name};	384	$crossposts{$name};
427	last if ( ++$i == $count );	385	last if ( ++$i == $count );
428	}	386	}
429	print "\n", "=" x 76, "\n";	387	print "\n", "=" x 76, "\n";
430	}	388	}
-		389
431	#######################	390	#########################
432	#show agents and counts	391	## Show agents and counts
433	#######################	392	#########################
434	unless ( $skipSec{8} )	393	unless ( $skipSec{8} )
435	{	394	{
436	if ( keys %agents < $topagents )	395	if ( keys %agents < $topagents )
437	{	396	{
438	$count = keys %agents;	397	$count = keys %agents;
439	}	398	}
440	else	399	else
441	{	400	{
442	$count = $topagents;	401	$count = $topagents;
443	}	402	}
444	printf "%s\n", &centred( "Top $count User Agents by poster", 76 );	403	printf "%s\n", &centred( "Top $count User Agents by poster", 76 );
445	print "=" x 76, "\n";	404	print "=" x 76, "\n";
446	$i = 0;	405	$i = 0;
447	foreach my $agent ( sort { $agents{$b} <=> $agents{$a} } keys %agents )	406	foreach my $agent ( sort { $agents{$b} <=> $agents{$a} } keys %agents )
448	{	407	{
449	printf "%2d: %-63s : %6d\n", $i + 1, rpad( $agent, 63, "." ),	408	printf "%2d: %-63s : %6d\n", $i + 1, rpad( $agent, 63, "." ),
450	$agents{$agent};	409	$agents{$agent};
451	last if ( ++$i == $count );	410	last if ( ++$i == $count );
452	}	411	}
453	print "\n", "=" x 76, "\n";	412	print "\n", "=" x 76, "\n";
454	}	413	}
455		414
456	#######################	415	#######################
457	#show distinct agents	416	## Show distinct agents
458	#######################	417	#######################
459	unless ( $skipSec{9} )	418	unless ( $skipSec{9} )
460	{	419	{
461	if ( keys %distinct_agent < $topagents )	420	if ( keys %distinct_agent < $topagents )
462	{	421	{
463	$count = keys %distinct_agent;	422	$count = keys %distinct_agent;
464	}	423	}
465	else	424	else
466	{	425	{
467	$count = $topagents;	426	$count = $topagents;
468	}	427	}
469	printf "%s\n", &centred( "Top $count User Agents by number of posts", 76 );	428	printf "%s\n", &centred( "Top $count User Agents by number of posts", 76 );
470	print "=" x 76, "\n";	429	print "=" x 76, "\n";
471	$i = 0;	430	$i = 0;
472	foreach my $agent (	431	foreach my $agent (
473	sort { $distinct_agent{$b} <=> $distinct_agent{$a} }	432	sort { $distinct_agent{$b} <=> $distinct_agent{$a} }
474	keys %distinct_agent	433	keys %distinct_agent
475	)	434	)
476	{	435	{
477	printf "%2d: %-58s : %5d (%2.f%%)\n", $i + 1, rpad( $agent, 58, "." ),	436	printf "%2d: %-58s : %5d (%2.f%%)\n", $i + 1, rpad( $agent, 58, "." ),
478	$distinct_agent{$agent},	437	$distinct_agent{$agent},
479	( ( $distinct_agent{$agent} / $totalposts ) * 100 );	438	( ( $distinct_agent{$agent} / $totalposts ) * 100 );
480	last if ( ++$i == $count );	439	last if ( ++$i == $count );
481	}	440	}
482	print "\n", "=" x 76, "\n";	441	print "\n", "=" x 76, "\n";
483	}	442	}
484		443

Subversion Repositories LCARS

(root)/trunk/tools/network/news/newsstat/newsstat.pl - Rev 11 → 13