Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Add author tests and remove some code smells

  • Loading branch information...
commit 494e24ddab144e7c033e37595a551f045e0fe7dc 1 parent 9438731
Hinrik Örn Sigurðsson authored
100 lib/Bot/BasicBot.pm
@@ -153,6 +153,7 @@ sub run {
153 153
154 154 # run
155 155 $poe_kernel->run() unless $self->{no_run};
  156 + return;
156 157 }
157 158
158 159 =head1 STOPPING THE BOT
@@ -175,7 +176,7 @@ you failed, in which case new() will die.
175 176
176 177 =cut
177 178
178   -sub init { 1; }
  179 +sub init { return 1; }
179 180
180 181
181 182 =head2 said($args)
@@ -230,7 +231,7 @@ Returning undef will cause nothing to be said.
230 231
231 232 =cut
232 233
233   -sub said { undef }
  234 +sub said { return }
234 235
235 236 =head2 emoted( $args )
236 237
@@ -244,7 +245,7 @@ C<emoted> receives the same data hash as C<said>.
244 245 =cut
245 246
246 247 sub emoted {
247   - shift->said(@_);
  248 + return shift->said(@_);
248 249 }
249 250
250 251 =head2 chanjoin( $mess )
@@ -257,7 +258,7 @@ This is a do-nothing implementation, override this in your subclass.
257 258
258 259 =cut
259 260
260   -sub chanjoin { undef }
  261 +sub chanjoin { return }
261 262
262 263 =head2 chanpart( $mess )
263 264
@@ -269,7 +270,7 @@ This is a do-nothing implementation, override this in your subclass.
269 270
270 271 =cut
271 272
272   -sub chanpart { undef }
  273 +sub chanpart { return }
273 274
274 275 =head2 got_names( $mess )
275 276
@@ -290,7 +291,7 @@ method won't be called when that happens.
290 291
291 292 =cut
292 293
293   -sub got_names { undef }
  294 +sub got_names { return }
294 295
295 296 =head2 topic( $mess )
296 297
@@ -300,7 +301,7 @@ channel, and $mess->{topic} will be the new topic of the channel.
300 301
301 302 =cut
302 303
303   -sub topic { undef }
  304 +sub topic { return }
304 305
305 306 =head2 nick_change( $mess )
306 307
@@ -312,7 +313,7 @@ When a user changes nicks, this will be called. $mess looks like
312 313
313 314 =cut
314 315
315   -sub nick_change { undef }
  316 +sub nick_change { return }
316 317
317 318 =head2 kicked( $mess )
318 319
@@ -328,7 +329,7 @@ The reply value is ignored.
328 329
329 330 =cut
330 331
331   -sub kicked { undef }
  332 +sub kicked { return }
332 333
333 334 =head2 tick()
334 335
@@ -360,7 +361,7 @@ whatsoever apart from returning this text.
360 361
361 362 =cut
362 363
363   -sub help { "Sorry, this bot has no interactive help." }
  364 +sub help { return "Sorry, this bot has no interactive help." }
364 365
365 366 =head2 connected
366 367
@@ -369,7 +370,7 @@ to the server
369 370
370 371 =cut
371 372
372   -sub connected { undef }
  373 +sub connected { return }
373 374
374 375 =head2 userquit( $mess )
375 376
@@ -383,6 +384,7 @@ $mess looks like
383 384
384 385 sub userquit {
385 386 my ($self, $mess) = @_;
  387 + return;
386 388 }
387 389
388 390
@@ -404,6 +406,7 @@ sub schedule_tick {
404 406 my $self = shift;
405 407 my $time = shift || 5;
406 408 $self->{kernel}->delay( tick => $time );
  409 + return;
407 410 }
408 411
409 412 =head2 forkit
@@ -479,7 +482,7 @@ sub forkit {
479 482 $args = \%args;
480 483 }
481 484
482   - return undef unless $args->{run};
  485 + return unless $args->{run};
483 486
484 487 $args->{handler} = $args->{handler} || "_fork_said";
485 488 $args->{arguments} = $args->{arguments} || [];
@@ -517,7 +520,7 @@ sub forkit {
517 520 address => $args->{address}
518 521 }
519 522 };
520   - return undef;
  523 + return;
521 524 }
522 525
523 526 sub _fork_said {
@@ -529,6 +532,7 @@ sub _fork_said {
529 532 $args->{body} = $body;
530 533
531 534 $self->say($args);
  535 + return;
532 536 }
533 537
534 538 =head2 say( key => value, .. )
@@ -612,10 +616,12 @@ sub say {
612 616
613 617 # post an event that will send the message
614 618 for my $body (@bodies) {
615   - my ($who, $body) = $self->charset_encode($who, $body);
616   - #warn "$who => $body\n";
617   - $poe_kernel->post( $self->{IRCNAME}, 'privmsg', $who, $body );
  619 + my ($enc_who, $enc_body) = $self->charset_encode($who, $body);
  620 + #warn "$enc_who => $enc_body\n";
  621 + $poe_kernel->post( $self->{IRCNAME}, 'privmsg', $enc_who, $enc_body );
618 622 }
  623 +
  624 + return;
619 625 }
620 626
621 627 =head2 emote( key => value, .. )
@@ -661,6 +667,7 @@ sub emote {
661 667 # me too; i'll look at it in v0.5 - sb
662 668
663 669 $poe_kernel->post( $self->{IRCNAME}, 'privmsg', $self->charset_encode($who, "\cAACTION " . $body . "\cA") );
  670 + return;
664 671 }
665 672
666 673 =head2 reply($mess, $body)
@@ -709,6 +716,8 @@ sub quit {
709 716 else {
710 717 $poe_kernel->post($self->{IRCNAME}, 'shutdown');
711 718 }
  719 +
  720 + return;
712 721 }
713 722
714 723 =head1 ATTRIBUTES
@@ -811,7 +820,7 @@ sub alt_nicks {
811 820 my @args = ( ref $_[0] eq "ARRAY" ) ? @{ $_[0] } : @_;
812 821 $self->{alt_nicks} = \@args;
813 822 }
814   - @{ $self->{alt_nicks} || [] };
  823 + return @{ $self->{alt_nicks} || [] };
815 824 }
816 825
817 826 =head2 username
@@ -824,7 +833,7 @@ will be the same as our nick.
824 833 sub username {
825 834 my $self = shift;
826 835 $self->{username} = shift if @_;
827   - $self->{username} or $self->nick;
  836 + return defined $self->{username} ? $self->{username} : $self->nick;
828 837 }
829 838
830 839 =head2 name
@@ -837,7 +846,7 @@ The name that the bot will identify itself as. Defaults to
837 846 sub name {
838 847 my $self = shift;
839 848 $self->{name} = shift if @_;
840   - $self->{name} or $self->nick . " bot";
  849 + return defined $self->{name} ? $self->{name} : $self->nick . " bot";
841 850 }
842 851
843 852 =head2 channels
@@ -854,7 +863,7 @@ sub channels {
854 863 my @args = ( ref $_[0] eq "ARRAY" ) ? @{ $_[0] } : @_;
855 864 $self->{channels} = \@args;
856 865 }
857   - @{ $self->{channels} || [] };
  866 + return @{ $self->{channels} || [] };
858 867 }
859 868
860 869 =head2 quit_message
@@ -866,7 +875,7 @@ The quit message. Defaults to "Bye".
866 875 sub quit_message {
867 876 my $self = shift;
868 877 $self->{quit_message} = shift if @_;
869   - defined( $self->{quit_message} ) ? $self->{quit_message} : "Bye";
  878 + return defined $self->{quit_message} ? $self->{quit_message} : "Bye";
870 879 }
871 880
872 881 =head2 ignore_list
@@ -884,7 +893,7 @@ sub ignore_list {
884 893 my @args = ( ref $_[0] eq "ARRAY" ) ? @{ $_[0] } : @_;
885 894 $self->{ignore_list} = \@args;
886 895 }
887   - @{ $self->{ignore_list} || [] };
  896 + return @{ $self->{ignore_list} || [] };
888 897 }
889 898
890 899 =head2 charset
@@ -915,7 +924,7 @@ Set to '1' to disable the built-in flood protection of POE::Compoent::IRC
915 924 sub flood {
916 925 my $self = shift;
917 926 $self->{flood} = shift if @_;
918   - $self->{flood};
  927 + return $self->{flood};
919 928 }
920 929
921 930 =head1 STATES
@@ -959,6 +968,8 @@ sub start_state {
959 968 ),
960 969 }
961 970 );
  971 +
  972 + return;
962 973 }
963 974
964 975 =head2 stop_state
@@ -993,6 +1004,7 @@ sub irc_001_state {
993 1004 $self->schedule_tick(5);
994 1005
995 1006 $self->connected();
  1007 + return;
996 1008 }
997 1009
998 1010 =head2 irc_disconnected_state
@@ -1009,6 +1021,7 @@ sub irc_disconnected_state {
1009 1021 $kernel->post($self->{IRCNAME}, 'shutdown');
1010 1022 delete $self->{shutting_down};
1011 1023 }
  1024 + return;
1012 1025 }
1013 1026
1014 1027 =head2 irc_error_state
@@ -1020,6 +1033,7 @@ Called if there is an irc server error. Logs the error.
1020 1033 sub irc_error_state {
1021 1034 my ( $self, $err, $kernel ) = @_[ OBJECT, ARG0, KERNEL ];
1022 1035 $self->log("Server error occurred! $err\n");
  1036 + return;
1023 1037 }
1024 1038
1025 1039 =head2 irc_kicked_state
@@ -1037,6 +1051,7 @@ sub irc_kicked_state {
1037 1051 my $nick = $self->nick_strip($nickstring);
1038 1052 $_[OBJECT]->_remove_from_channel( $channel, $kicked );
1039 1053 $self->kicked({ channel => $channel, who => $nick, kicked => $kicked, reason => $reason });
  1054 + return;
1040 1055 }
1041 1056
1042 1057 =head2 irc_join_state
@@ -1047,6 +1062,7 @@ Called if someone joins. Used for nick tracking
1047 1062
1048 1063 sub irc_join_state {
1049 1064 my ( $self, $nick ) = @_[ OBJECT, ARG0 ];
  1065 + return;
1050 1066 }
1051 1067
1052 1068 =head2 irc_nick_state
@@ -1063,12 +1079,14 @@ sub irc_nick_state {
1063 1079 = delete $self->{channel_data}{$channel}{$nick};
1064 1080 }
1065 1081 $self->nick_change($nick, $newnick);
  1082 + return;
1066 1083 }
1067 1084
1068 1085 =head2 irc_mode_state
1069 1086
1070 1087 =cut
1071 1088
  1089 +## no critic (ControlStructures::ProhibitCascadingIfElse)
1072 1090 sub irc_mode_state {
1073 1091 my ($self, $kernel, $session) = @_[OBJECT, KERNEL, SESSION];
1074 1092 my ($nickstring, $channel, $mode, @ops) = @_[ARG0..$#_];
@@ -1081,23 +1099,24 @@ sub irc_mode_state {
1081 1099
1082 1100 my $op = shift(@modes);
1083 1101
1084   - if ($added and $op eq 'o') {
  1102 + if ($added && $op eq 'o') {
1085 1103 $current->{op} = 1;
1086 1104 $current->{voice} = 0;
1087 1105
1088   - } elsif ($added and $op eq 'v') {
  1106 + } elsif ($added && $op eq 'v') {
1089 1107 $current->{voice} = 1 unless $current->{op};
1090 1108
1091   - } elsif (!$added and $op eq 'o') {
  1109 + } elsif (!$added && $op eq 'o') {
1092 1110 $current->{op} = 0;
1093 1111 $current->{voice} = 0;
1094 1112
1095   - } elsif (!$added and $op eq 'v') {
  1113 + } elsif (!$added && $op eq 'v') {
1096 1114 $current->{voice} = 1 unless $current->{op};
1097 1115 }
1098 1116
1099 1117 $self->{channel_data}{$channel}{$who} = $current;
1100 1118 }
  1119 + return;
1101 1120 }
1102 1121
1103 1122
@@ -1116,6 +1135,7 @@ sub irc_quit_state {
1116 1135 # do this second, so that the userquit implementor has a chance to see
1117 1136 # which channels they left
1118 1137 $self->_remove_from_all_channels( $nick );
  1138 + return;
1119 1139 }
1120 1140
1121 1141 =head2 irc_said_state
@@ -1127,6 +1147,7 @@ formats it into a nicer format and calls 'said'
1127 1147
1128 1148 sub irc_said_state {
1129 1149 irc_received_state( 'said', 'say', @_ );
  1150 + return;
1130 1151 }
1131 1152
1132 1153 =head2 irc_emoted_state
@@ -1139,6 +1160,7 @@ which deals with it as if it was a spoken phrase.
1139 1160
1140 1161 sub irc_emoted_state {
1141 1162 irc_received_state( 'emoted', 'emote', @_ );
  1163 + return;
1142 1164 }
1143 1165
1144 1166 =head2 irc_received_state
@@ -1185,15 +1207,15 @@ sub irc_received_state {
1185 1207
1186 1208 $mess->{body} = $body;
1187 1209 unless ( $mess->{channel} eq "msg" ) {
1188   - my $nick = $self->nick;
  1210 + my $own_nick = $self->nick;
1189 1211
1190   - if ( $mess->{body} =~ s/^(\Q$nick\E)\s*[:,-]?\s*//i ) {
  1212 + if ( $mess->{body} =~ s/^(\Q$own_nick\E)\s*[:,-]?\s*//i ) {
1191 1213 $mess->{address} = $1;
1192 1214 }
1193 1215
1194   - foreach $nick ( $self->alt_nicks ) {
  1216 + foreach my $alt_nick ( $self->alt_nicks ) {
1195 1217 last if $mess->{address};
1196   - if ( $mess->{body} =~ s/^(\Q$nick\E)\s*[:,-]?\s*//i ) {
  1218 + if ( $mess->{body} =~ s/^(\Q$alt_nick\E)\s*[:,-]?\s*//i ) {
1197 1219 $mess->{address} = $1;
1198 1220 }
1199 1221 }
@@ -1243,6 +1265,7 @@ sub irc_chanjoin_state {
1243 1265 }
1244 1266 $_[OBJECT]->_add_to_channel( $channel, $nick );
1245 1267 irc_chan_received_state( 'chanjoin', 'say', @_ );
  1268 + return;
1246 1269 }
1247 1270
1248 1271 =head2 irc_chanpart_state
@@ -1262,6 +1285,7 @@ sub irc_chanpart_state {
1262 1285 }
1263 1286 $_[OBJECT]->_remove_from_channel( $channel, $nick );
1264 1287 irc_chan_received_state( 'chanpart', 'say', @_ );
  1288 + return;
1265 1289 }
1266 1290
1267 1291 =head2 irc_chan_received_state
@@ -1314,6 +1338,7 @@ from memory.
1314 1338 sub fork_close_state {
1315 1339 my ( $self, $wheel_id ) = @_[ 0, ARG0 ];
1316 1340 delete $self->{forks}->{$wheel_id};
  1341 + return;
1317 1342 }
1318 1343
1319 1344 =head2 fork_error_state
@@ -1337,6 +1362,7 @@ sub tick_state {
1337 1362 my ( $self, $kernel, $heap ) = @_[ OBJECT, KERNEL, HEAP ];
1338 1363 my $delay = $self->tick();
1339 1364 $self->schedule_tick($delay) if $delay;
  1365 + return;
1340 1366 }
1341 1367
1342 1368 =head2 names_state
@@ -1360,6 +1386,7 @@ sub names_state {
1360 1386 voice => $voice,
1361 1387 }
1362 1388 }
  1389 + return;
1363 1390 }
1364 1391
1365 1392 =head2 names_done_state
@@ -1376,6 +1403,7 @@ sub names_done_state {
1376 1403 return unless $built;
1377 1404 $self->{channel_data}{$channel} = $built;
1378 1405 $self->names({ channel => $channel, names => $built });
  1406 + return;
1379 1407 }
1380 1408
1381 1409
@@ -1383,11 +1411,13 @@ sub _add_to_channel {
1383 1411 my ($self, $channel, $nick, $ops) = @_;
1384 1412 $ops ||= { op => 0, voice => 0 };
1385 1413 $self->{channel_data}{$channel}{$nick} = $ops;
  1414 + return;
1386 1415 }
1387 1416
1388 1417 sub _remove_from_channel {
1389 1418 my ($self, $channel, $nick) = @_;
1390 1419 delete $self->{channel_data}{$channel}{$nick};
  1420 + return;
1391 1421 }
1392 1422
1393 1423 sub _remove_from_all_channels {
@@ -1397,6 +1427,7 @@ sub _remove_from_all_channels {
1397 1427 $self->_remove_from_channel( $channel, $nick );
1398 1428 }
1399 1429 }
  1430 + return;
1400 1431 }
1401 1432
1402 1433 =head2 topic_raw_state
@@ -1407,6 +1438,7 @@ sub topic_raw_state {
1407 1438 my ($self, $kernel, $server, $raw) = @_[OBJECT, KERNEL, ARG0, ARG1];
1408 1439 my ($channel, $topic) = split(/ :/, $raw, 2);
1409 1440 $self->topic({ channel => $channel, who => undef, topic => $topic });
  1441 + return;
1410 1442 }
1411 1443
1412 1444 =head2 topic_state
@@ -1418,6 +1450,7 @@ sub topic_state {
1418 1450 = @_[OBJECT, KERNEL, ARG0, ARG1, ARG2];
1419 1451 my $nick = $self->nick_strip($nickraw);
1420 1452 $self->topic({ channel => $channel, who => $nick, topic => $topic });
  1453 + return;
1421 1454 }
1422 1455
1423 1456 =head2 shutdown_state
@@ -1431,6 +1464,7 @@ sub shutdown_state {
1431 1464 for my $fork (values %{ $self->{forks} }) {
1432 1465 $fork->{wheel}->kill();
1433 1466 }
  1467 + return;
1434 1468 }
1435 1469
1436 1470 =head1 OTHER METHODS
@@ -1453,6 +1487,7 @@ sub AUTOLOAD {
1453 1487 our $AUTOLOAD;
1454 1488 $AUTOLOAD =~ s/.*:://;
1455 1489 $poe_kernel->post( $self->{IRCNAME}, $AUTOLOAD, $self->charset_encode(@_) );
  1490 + return;
1456 1491 }
1457 1492
1458 1493 =head2 log
@@ -1470,6 +1505,7 @@ sub log {
1470 1505 chomp $log_entry;
1471 1506 print STDERR "$log_entry\n";
1472 1507 }
  1508 + return;
1473 1509 }
1474 1510
1475 1511 =head2 ignore_nick($nick)
@@ -1480,7 +1516,7 @@ the ignore list
1480 1516 =cut
1481 1517
1482 1518 sub ignore_nick {
1483   - local $_;
  1519 + local $_ = undef;
1484 1520 my $self = shift;
1485 1521 my $nick = shift;
1486 1522 return grep { $nick eq $_ } @{ $self->{ignore_list} };
20 xt/perl_critic.t
... ... @@ -0,0 +1,20 @@
  1 +use strict;
  2 +use warnings;
  3 +use File::Spec;
  4 +use Test::More;
  5 +use English qw(-no_match_vars);
  6 +
  7 +eval { require Test::Perl::Critic; };
  8 +
  9 +if ( $EVAL_ERROR ) {
  10 + my $msg = 'Test::Perl::Critic required to criticise code';
  11 + plan( skip_all => $msg );
  12 +}
  13 +elsif ($Perl::Critic::VERSION lt 1.108) {
  14 + my $msg = 'Perl::Critic >= 1.108 required to criticise code';
  15 + plan( skip_all => $msg );
  16 +}
  17 +
  18 +my $rcfile = File::Spec->catfile( 'xt', 'perlcriticrc' );
  19 +Test::Perl::Critic->import( -profile => $rcfile );
  20 +all_critic_ok();
20 xt/perl_critic_t.t
... ... @@ -0,0 +1,20 @@
  1 +use strict;
  2 +use warnings;
  3 +use File::Spec;
  4 +use Test::More;
  5 +use English qw(-no_match_vars);
  6 +
  7 +eval { require Test::Perl::Critic; };
  8 +
  9 +if ( $EVAL_ERROR ) {
  10 + my $msg = 'Test::Perl::Critic required to criticise code';
  11 + plan( skip_all => $msg );
  12 +}
  13 +elsif ($Perl::Critic::VERSION lt 1.108) {
  14 + my $msg = 'Perl::Critic >= 1.108 required to criticise code';
  15 + plan( skip_all => $msg );
  16 +}
  17 +
  18 +my $rcfile = File::Spec->catfile( 'xt', 'perlcriticrc_t' );
  19 +Test::Perl::Critic->import( -profile => $rcfile );
  20 +all_critic_ok(glob 't/0*');
26 xt/perlcriticrc
... ... @@ -0,0 +1,26 @@
  1 +# level 3 is a nice compromise
  2 +severity = 3
  3 +verbose = 3
  4 +
  5 +# these policies are either too anal, demand additional dependencies,
  6 +# or inhibit backwards-compatability
  7 +[-RegularExpressions::RequireExtendedFormatting]
  8 +[-RegularExpressions::ProhibitCaptureWithoutTest]
  9 +
  10 +[-ValuesAndExpressions::ProhibitConstantPragma]
  11 +
  12 +[-Variables::ProhibitPackageVars]
  13 +[-Variables::RequireLocalizedPunctuationVars]
  14 +
  15 +[-BuiltinFunctions::ProhibitStringyEval]
  16 +
  17 +[-Subroutines::ProhibitBuiltinHomonyms]
  18 +[-Subroutines::RequireArgUnpacking]
  19 +[-Subroutines::ProhibitUnusedPrivateSubroutines]
  20 +
  21 +[-ErrorHandling::RequireCarping]
  22 +[-ErrorHandling::RequireCheckingReturnValueOfEval]
  23 +
  24 +[-ClassHierarchies::ProhibitAutoloading]
  25 +
  26 +[-Modules::ProhibitAutomaticExportation]
28 xt/perlcriticrc_t
... ... @@ -0,0 +1,28 @@
  1 +# level 3 is a nice compromise
  2 +severity = 3
  3 +verbose = 3
  4 +
  5 +# these policies are either too anal, demand additional dependencies,
  6 +# or inhibit backwards-compatability
  7 +[-RegularExpressions::RequireExtendedFormatting]
  8 +
  9 +[-ValuesAndExpressions::ProhibitConstantPragma]
  10 +
  11 +[-Variables::ProhibitPackageVars]
  12 +[-Variables::RequireLocalizedPunctuationVars]
  13 +
  14 +[-BuiltinFunctions::ProhibitStringyEval]
  15 +
  16 +[-Subroutines::ProhibitBuiltinHomonyms]
  17 +[-Subroutines::RequireArgUnpacking]
  18 +
  19 +[-ErrorHandling::RequireCarping]
  20 +[-ErrorHandling::RequireCheckingReturnValueOfEval]
  21 +
  22 +# more policies we don't care about in tests
  23 +[-InputOutput::RequireBriefOpen]
  24 +[-Modules::RequireEndWithOne]
  25 +[-Modules::RequireExplicitPackage]
  26 +[-Modules::RequireFilenameMatchesPackage]
  27 +[-Subroutines::RequireFinalReturn]
  28 +[-ControlStructures::ProhibitCascadingIfElse]
4 xt/pod.t
... ... @@ -0,0 +1,4 @@
  1 +use Test::More;
  2 +eval "use Test::Pod 1.00";
  3 +plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
  4 +all_pod_files_ok();
9 xt/pod_coverage.t
... ... @@ -0,0 +1,9 @@
  1 +use Test::More;
  2 +eval "use Test::Pod::Coverage 1.00";
  3 +plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@;
  4 +
  5 +my @modules = all_modules();
  6 +
  7 +plan tests => scalar @modules;
  8 +
  9 +pod_coverage_ok($_) for @modules;

0 comments on commit 494e24d

Please sign in to comment.
Something went wrong with that request. Please try again.