melo / codebits

Presentations and projects done at SAPO Codebits

This URL has Read+Write access

codebits / 2008 / xmpp-hands-on / bots / process_sync / Bot.pm
100644 146 lines (102 sloc) 2.757 kb
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
package Bot;
 
use strict;
use warnings;
use base 'Mojo::Base';
use Net::XMPP2::Client;
use AnyEvent::Mojo;
use Encode 'decode';
use FindBin;
use lib "$FindBin::Bin/../../lib";
 
__PACKAGE__->attr([qw( jid password host port http_port http_host )]);
__PACKAGE__->attr([qw( bot http_server )]);
__PACKAGE__->attr([qw( stop_cond )]);
__PACKAGE__->attr('debug', default => sub { return $ENV{DEBUG} });
 
##################
# Start the circus
 
sub start {
  my $self = shift;
  
  $self->start_bot;
  $self->start_http_server;
  $self->started;
  
  return;
}
 
# Override started in your class if you want to do some more starting...
sub started {}
 
sub run {
  AnyEvent->condvar->recv; # event loop kicks in!
  
  return;
}
 
 
#########
# Our Bot
 
sub start_bot {
  my $self = shift;
  
  # Start a small bot
  my $bot = Net::XMPP2::Client->new(debug => $self->debug);
  $self->bot($bot);
  
  $bot->add_account($self->jid, $self->password, $self->host, $self->port);
  $bot->start;
 
  # When one account connects...
  $bot->reg_cb(
    connected => sub { return $self->bot_connected(@_) },
    connect_error => sub { return $self->bot_reconnect(@_) },
    error => sub { return $self->bot_reconnect(@_) },
    contact_request_subscribe => sub { return $self->bot_subscription_request(@_) },
    contact_subscribed => sub { return $self->bot_contact_subscribed(@_) },
  );
 
  $self->bot_started($bot);
  
  return;
}
 
# Override to hook more stuff
sub bot_started {}
 
sub bot_connected {
  my ($self, $bot, $acc) = @_;
 
  print STDERR "Connected ",$acc->jid,"\n";
 
  return;
}
 
sub bot_reconnect {
  my ($self, $bot) = @_;
  
  my $t; $t = AnyEvent->timer(
    after => .5,
    cb => sub {
      $bot->update_connections;
      undef $t;
    }
  );
  
  return;
}
 
sub bot_subscription_request {
  my ($self, $bot, $acc, $roster, $contact) = @_;
  
  $contact->send_subscribed;
  $contact->send_subscribe;
  
  return;
}
 
sub bot_contact_subscribed {
  my ($self, $bot, $acc, $roster, $contact) = @_;
 
  $bot->send_message('Welcome!', $contact->jid, undef, 'chat');
 
  return;
}
 
 
#############
# HTTP server
 
sub start_http_server {
  my $self = shift;
  
  return unless $self->http_port;
  
  my $server = mojo_server $self->http_host, $self->http_port, sub {
    return $self->handle_http_request(@_);
  };
  $self->http_server($server);
  
  return;
}
 
sub handle_http_request {
  my $self = shift;
  
  $self->http_404_response(@_);
  
  return;
}
 
sub http_404_response {
  my ($self, $tx) = @_;
  my $res = $tx->res;
 
  $res->code(404);
  $res->body('These are not the droids you are looking for...');
  $res->headers->content_type('text/plain');
 
  return;
}
 
1;