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