NicelandYouTube.pm

package NicelandYouTube;

use strict;
use warnings FATAL => 'all';
use List::MoreUtils 'any';
use POE::Component::IRC::Plugin 'PCI_EAT_NONE';
use POE::Component::IRC::Plugin::URI::Find;
use POE::Quickie;

sub new {
    my ($package, %args) = @_;
    my $self = bless \%args, $package;

    $self->{channels} = ['#niceland'] if !defined $self->{channels};
    $self->{post_uri} = 'http://stuff.group.is/niceland/post.php';
    return $self;
}

sub PCI_register {
    my ($self, $irc) = @_;

    # add a URI::Find plugin if one is not present
    if ( !grep { $_->isa('POE::Component::IRC::Plugin::URI::Find') } values %{ $irc->plugin_list() } ) {
        $irc->plugin_add('URIFind', POE::Component::IRC::Plugin::URI::Find->new());
    }

    $irc->plugin_register($self, 'SERVER', qw(urifind_uri));
    return 1;
}

sub PCI_unregister {
    my ($self, $irc) = @_;
    return 1;
}

sub S_urifind_uri {
    my ($self, $irc) = splice @_, 0, 2;
    my $where = ${ $_[1] };
    my $uri   = ${ $_[2] };

    if ($uri =~ m[youtube\.com/watch\?v=[A-Za-z0-9_-]+]
            && any { $_ eq $where } @{ $self->{channels} }) {
        # post the uri in the background
        quickie_run(
            Program     => \&post_uri,
            ProgramArgs => [$self->{post_uri}, $uri],
        );
    }

    return PCI_EAT_NONE;
}

sub post_uri {
    my ($post_uri, $video) = @_;

    require LWP::UserAgent;
    my $agent = LWP::UserAgent->new(requests_redirectable => ['POST']);

    for (1..3) {
        my $response = $agent->post($post_uri, { videoid => $video });
        last if $response->is_success();
    }
}

1;

=encoding utf8

=head1 NAME

NicelandYouTube - A POE::Component::IRC plugin which posts YouTube uris to
http://stuff.group.is/niceland

=head1 SYNOPSIS

To quickly get an IRC bot with this plugin up and running, you can use
L<App::Pocoirc|App::Pocoirc>:

 $ pocoirc -s open.ircnet.net -j '#niceland' -a NicelandYouTube

Or use it in your code:

 use NicelandYouTube;

 $irc->plugin_add('NicelandYT', NicelandYouTube->new());

=head1 AUTHOR

Hinrik E<Ouml>rn SigurE<eth>sson, [email protected]

=head1 LICENSE AND COPYRIGHT

Copyright 2011 Hinrik E<Ouml>rn SigurE<eth>sson

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

=cut