package Hubot::Robot;
{
$Hubot::Robot::VERSION = '0.1.3';
}
use Moose;
use namespace::autoclean;
use Pod::Usage;
use AnyEvent::HTTP::ScopedClient;
use Hubot::User;
use Hubot::Brain;
use Hubot::Listener;
use Hubot::TextListener;
has 'name' => ( is => 'rw', isa => 'Str' );
has 'alias' => ( is => 'rw', isa => 'Str' );
has 'adapter' => ( is => 'rw' );
has 'brain' => (
is => 'ro',
isa => 'Hubot::Brain',
default => sub { Hubot::Brain->new }
);
has '_commands' => (
traits => ['Array'],
is => 'rw',
isa => 'ArrayRef[Str]',
default => sub { [] },
handles => {
commands => 'elements',
addCommand => 'push',
}
);
has '_listeners' => (
traits => ['Array'],
is => 'rw',
isa => 'ArrayRef[Hubot::Listener]',
default => sub { [] },
handles => {
listeners => 'elements',
addListener => 'push',
}
);
sub BUILD {
my $self = shift;
$self->loadAdapter($self->adapter)
}
sub loadAdapter {
my ($self, $adapter) = @_;
## TODO: HUBOT_DEFAULT_ADAPTERS
$adapter = "Hubot::Adapter::" . ucfirst($adapter);
eval "require $adapter; 1";
if ($@) {
print STDERR "Cannot load adapter $adapter - $@\n";
} else {
$self->adapter($adapter->new({ robot => $self }));
}
}
sub run { shift->adapter->run }
sub userForId {
my ($self, $id, $options) = @_;
my $user = $self->brain->{data}{users}{$id};
unless ($user) {
$user = Hubot::User->new({ id => $id, %$options });
$self->brain->{data}{users}{$id} = $user;
}
my $options_room = $options->{room} || '';
if ($options_room && (!$user->{room} || $user->{room} ne $options_room)) {
$user = Hubot::User->new({ id => $id, %$options });
$self->brain->{data}{users}{$id} = $user;
}
return $user;
}
sub userForName {
my ($self, $name) = @_;
my $result;
for my $k (keys %{ $self->brain->{data}{users} }) {
my $userName = $self->brain->{data}{users}{$k}{name};
if (lc $userName eq lc $name) {
$result = $self->brain->{data}{users}{$k};
}
}
return $result;
}
sub usersForFuzzyRawName {
my ($self, $fuzzyName) = @_;
my $lowerFuzzyName = lc $fuzzyName;
my @users;
while (my ($key, $user) = each %{ $self->brain->{data}{users} || {} }) {
if (lc($user->{name}) =~ m/^$lowerFuzzyName/) {
push @users, $user;
}
}
return @users;
}
sub usersForFuzzyName {
my ($self, $fuzzyName) = @_;
my @matchedUsers = $self->usersForFuzzyRawName($fuzzyName);
my $lowerFuzzyName = lc $fuzzyName;
for my $user (@matchedUsers) {
return $user if lc($user->{name}) eq $lowerFuzzyName;
}
return @matchedUsers;
}
sub shutdown {
my $self = shift;
$self->brain->close;
$self->adapter->close;
}
sub loadHubotScripts {
my ($self, $scripts) = @_;
## TODO: Debug Message
# print "Loading hubot-scripts\n" if $ENV{DEBUG};
for my $script (@$scripts) {
$self->loadFile($script);
}
}
sub loadFile {
my ($self, $script) = @_;
my $full = "Hubot::Scripts::$script";
eval "require $full; 1";
$full->load($self);
if ($@) {
print STDERR "Unable to load $full: $@\n";
} else {
$self->parseHelp($full);
}
}
sub parseHelp {
my ($self, $module) = @_;
$module =~ s{::}{/}g;
my $fullpath = $INC{$module . '.pm'};
open my $fh, '>', \my $usage or die "Couldn't open filehandle: $!\n";
pod2usage({
-input => $fullpath,
-output => $fh,
-exitval => 'noexit',
});
$usage =~ s/^Usage://;
$usage =~ s/(^\s+|\s+$)//gm;
$self->addCommand($_) for split(/\n/, $usage);
}
sub hear {
my ($self, $regex, $callback) = @_;
$self->addListener(new Hubot::TextListener(
robot => $self,
regex => $regex,
callback => $callback
));
}
sub respond {
my ($self, $regex, $callback) = @_;
my $index = index "$regex", ':';
my $stringRegex = substr "$regex", ($index + 1), -1;
my $first = substr $stringRegex, 0, 1;
## TODO: $^ 에 따른 분기; perl version 에 따라서 Regex object 의 modifier 위치가 달라짐
my $modifiers = '';
my $modifiersLen = $index - 3;
if ($modifiersLen > 0 && length $stringRegex > 3) {
$modifiers = substr $stringRegex, 3, $modifiersLen
}
if ($first eq '^') {
print STDERR "Anchors don't work well with respond, perhaps you want to use 'hear'\n";
print STDERR "The regex in question was $stringRegex\n";
}
my $newRegex;
my $name = $self->name;
if ($self->alias) {
my $alias = $self->alias;
$alias =~ s/[-[\]{}()\*+?.,\\^$|#\s]/\\$&/g; # escape alias for regexp
## TODO: fix to generate correct regex
## qr/regex/$var 처럼 modifier 에 변수가 들어갈 수 없음
## 일단 modifiers 가 있다면 `i` 라고 가정하고 들어감 WTH..
if ($modifiers) {
$newRegex = qr/^(?:$alias[:,]?|$name[:,]?)\s*(?:$stringRegex)/i;
} else {
$newRegex = qr/^(?:$alias[:,]?|$name[:,]?)\s*(?:$stringRegex)/
}
} else {
if ($modifiers) {
$newRegex = qr/^(?:$name[:,]?)\s*(?:$stringRegex)/i;
} else {
$newRegex = qr/^(?:$name[:,]?)\s*(?:$stringRegex)/
}
}
print "$newRegex\n" if $ENV{DEBUG};
$self->addListener(new Hubot::TextListener(
robot => $self,
regex => $newRegex,
callback => $callback
));
}
sub enter {
my ($self, $callback) = @_;
$self->addListener(Hubot::Listener->new(
robot => $self,
matcher => sub { ref(shift) eq 'Hubot::EnterMessage' ? 1 : () },
callback => $callback
));
}
sub leave {
my ($self, $callback) = @_;
$self->addListener(Hubot::Listener->new(
robot => $self,
matcher => sub { ref(shift) eq 'Hubot::LeaveMessage' ? 1 : () },
callback => $callback
));
}
sub whisper {
my ($self, $callback) = @_;
$self->addListener(Hubot::Listener->new(
robot => $self,
matcher => sub { ref(shift) eq 'Hubot::WhisperMessage' ? 1 : () },
callback => $callback
));
}
sub catchAll {
my ($self, $callback) = @_;
$self->addListener(Hubot::Listener->new(
robot => $self,
matcher => sub { ref(shift) eq 'Hubot::CatchAllMessage' ? 1 : () },
callback => sub {
my $msg = shift;
$msg->message($msg->message->message);
$callback->($msg);
}
));
}
sub receive {
my ($self, $message) = @_;
my $results = [];
for my $listener ($self->listeners) {
eval $listener->call($message);
last if $message->done;
if ($@) {
print STDERR "Unable to call the listener: $@\n";
return 0;
}
}
$self->receive(new Hubot::CatchAllMessage(
message => $message
)) if ref($message) ne 'Hubot::CatchAllMessage';
}
sub http { AnyEvent::HTTP::ScopedClient->new($_[1]) }
__PACKAGE__->meta->make_immutable;
1;
=pod
=encoding utf-8
=head1 NAME
Hubot::Robot
=head1 SYNOPSIS
# Hubot::Robot has a CLI. named `hubot`
$ perldoc hubot
# make sure `hubot-scripts.json` is exist in current working directory
use JSON::XS;
use Cwd 'cwd';
use Hubot::Robot;
my $robot = Hubot::Robot->new({
adapter => 'shell',
name => 'hubot'
});
$robot->adapter->on(
'connected',
sub {
my $cwd = cwd();
my $scriptsFile = "$cwd/hubot-scripts.json";
if (-f $scriptsFile) {
my $json = read_file($scriptsFile);
my $scripts = decode_json($json);
$robot->loadHubotScripts($scripts);
}
}
);
$robot->run;
=head1 DESCRIPTION
A customizable, kegerator-powered life embetterment robot.
The original hubot description is..
"This is a version of GitHub's Campfire bot, hubot. He's pretty cool."
this is hubot B<Perl> port.
=head1 SEE ALSO
=over
=item L<http://hubot.github.com/>
=item L<https://github.com/github/hubot>
=item L<hubot>
=back
=head1 AUTHOR
Hyungsuk Hong <hshong@perl.kr>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2012 by Hyungsuk Hong.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut