examples/moose_room.pl

   1 package MooseRoom;
   2 use strict;
   3 our $VERSION = '0.0.1';
   4 use Moose;
   5 use POE qw(Component::Server::IRC);
   6
   7 with qw(MooseX::Getopt);
   8 with qw(MooseX::Daemonize);
   9
  10 has servername => (
  11     isa     => 'Str',
  12     is      => 'ro',
  13     default => sub { 'moose.room' },
  14 );
  15
  16 has nicklen => (
  17     isa     => 'Int',
  18     is      => 'ro',
  19     default => sub { 15 },
  20 );
  21
  22 has network => (
  23     isa     => 'Str',
  24     is      => 'ro',
  25     default => sub { 'MooseRoom' },
  26 );
  27
  28 has ircd => (
  29     isa     => 'POE::Component::Server::IRC',
  30     is      => 'ro',
  31     lazy    => 1,
  32     default => sub {
  33         POE::Component::Server::IRC->spawn(
  34             {
  35                 servername => $_[0]->servername,
  36                 nicklen    => $_[0]->nicklen,
  37                 network
  38             }
  39         );
  40     },
  41 );
  42
  43 has operators => (
  44     isa        => 'ArrayRef',
  45     is         => 'ro',
  46     auto_deref => 1,
  47     default    => sub {
  48         [ { username => 'perigrin', password => 'hobbit' }, ];
  49     },
  50 );
  51
  52 sub BUILD {
  53     my ($self) = @_;
  54     POE::Session->create( object_states => [ $self => [qw(_start _default)], ],
  55     );
  56
  57 }
  58
  59 sub _start {
  60     my ( $self, $kernel, $heap ) = @_[ OBJECT, KERNEL, HEAP ];
  61     $self->ircd->yield('register');
  62
  63     # Anyone connecting from the loopback gets spoofed hostname
  64     $self->ircd->add_auth(
  65         mask     => '*@localhost',
  66         spoof    => $self->hostname,
  67         no_tilde => 1
  68     );
  69
  70     # We have to add an auth as we have specified one above.
  71     $self->ircd->add_auth( mask => '*@*' );
  72
  73     # Start a listener on the 'standard' IRC port.
  74     $self->ircd->add_listener( port => 6667 );
  75
  76     # Add an operator who can connect from localhost
  77     $self->ircd->add_operator($_) for $self->operators;
  78     return;
  79 }
  80
  81 sub _default {
  82     my ( $event, $args ) = @_[ ARG0 .. $#_ ];
  83     print STDOUT "$event: ";
  84     foreach (@$args) {
  85       SWITCH: {
  86             if ( ref($_) eq 'ARRAY' ) {
  87                 print STDOUT "[", join( ", ", @$_ ), "] ";
  88                 last SWITCH;
  89             }
  90             if ( ref($_) eq 'HASH' ) {
  91                 print STDOUT "{", join( ", ", %$_ ), "} ";
  92                 last SWITCH;
  93             }
  94             print STDOUT "'$_' ";
  95         }
  96     }
  97     print STDOUT "\n";
  98     return 0;    # Don't handle signals.
  99 }
 100
 101 before new  => sub { POE::Kernel->run(); };
 102 after start => sub { POE::Kernel->run(); };
 103
 104 unless ( caller() ) {
 105     require Cwd;
 106     my $cmd = lc $ARGV[-1];
 107     my $app = MooseRoom->new_with_options( pidbase => Cwd::cwd() );
 108     print STDERR "trying to $cmd server\n";
 109     if ( $cmd eq 'start' ) {
 110         print STDERR qq{
 111         pidfile: @{ [ $app->pidfile ] }
 112         port:    @{ [ $app->Port ] }
 113         };
 114     }
 115     $app->$cmd;
 116 }
 117
 118 no Moose;
 119 1;    # Magic true value required at end of module
 120 __END__