CPAN::Testers::WWW::Statistics::Excel - CPAN Testers Statistics Excel tool.

  my %hash = { logfile => 'my.log' };
  my $ct = CPAN::Testers::WWW::Statistics::Excel->new(%hash);
  $ct->create( source => $source, target => $target );

  Barbie, <barbie@cpan.org>
  for Miss Barbell Productions <http://www.missbarbell.co.uk>.

  Copyright (C) 2009 Barbie for Miss Barbell Productions.

  This module is free software; you can redistribute it and/or
  modify it under the same terms as Perl itself.

package CPAN::Testers::WWW::Statistics::Excel;

use warnings;
use strict;
use vars qw($VERSION);

$VERSION = '0.02';

#----------------------------------------------------------------------------

# -------------------------------------
# Library Modules

use base qw(Class::Accessor::Fast);

use File::Basename;
use File::Path;
use HTML::Entities;
use HTML::TokeParser;
use IO::File;
use Spreadsheet::WriteExcel;

# -------------------------------------
# Variables

my %format_config = (
    head    => { border => 1, pattern => 1, color => 'black',   bg_color => 'gray',     bold => 1 },
    lots    => { border => 1, pattern => 1, color => 'black',   bg_color => 'green',    align => 'right' },
    more    => { border => 1, pattern => 1, color => 'black',   bg_color => 'lime',     align => 'right' },
    some    => { border => 1, pattern => 1, color => 'black',   bg_color => 'yellow',   align => 'right' },
    none    => { border => 1, pattern => 1, color => 'black',   bg_color => 'silver',   align => 'center', valign => 'middle' },
    totals  => { border => 1, pattern => 1, color => 'white',   bg_color => 'black',    bold => 1 },
);

# -------------------------------------
# Subroutines

sub new {
    my $class = shift;
    my %hash  = @_;

    my $self = {};
    bless $self, $class;

    $self->logfile(  $hash{logfile}       );
    $self->logclean( $hash{logclean} || 0 );

    $self->_log("logfile  =".($self->logfile   || ''));
    $self->_log("logclean =".($self->logclean  || ''));

    return $self;
}

__PACKAGE__->mk_accessors( qw( logfile logclean ) );


sub create {
    my $self = shift;
    my %hash = @_;
    my %opt;

    $self->_log("start");

    die "Source file not provided\n"               unless(   $hash{source});
    die "Target file not provided\n"               unless(   $hash{target});
    die "Source file [$hash{source}] not found\n"  unless(-f $hash{source});
    mkpath(dirname($hash{target}));

    my $workbook = Spreadsheet::WriteExcel->new( $hash{target} ); 

    $workbook->set_custom_color(23, '#999999');   # head
    $workbook->set_custom_color(17, '#00ff00');   # lots
    $workbook->set_custom_color(11, '#99ff99');   # more
    $workbook->set_custom_color(13, '#ddffdd');   # some
    $workbook->set_custom_color(22, '#dddddd');   # none

    #  Add and define a format
    my %formats;
    for my $format (keys %format_config) {
        my $class = $workbook->add_format( %{ $format_config{$format} } ); # Add a format
        $formats{$format} = $class;
    }

    my $worksheet = $workbook->add_worksheet();

    my $cell = {};
    my ($title,$table,$row,$col) = (0,0,0,0);
    my $p = HTML::TokeParser->new( $hash{source}, %opt ); 
    while(my $token = $p->get_token) {

        # if no title given, use the H2 tag.
        unless($table || $hash{title}) {
            if($token->[0] eq 'S' && $token->[1] eq 'h2') {
                $title = 1;
                $cell = {text => ''};
                next;
            }
            if($token->[0] eq 'E' && $token->[1] eq 'h2') {
                $title = 0;
                $hash{title} = decode_entities($cell->{text});
                $self->_log("TITLE: '$cell->{text}'");
                next;
            }
            if($title && $token->[0] eq 'T') {
                $cell->{text} .= "\n"   if($cell->{text});
                $cell->{text} .= $token->[1];
            }
        }

        next    unless($table || $token->[1] eq 'table');

        if($token->[0] eq 'S' && $token->[1] eq 'table') {
            $table = 1;
            next;
        }
        if($token->[0] eq 'E' && $token->[1] eq 'table') {
            $table = 0;
            last;
        }

        if($token->[0] eq 'S' && $token->[1] eq 'tr') {
            $col = 0;
            next;
        }
        if($token->[0] eq 'E' && $token->[1] eq 'tr') {
            $row++;
            next;
        }

        if($token->[0] eq 'S' && $token->[1] eq 'th') {
            $cell = { class => 'head', text => '' };
            if($token->[2]->{class}) {
                $cell = { class => $token->[2]->{class}, text => '' };
            }
            next;
        }
        if($token->[0] eq 'E' && $token->[1] eq 'th') {
            # write cell
            $self->_log("CELL: TH: [$row/$col] $cell->{class} '$cell->{text}'");
            $worksheet->write($row, $col, decode_entities($cell->{text}), $formats{$cell->{class}});
            $col++;
            next;
        }

        if($token->[0] eq 'S' && $token->[1] eq 'td') {
            $cell = { class => 'none', text => '' };
            if($token->[2]->{class}) {
                $cell = { class => $token->[2]->{class}, text => '' };
            }
            next;
        }
        if($token->[0] eq 'E' && $token->[1] eq 'td') {
            # write cell
            $self->_log("CELL: TD: [$row/$col] $cell->{class} '$cell->{text}'");
            $worksheet->write($row, $col, decode_entities($cell->{text}), $formats{$cell->{class}});
            $col++;
            next;
        }

        if($token->[0] eq 'T') {
            $cell->{text} .= "\n"   if($cell->{text});
            $cell->{text} .= $token->[1];
        }
    }

    $hash{title}    ||= 'CPAN Testers Matrix';
    $hash{author}   ||= 'CPAN Testers';
    $hash{comments} ||= 'Copyright (C) 2009 The Perl Foundation';

    $worksheet->set_landscape();    # Landscape mode
    $worksheet->set_paper(9);       # A4
    $worksheet->fit_to_pages(0, 1); # 1 page deep, many wide
    $worksheet->set_header('&L&D&C'.$hash{title}.'&R&T');
    $worksheet->set_footer('&RPage &P of &N');

    $worksheet->repeat_rows(0, 1);      # Repeat the first two rows
    $worksheet->repeat_columns(0, 1);   # Repeat the first two columns


    $workbook->set_properties(
        title    => $hash{title},
        author   => $hash{author},
        comments => $hash{comments},
    );

    $workbook->close() or die "Error closing file: $!";
    $self->_log("finish");
}

# -------------------------------------
# Private Methods

sub _log {
    my $self = shift;
    my $log = $self->logfile or return;
    mkpath(dirname($log))   unless(-f $log);

    my $mode = $self->logclean ? 'w+' : 'a+';
    $self->logclean(0);

    my @dt = localtime(time);
    my $dt = sprintf "%04d/%02d/%02d %02d:%02d:%02d", $dt[5]+1900,$dt[4]+1,$dt[3],$dt[2],$dt[1],$dt[0];

    my $fh = IO::File->new($log,$mode) or die "Cannot write to log file [$log]: $!\n";
    print $fh "$dt ", @_, "\n";
    $fh->close;
}

q('This module is dedicated to the Birmingham Perl Mongers');

__END__