Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Perlmonks Age Stats

by rattusillegitimus (Friar)
on Aug 05, 2002 at 05:37 UTC ( #187590=sourcecode: print w/ replies, xml ) Need Help??

Category: Perlmonks.org Related Scripts
Author/Contact Info rattusillegitimus
Description:

A little while back in the CB, someone (forgive me, I have forgotten who), mentioned it would be interesting to see the age distribution of those monks who have reported their ages for the PerlMonks Stats Pages. So I decided to take a stab at generating such stats.

The script currently pulls up the upcoming birthdays page and scrapes the age information out, then outputs the requested file format (HTML or PNG). A future version might pull XML data from the server instead when it is available.

Examples: HTML Output, Summary Graph, Detail Graph.

Update: T'was dada that proposed the age stats in the CB. Thanks for the reminder ;)
Changed PDF to PNG in the comments.

#!/usr/bin/perl -wT
# $Id: monkages.pl,v 1.3 2002/08/05 05:31:48 corwin Exp $
# 04 Aug 02 - rattusillegitimus of perlmonks.org
#
# Freely redistributable under the same terms as perl itself.
#
# monkages.pl -o HTML > ages.html
#
# monkages.pl -o PNG > summary.png
#
# monkages.pl -o PNG -d > detail.png
#
use strict;
use Getopt::Std;           # Get output type
use LWP::Simple;           # Gather the Data
use HTML::TableExtract;    # Extract the Data
use HTML::Template;        # Build output HTML
use GD::Graph::bars ();    # Build output graph

my $url =
  'http://www.tinymicros.com/pm/index.php?goto=UpcomingBirthdays';
my ( $content, $monks, %agesum, %agedet, $row, %opts );
getopts( 'do:', \%opts );    # Get my command-line options

# Get the page
unless ( defined( $content = get $url) ) {
    die "Could not get $url\n";
}

# Let's do some parsing
my $te =
  new HTML::TableExtract( headers =>
      [ 'Node ID', 'Name', 'Birthday', 'Days Until', 'Current Age' ] )
+;
$te->parse($content);
foreach $row ( $te->rows ) {
    $monks++;
    @$row[4] eq '--' ? $agedet{-1}++ : $agedet{ @$row[4] }++;
    @$row[4] eq '--' ? $agesum{-1}++ : $agesum{ int( @$row[4] / 10 ) }
+++;
}

if ( $opts{'o'} && ( $opts{'o'} eq 'PNG' ) ) {
    my $gd;
    if ( defined $opts{'d'} ) {
        $gd = do_graph( 'D', %agedet );
    }
    else {
        $gd = do_graph( 'S', %agesum );
    }
    print $gd->png;
}
else {
    print do_html( \%agesum, \%agedet );
}

sub do_html {

    # Apply the data to the template
    my ( $agesum, $agedet ) = @_;

    # Build the details array for the template
    my ( @details, @summary );
    for ( sort bynum keys %agedet ) {
        push (
            @details,
            {
                AGE => ( ( $_ == -1 ) ? 'N/A' : $_ ),
                MONKS => $agedet{$_}
            }
        );
    }
    for ( sort bynum keys %agesum ) {
        push (
            @summary,
            {
                AGE => (
                    ( $_ == -1 )
                    ? 'N/A'
                    : sprintf( "%d - %d", $_ * 10, ( $_ * 10 ) + 9 )
                ),
                MONKS => $agesum{$_}
            }
        );
    }
    my $template = HTML::Template->new( filehandle => *DATA );
    $template->param( DETAILS   => [@details] );
    $template->param( SUMMARY   => [@summary] );
    $template->param( MONKCOUNT => $monks );
    return $template->output;
}

sub bynum { $a <=> $b; }    # numeric sorting for great justice

sub age_range {
    my $key = shift;
    return (
        ( $key == -1 )
        ? 'N/A'
        : sprintf( "%d - %d", $key * 10, ( $key * 10 ) + 9 )
    );
}

sub do_graph {

    # Build me a graph using GD::Graph and return the GD image
    my $type    = shift;
    my %agedata = @_;
    my @data;
    for ( sort bynum keys %agedata ) {
        push @{ $data[0] }, ( $type eq 'S' )
          ? age_range($_)
          : ( ( $_ < 0 ) ? 'N/A' : $_ );
        push @{ $data[1] }, $agedata{$_};
    }

    my $graph = new GD::Graph::bars( 600, 400 ) || die "$!";
    $graph->set(
        title            => 'PerlMonks Age Distribution',
        x_label          => ( ( $type eq 'S' ) ? 'Age Range' : 'Age' )
+,
        x_label_position => 1 / 2,
        y_label          => 'Number of Monks',
        shadow_depth     => 3,
        show_values      => 1,
        bar_spacing      => 5,
    );
    return $graph->plot( \@data );
}

__DATA__
<html>
<head>
<title>Perlmonks Age Breakdown</title>
<style type="text/css">
<!--
html { font-family: Verdana; }
body { background-color: #f0f8ff; color: #000000; }
table { border-collapse: collapse; 
        border-style: ridge; 
        background-color: #ccccff; }
th,td { border-style: ridge; }
th { background-color: #cccccc; }
td { text-align: center; }
caption { white-space: nowrap; }
-->
</style>
</head>
<body>
<h1>Perlmonks Age Breakdown</h1>
<h2><TMPL_VAR NAME=MONKCOUNT> monks counted</h2>
<hr/>
<table>
<caption>
<strong>Age Summary</strong>
</caption>
<thead>
<tr>
<th scope="col">Age</th>
<th scope="col"># Monks</th>
</tr>
</thead>
<tbody>
<TMPL_LOOP NAME=SUMMARY>
<tr>
<td>
<TMPL_VAR NAME=AGE>
</td>
<td>
<TMPL_VAR NAME=MONKS>
</td>
</tr>
</TMPL_LOOP>
</tbody>
</table>
<hr/>
<table>
<caption>
<strong>Age Details</strong>
</caption>
<thead>
<tr>
<th scope="col">Age</th>
<th scope="col"># Monks</th>
</tr>
</thead>
<tbody>
<TMPL_LOOP NAME=DETAILS>
<tr>
<td>
<TMPL_VAR NAME=AGE>
</td>
<td>
<TMPL_VAR NAME=MONKS>
</td>
</tr>
</TMPL_LOOP>
</tbody>
</table>
<hr/>
</body>
</html>

Comment on Perlmonks Age Stats
Download Code

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://187590]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (4)
As of 2014-10-26 00:04 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (149 votes), past polls