comment on

#!/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>
[download]

In reply to Perlmonks Age Stats by rattusillegitimus

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


There's more than one way to do things
	PerlMonks