App::Bondage::Away - A PoCo-IRC plugin which changes the away status

App-Bondage documentation Contained in the App-Bondage distribution.

Index

Code Index:

NAME

Top

App::Bondage::Away - A PoCo-IRC plugin which changes the away status based on the presence of proxy clients.

SYNOPSIS

Top

 use App::Bondage::Away;

 $irc->plugin_add('Away', App::Bondage::Away->new(Message => "I'm out to lunch"));

DESCRIPTION

Top

App::Bondage::Away is a POE::Component::IRC plugin. When the last proxy client detaches, it changes the status to away, with the supplied away message.

This plugin requires the IRC component to be POE::Component::IRC::State or a subclass thereof.

METHODS

Top

new

One optional argument:

'Message', the away message you want to use. Defaults to 'No clients attached'.

Returns a plugin object suitable for feeding to POE::Component::IRC's plugin_add() method.

message

One optional argument:

An away message

Changes the away message when called with an argument, returns the current away message otherwise.

AUTHOR

Top

Hinrik Örn Sigurðsson, hinrik.sig@gmail.com

App-Bondage documentation Contained in the App-Bondage distribution. 
package App::Bondage::Away;
BEGIN {
  $App::Bondage::Away::AUTHORITY = 'cpan:HINRIK';
}

use strict;
use warnings FATAL => 'all';
use POE::Component::IRC::Plugin qw( :ALL );

our $VERSION = '1.1';

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

sub PCI_register {
    my ($self, $irc) = @_;
    
    if (!$irc->isa('POE::Component::IRC::State')) {
        die __PACKAGE__ . " requires PoCo::IRC::State or a subclass thereof\n";
    }
    
    $self->{Message} = 'No clients attached' unless defined $self->{Message};
    $self->{clients} = 0;

    if ($irc->connected() && $irc->is_away($irc->nick_name())) {
        $self->{away} = 1;
    }

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

sub PCI_unregister {
    return 1;
}

sub S_001 {
    my ($self, $irc) = splice @_, 0, 2;
    if (!$self->{clients}) {
        $irc->yield(away => $self->{Message});
        $self->{away} = 1;
    }
    return PCI_EAT_NONE;
}

sub S_proxy_authed {
    my ($self, $irc) = splice @_, 0, 2;
    my $client = ${ $_[0] };
    $self->{clients}++;
    if ($self->{away}) {
        $irc->yield('away');
        $self->{away} = 0;
    }
    return PCI_EAT_NONE;
}

sub S_proxy_close {
    my ($self, $irc) = splice @_, 0, 2;
    my $client = ${ $_[0] };
    $self->{clients}--;
    if (!$self->{clients}) {
        $irc->yield(away => $self->{Message});
        $self->{away} = 1;
    }
    return PCI_EAT_NONE;
}

sub message {
    my ($self, $value) = @_;
    return $self->{Message} if !defined $value;
    $self->{Message} = $value;
    return;
}

1;