File Coverage

blib/lib/Bot/IRC/Greeting.pm
Criterion Covered Total %
statement 28 30 93.3
branch 9 16 56.2
condition 6 14 42.8
subroutine 7 7 100.0
pod 0 2 0.0
total 50 69 72.4


line stmt bran cond sub pod time code
1             package Bot::IRC::Greeting;
2             # ABSTRACT: Bot::IRC greet joining users to channels
3              
4 1     1   2979 use 5.014;
  1         7  
5 1     1   7 use exact;
  1         2  
  1         10  
6              
7 1     1   2146 use DateTime;
  1         495744  
  1         54  
8 1     1   538 use DateTime::Format::Human::Duration;
  1         2155  
  1         597  
9              
10             our $VERSION = '1.40'; # VERSION
11              
12             sub init {
13 1     1 0 6252 my ($bot) = @_;
14 1         5 my $vars = $bot->vars;
15 1 50 50     9 my $greeting = ( not ref $vars ) ? $vars : $vars->{greeting} // 'greetings';
16 1 50       5 my $channels = ( ref $vars ) ? $vars->{channels} : undef;
17              
18             $bot->hook(
19             {
20             command => 'JOIN',
21             },
22             sub {
23 1     1   301 my ( $bot, $in ) = @_;
24              
25 1 50 33     9 unless ( ref $channels and not grep { $_ eq $in->{forum} } @$channels ) {
  0         0  
26 1         5 $bot->reply_to( greeting_based_on_nick( $greeting, $in->{nick} ) );
27 1         21 return;
28             }
29             },
30 1 50 33     12 ) unless ( defined $channels and not ref $channels and $channels == 0 );
      33        
31             }
32              
33             sub greeting_based_on_nick {
34 1     1 0 3 my ( $greeting, $nick ) = @_;
35              
36 1 50       7 if ( $nick !~ /[a-z]/ ) {
37 0         0 $greeting = uc($greeting);
38             }
39             else {
40 1   66     9 for ( my $i = 0; $i < length($greeting) and $i < length( $nick ); $i++ ) {
41 7         12 my $letter = substr( $nick, $i, 1 );
42 7 100       31 substr( $greeting, $i, 1, uc( substr( $greeting, $i, 1 ) ) ) if ( $letter =~ /[A-Z]/ );
43             }
44             }
45 1 50       4 $greeting =~ tr/oi/01/ if ( $nick =~ /[0-9]/ );
46 1 50       14 $greeting .= $1 if ( $nick =~ /(_+)$/ );
47              
48 1         8 return $greeting;
49             }
50              
51             1;
52              
53             __END__
54              
55             =pod
56              
57             =encoding UTF-8
58              
59             =head1 NAME
60              
61             Bot::IRC::Greeting - Bot::IRC greet joining users to channels
62              
63             =head1 VERSION
64              
65             version 1.40
66              
67             =head1 SYNOPSIS
68              
69             use Bot::IRC;
70              
71             Bot::IRC->new(
72             connect => { server => 'irc.perl.org' },
73             plugins => ['Greeting'],
74             vars => {
75             greeting => {
76             greeting => 'morning',
77             channels => [ '#perl', '#perl-help' ],
78             },
79             },
80             )->run;
81              
82             =head1 DESCRIPTION
83              
84             This L<Bot::IRC> plugin causes the bot to greet joining users to channels.
85             By default, it will say something like "greetings" to whomever joins. The bot
86             will change the style of "greetings" to somewhat match the user's nick style.
87             For example, if "John" joins, the bot will say "Greetings" to him. If
88             "joan_" joins, the bot will say "greetings_" to her.
89              
90             You can specify the greeting word and channel list with C<vars>.
91              
92             greeting => 'morning',
93             channels => [ '#perl', '#perl-help' ],
94              
95             If greeting isn't specified, the bot will use "greetings" as the greeting. If
96             a channel list isn't supplied, the bot will greet on all channels it's on. If
97             you specify a greeting of empty string or some other false value, the greeting
98             will get skipped.
99              
100             =head2 SEE ALSO
101              
102             L<Bot::IRC>
103              
104             =for Pod::Coverage init greeting_based_on_nick
105              
106             =head1 AUTHOR
107              
108             Gryphon Shafer <gryphon@cpan.org>
109              
110             =head1 COPYRIGHT AND LICENSE
111              
112             This software is Copyright (c) 2016-2050 by Gryphon Shafer.
113              
114             This is free software, licensed under:
115              
116             The Artistic License 2.0 (GPL Compatible)
117              
118             =cut