The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package POE::Component::SmokeBox::Uploads::NNTP;

use strict;
use warnings;
use Carp;
use POE qw(Component::Client::NNTP);
use Email::Simple;
use vars qw($VERSION);

$VERSION = '1.00';

sub spawn {
  my $package = shift;
  my %opts = @_;
  $opts{lc $_} = delete $opts{$_} for keys %opts;
  croak "$package requires an 'event' argument\n" unless $opts{event};
  $opts{nntp} = 'nntp.perl.org' unless $opts{nntp};
  $opts{group} = 'perl.cpan.uploads' unless $opts{group};
  my $options = delete $opts{options};
  my $self = bless \%opts, $package;
  $self->{session_id} = POE::Session->create(
        object_states => [
	   $self => { shutdown        => '_shutdown', 
		      connect         => '_connect',
		      poll	      => '_poll',
		      nntp_registered => '_nntp_registered', 
		      nntp_socketerr  => '_nntp_socketerr',
		      nntp_disconnected => '_nntp_disconnected',
		      nntp_200	      => '_nntp_200',
		      nntp_211	      => '_nntp_211',
		      nntp_220	      => '_nntp_220',
	   },
           $self => [ qw(_start _dispatch) ],
        ],
        heap => $self,
        ( ref($options) eq 'HASH' ? ( options => $options ) : () ),
  )->ID();
  return $self;
}

sub session_id {
  return $_[0]->{session_id};
}

sub shutdown {
  my $self = shift;
  $poe_kernel->post( $self->{session_id}, 'shutdown' );
  return;
}

sub _shutdown {
  my ($kernel,$self) = @_[KERNEL,OBJECT];
  $kernel->alias_remove( $_ ) for $kernel->alias_list();
  $kernel->refcount_decrement( $self->{session_id}, __PACKAGE__ ) unless $self->{alias};  
  $kernel->refcount_decrement( $self->{sender_id}, __PACKAGE__ );
  $kernel->post( $self->{nntpclient}->session_id(), 'shutdown' );
  return;
}

sub _start {
  my ($kernel,$session,$sender,$self) = @_[KERNEL,SESSION,SENDER,OBJECT];
  $self->{session_id} = $session->ID();
  if ( $kernel == $sender and !$self->{session} ) {
        croak "Not called from another POE session and 'session' wasn't set\n";
  }
  my $sender_id;
  if ( $self->{session} ) {
    if ( my $ref = $kernel->alias_resolve( $self->{session} ) ) {
        $sender_id = $ref->ID();
    }
    else {
        croak "Could not resolve 'session' to a valid POE session\n";
    }
  }
  else {
    $sender_id = $sender->ID();
  }
  $kernel->refcount_increment( $sender_id, __PACKAGE__ );
  $self->{sender_id} = $sender_id;
  $self->{nntpclient} = POE::Component::Client::NNTP->spawn( 'nntp' . $self->{session_id}, 
	{ NNTPServer => $self->{nntp}, Port => $self->{nntp_port} } );
  return;
}

sub _nntp_registered {
  my ($kernel,$self,$sender) = @_[KERNEL,OBJECT,SENDER];
  $kernel->yield( 'connect', $sender->ID() );
  return;
}

sub _connect {
  my ($kernel,$self,$sender) = @_[KERNEL,OBJECT,ARG0];
  $kernel->post( $sender, 'connect' );
  return;
}

sub _nntp_socketerr {
  my ($kernel,$self,$sender,$error) = @_[KERNEL,OBJECT,SENDER,ARG0];
  warn "Socket error: $error\n";
  $kernel->delay( 'connect', 60, $sender->ID() );
  return;
}

sub _nntp_disconnected {
  my ($kernel,$self,$sender) = @_[KERNEL,OBJECT,SENDER];
  $kernel->delay( 'connect', 60, $sender->ID() );
  return;
}

sub _poll {
  my ($kernel,$self) = @_[KERNEL,OBJECT];
  $kernel->post ( $self->{nntpclient}->session_id(), 'group', $self->{group} );
  undef;
}

sub _nntp_200 {
  my ($kernel,$self) = @_[KERNEL,OBJECT];
  $kernel->yield( 'poll' );
  undef;
}

sub _nntp_211 {
  my ($kernel,$self,$sender) = @_[KERNEL,OBJECT,SENDER];
  my ($estimate,$first,$last,$group) = split( /\s+/, $_[ARG0] );

  if ( defined $self->{articles}->{ $group } ) {
        # Check for new articles
        if ( $estimate >= $self->{articles}->{ $group } ) {
           for my $article ( $self->{articles}->{ $group } .. $estimate ) {
                $kernel->post ( $sender => article => $article );
           }
           $self->{articles}->{ $group } = $estimate + 1;
        }
  }
  else {
        $self->{articles}->{ $group } = $estimate + 1;
  }
  $kernel->delay( 'poll' => ( $self->{poll} || 60 ) );
  undef;
}

sub _nntp_220 {
  my ($kernel,$self,$text) = @_[KERNEL,OBJECT,ARG0];
  my $article = Email::Simple->new( join "\n", @{ $_[ARG1] } );
  my $subject = $article->header('Subject');
  if ( my ($upload) = $subject =~ m!^CPAN Upload:\s+(\w+/\w+/\w+/.+(\.tar\.(gz|bz2)|\.tgz|\.zip))$!i ) {
	$kernel->call( $self->{session_id}, '_dispatch', $upload );
  }
  return;
}

sub _dispatch {
  my ($kernel,$self,$module) = @_[KERNEL,OBJECT,ARG0];
  $kernel->post( $self->{sender_id}, $self->{event}, $module );
  return;
}

1;
__END__

=head1 NAME

POE::Component::SmokeBox::Uploads::NNTP - Obtain uploaded CPAN modules via NNTP.

=head1 SYNOPSIS

  use strict;
  use POE qw(Component::SmokeBox::Uploads::NNTP);

  $|=1;

  POE::Session->create(
        package_states => [
          'main' => [qw(_start upload)],
        ],
  );

  $poe_kernel->run();
  exit 0;

  sub _start {
    POE::Component::SmokeBox::Uploads::NNTP->spawn(
        event => 'upload',
    );
    return;
  }

  sub upload {
    print $_[ARG0], "\n";
    return;
  }

=head1 DESCRIPTION

POE::Component::SmokeBox::Uploads::NNTP is a L<POE> component that alerts newly uploaded CPAN
distributions. It obtains this information from polling an NNTP server ( by default the C<perl.cpan.uploads> group on C<nntp.perl.org> ).

L<POE::Component::Client::NNTP> is used to handle the interaction with the NNTP server.

=head1 CONSTRUCTOR

=over

=item C<spawn>

Takes a number of parameters:

  'event', the event handler in your session where each new upload alert should be sent, mandatory;
  'session', optional if the poco is spawned from within another session;
  
The 'session' parameter is only required if you wish the output event to go to a different
session than the calling session, or if you have spawned the poco outside of a session.

Returns an object.

=back

=head1 METHODS

=over 

=item C<session_id>

Returns the POE::Session ID of the component.

=item C<shutdown>

Terminates the component.

=back

=head1 INPUT EVENTS

=over 

=item C<shutdown>

Terminates the component.

=back

=head1 OUTPUT EVENTS

An event will be triggered for each new CPAN upload. The event will have ARG0 set to the path of the 
upload:

  B/BI/BINGOS/POE-Component-SmokeBox-Uploads-NNTP-0.01.tar.gz

Suitable for feeding to the smoke tester of your choice.

=head1 AUTHOR

Chris C<BinGOs> Williams <chris@bingosnet.co.uk>

=head1 LICENSE

Copyright E<copy> Chris Williams

This module may be used, modified, and distributed under the same terms as Perl itself. Please see the license that came with your Perl distribution for details.

=head1 SEE ALSO

L<POE>

L<POE::Component::Client::NNTP>

L<http://www.nntp.perl.org/>

L<http://log.perl.org/2008/02/goodbye-cpan-te.html>

=cut