The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package CPAN::WWW::Testers::Generator::Article;
use strict;
use CPAN::DistnameInfo;
#use DateTime::Format::Mail;
use Email::Simple;
use base qw( Class::Accessor::Fast );
__PACKAGE__->mk_accessors(qw( 
date status distribution version
perl osname osvers archname
));

sub new {
  my($class, $article) = @_;
  my $self = {};
  bless $self, $class;

  my $mail = Email::Simple->new($$article);
  return if $mail->header("In-Reply-To");
  my $subject = $mail->header("Subject");
  return unless $subject;
  return if $subject =~ /::/; # it's supposed to be distribution
  my($status, $distversion, $platform) = split /\s/, $subject;
  return unless $status =~ /^(PASS|FAIL|UNKNOWN|NA)$/;

  $distversion .= '.tar.gz' unless $distversion =~ /\.(tar|tgz|zip)/;
  my $d = CPAN::DistnameInfo->new($distversion);
  my ($dist, $version) = ($d->dist, $d->version);
  return unless $dist;
  return unless $version;

#  my $dfm = DateTime::Format::Mail->new(loose => 1);
#  my $datetime = $dfm->parse_datetime($mail->header("Date"));

  my $body = $mail->body;

  my $perl = $self->_extract_perl_version(\$body);

  my($osname) = $body =~ /osname=(?:3D)?([^ ,]+)/;
  my($osvers) = $body =~ /osvers=([^ ,]+)/;
  my($archname) = $body =~ /archname=([^ ,]+)/m;
  $archname =~ s/\n//;

#  $self->date($datetime);
  $self->status($status);
  $self->distribution($dist);
  $self->version($version);
  $self->perl($perl);
  $self->osname($osname || "");
  $self->osvers($osvers || "");
  $self->archname($archname || "");

  return $self;
}

sub passed {
  my $self = shift;
  return $self->status eq 'PASS';
}

sub failed {
  my $self = shift;
  return $self->status eq 'FAIL';
}

# there are a few old test reports that omitted the perl version number.
# In these instances 0 is assumed. These reports are now so old, that
# worrying about them is not worth the effort.

sub _extract_perl_version {
  my($self, $body) = @_;

  # Summary of my perl5 (revision 5.0 version 6 subversion 1) configuration:
  my ($rev, $ver, $sub, $extra) = 
	  $$body =~ /Summary of my (?:perl\d+)? \((?:revision )?(\d+(?:\.\d+)?) (?:version|patchlevel) (\d+) subversion\s+(\d+) ?(.*?)\) configuration/s;
  
  unless(defined $rev) {
#    warn "Cannot parse perl version for article:\n$body";
    return 0;
  }

  my $perl = $rev + ($ver / 1000) + ($sub / 1000000);
  $rev = int($perl);
  $ver = int(($perl*1000)%1000);
  $sub = int(($perl*1000000)%1000);

  my $version = sprintf "%d.%d.%d", $rev, $ver, $sub;
  $version .= " $extra" if $extra;
  return $version;
#  return sprintf "%0.6f", $perl;	# an alternate format
}

1;

__END__

=head1 NAME

CPAN::WWW::Testers::Generator::Article - Parse a CPAN Testers article

=head1 DESCRIPTION

This is used by CPAN::WWW::Testers::Generator.

=head1 METHOD

=head2 new

The constructor. Pass in a reference to the article.

=head2 passed

Whether it was a PASS

=head2 failed

Whether it was a FAIL

=head1 AUTHOR

Leon Brocard <leon@astray.com>

=head1 LICENSE

This code is distributed under the same license as Perl.