Skip to content

Commit 0f36393

Browse files
toddrtoddr
authored
Merge pull request #56 from toddr-bot/koan.toddr.bot/add-graceful-shutdown
feature: add Stop() for graceful Start() loop shutdown
2 parents 8511f1f + 5ca601a commit 0f36393

File tree

2 files changed

+235
-3
lines changed

2 files changed

+235
-3
lines changed

‎lib/Net/Jabber/Bot.pm‎

Lines changed: 28 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -79,6 +79,8 @@ has 'messages_sent_today' => (
7979
}
8080
);
8181

82+
has '_running' => ( isa => Bool, is => 'rw', default => 0 );
83+
8284
#my %message_function : ATTR; # What is called if we are fed a new message once we are logged in.
8385
#my %bot_background_function : ATTR; # What is called if we are fed a new message once we are logged in.
8486
#my %forum_join_time : ATTR; # Tells us if we've parsed historical messages yet.
@@ -514,7 +516,7 @@ sub Process { # Call connection process.
514516

515517
=item B<Start>
516518
517-
Primary subroutine save new called by the program. Does an endless loop of:
519+
Primary subroutine save new called by the program. Runs a loop of:
518520
519521
=over
520522
@@ -528,6 +530,8 @@ Primary subroutine save new called by the program. Does an endless loop of:
528530
529531
=back
530532
533+
The loop runs until Stop() is called. Returns the loop iteration count.
534+
531535
=cut
532536

533537
sub Start {
@@ -539,9 +543,11 @@ sub Start {
539543
my $message_delay = $self->message_delay;
540544

541545
my $last_background = time - $time_between_background_routines - 1; # Call background process every so often...
542-
my $counter = 0; # Keep track of how many times we've looped. Not sure if we'll use this long term.
546+
my $counter = 0; # Keep track of how many times we've looped.
543547

544-
while (1) { # Loop for ever!
548+
$self->_running(1);
549+
550+
while ( $self->_running ) {
545551
# Process and re-connect if you have to.
546552
eval { $self->Process($process_timeout) };
547553

@@ -561,6 +567,25 @@ sub Start {
561567
}
562568
Time::HiRes::sleep $message_delay;
563569
}
570+
571+
return $counter;
572+
}
573+
574+
=item B<Stop>
575+
576+
$bot->Stop();
577+
578+
Signals the Start() loop to exit after the current iteration completes.
579+
Typically called from within the background_function or message_function callback.
580+
581+
=cut
582+
583+
sub Stop {
584+
my $self = shift;
585+
586+
INFO("Stop requested, will exit Start() loop after current iteration");
587+
$self->_running(0);
588+
return 1;
564589
}
565590

566591
=item B<ReconnectToServer>

‎t/08-test_start_stop.t‎

Lines changed: 207 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,207 @@
1+
#!perl
2+
3+
use strict;
4+
use warnings;
5+
6+
# Override sleep to avoid delays in tests
7+
BEGIN { *CORE::GLOBAL::sleep = sub { }; }
8+
9+
use Test::More tests => 14;
10+
use Net::Jabber::Bot;
11+
12+
# stuff for mock client object
13+
use FindBin;
14+
use lib "$FindBin::Bin/lib";
15+
use MockJabberClient; # Test object
16+
17+
my $server = 'talk.google.com';
18+
19+
my %forums_and_responses;
20+
$forums_and_responses{'test_forum1'} = [ "jbot:", "" ];
21+
22+
# Test 1: Stop() method exists and returns true
23+
{
24+
my $bot = Net::Jabber::Bot->new(
25+
server => $server,
26+
conference_server => "conference.$server",
27+
port => 5222,
28+
username => 'test_username',
29+
password => 'test_pass',
30+
alias => 'stop_test_bot',
31+
message_function => sub { },
32+
background_function => sub { },
33+
loop_sleep_time => 5,
34+
process_timeout => 5,
35+
forums_and_responses => \%forums_and_responses,
36+
out_messages_per_second => 5,
37+
max_message_size => 800,
38+
max_messages_per_hour => 100,
39+
forum_join_grace => 0,
40+
);
41+
42+
isa_ok( $bot, "Net::Jabber::Bot" );
43+
ok( $bot->IsConnected(), "Bot connected after init" );
44+
ok( $bot->Stop(), "Stop() returns true" );
45+
}
46+
47+
# Test 2: Start() exits when Stop() is called from background_function
48+
{
49+
my $bg_count = 0;
50+
my $bot = Net::Jabber::Bot->new(
51+
server => $server,
52+
conference_server => "conference.$server",
53+
port => 5222,
54+
username => 'test_username',
55+
password => 'test_pass',
56+
alias => 'start_stop_bot',
57+
message_function => sub { },
58+
background_function => sub {
59+
my ( $bot_obj, $counter ) = @_;
60+
$bg_count = $counter;
61+
$bot_obj->Stop() if $counter >= 3;
62+
},
63+
loop_sleep_time => 0.01,
64+
process_timeout => 0.01,
65+
forums_and_responses => \%forums_and_responses,
66+
out_messages_per_second => 5,
67+
max_message_size => 800,
68+
max_messages_per_hour => 100,
69+
forum_join_grace => 0,
70+
);
71+
72+
my $iterations = $bot->Start();
73+
ok( !$bot->_running, "Bot is no longer running after Start() returns" );
74+
is( $bg_count, 3, "Background function was called 3 times" );
75+
is( $iterations, 3, "Start() returns the iteration count" );
76+
}
77+
78+
# Test 3: Calling Stop() before Start() does not prevent Start() from running
79+
{
80+
my $bg_count = 0;
81+
my $bot = Net::Jabber::Bot->new(
82+
server => $server,
83+
conference_server => "conference.$server",
84+
port => 5222,
85+
username => 'test_username',
86+
password => 'test_pass',
87+
alias => 'prestop_bot',
88+
message_function => sub { },
89+
background_function => sub {
90+
my ( $bot_obj, $counter ) = @_;
91+
$bg_count = $counter;
92+
$bot_obj->Stop(); # Stop on first background call
93+
},
94+
loop_sleep_time => 0.01,
95+
process_timeout => 0.01,
96+
forums_and_responses => \%forums_and_responses,
97+
out_messages_per_second => 5,
98+
max_message_size => 800,
99+
max_messages_per_hour => 100,
100+
forum_join_grace => 0,
101+
);
102+
103+
$bot->Stop(); # Stop before Start — should have no lasting effect
104+
my $iterations = $bot->Start();
105+
106+
# Start() resets _running to 1, so a prior Stop() does not prevent the loop.
107+
ok( $bg_count > 0, "Start() still runs despite prior Stop() call" );
108+
}
109+
110+
# Test 4: Start() can be called again after Stop()
111+
{
112+
my $total_bg_calls = 0;
113+
my $run_number = 0;
114+
my $bot = Net::Jabber::Bot->new(
115+
server => $server,
116+
conference_server => "conference.$server",
117+
port => 5222,
118+
username => 'test_username',
119+
password => 'test_pass',
120+
alias => 'restart_bot',
121+
message_function => sub { },
122+
background_function => sub {
123+
my ( $bot_obj, $counter ) = @_;
124+
$total_bg_calls++;
125+
$bot_obj->Stop() if $counter >= 2;
126+
},
127+
loop_sleep_time => 0.01,
128+
process_timeout => 0.01,
129+
forums_and_responses => \%forums_and_responses,
130+
out_messages_per_second => 5,
131+
max_message_size => 800,
132+
max_messages_per_hour => 100,
133+
forum_join_grace => 0,
134+
);
135+
136+
my $iters1 = $bot->Start();
137+
is( $iters1, 2, "First Start() ran 2 iterations" );
138+
139+
my $iters2 = $bot->Start();
140+
is( $iters2, 2, "Second Start() ran 2 iterations" );
141+
142+
is( $total_bg_calls, 4, "Background function called 4 times total across both runs" );
143+
}
144+
145+
# Test 5: Stop() from message_function also works
146+
{
147+
my $msg_received = 0;
148+
my $bot = Net::Jabber::Bot->new(
149+
server => $server,
150+
conference_server => "conference.$server",
151+
port => 5222,
152+
username => 'test_username',
153+
password => 'test_pass',
154+
alias => 'msg_stop_bot',
155+
message_function => sub {
156+
my %args = @_;
157+
$msg_received++;
158+
$args{bot_object}->Stop();
159+
},
160+
background_function => sub { },
161+
loop_sleep_time => 0.01,
162+
process_timeout => 0.01,
163+
forums_and_responses => \%forums_and_responses,
164+
out_messages_per_second => 5,
165+
max_message_size => 800,
166+
max_messages_per_hour => 100,
167+
forum_join_grace => 0,
168+
ignore_self_messages => 0,
169+
safety_mode => 0,
170+
);
171+
172+
# Inject a message that will trigger the callback
173+
$bot->SendPersonalMessage( 'test_user@' . $server . '/res', "trigger stop" );
174+
175+
my $iterations = $bot->Start();
176+
ok( $msg_received > 0, "Message function was called" );
177+
ok( !$bot->_running, "Bot stopped from message_function" );
178+
}
179+
180+
# Test 6: Start() handles Process() errors and reconnects, then stops
181+
{
182+
my $bot = Net::Jabber::Bot->new(
183+
server => $server,
184+
conference_server => "conference.$server",
185+
port => 5222,
186+
username => 'test_username',
187+
password => 'test_pass',
188+
alias => 'error_stop_bot',
189+
message_function => sub { },
190+
background_function => sub {
191+
my ( $bot_obj, $counter ) = @_;
192+
$bot_obj->Stop();
193+
},
194+
loop_sleep_time => 0.01,
195+
process_timeout => 0.01,
196+
forums_and_responses => \%forums_and_responses,
197+
out_messages_per_second => 5,
198+
max_message_size => 800,
199+
max_messages_per_hour => 100,
200+
forum_join_grace => 0,
201+
);
202+
203+
ok( $bot->IsConnected(), "Bot connected before Start with errors" );
204+
205+
my $iterations = $bot->Start();
206+
ok( defined $iterations, "Start() returned cleanly even after running" );
207+
}

0 commit comments

Comments
 (0)