File Coverage

blib/lib/Bot/IRC/Join.pm
Criterion Covered Total %
statement 22 59 37.2
branch 0 18 0.0
condition 0 5 0.0
subroutine 4 10 40.0
pod 0 1 0.0
total 26 93 27.9


line stmt bran cond sub pod time code
1             # ABSTRACT: Bot::IRC join and part channels and remember channels state
2              
3             use 5.014;
4 1     1   1845 use exact;
  1         2  
5 1     1   18  
  1         2  
  1         5  
6             our $VERSION = '1.39'; # VERSION
7              
8             my ($bot) = @_;
9             $bot->load('Store');
10 1     1 0 5072  
11 1         7 $bot->hook(
12             {
13             to_me => 1,
14             text => qr/^join\s+(?<channel>\S+)/i,
15             },
16             sub {
17             my ( $bot, $in, $m ) = @_;
18              
19 0     0   0 if ( $m->{channel} =~ /^#\w+$/ ) {
20             $bot->reply( 'I will attempt to join: ' . $m->{channel} );
21 0 0       0 $bot->join( $m->{channel} );
22 0         0 }
23 0         0 else {
24             $bot->reply_to( '"' . $m->{channel} . q{" doesn't appear to be a channel I can join.} );
25             }
26 0         0 },
27             );
28              
29 1         13 $bot->hook(
30             {
31             to_me => 1,
32             text => qr/^(?:part|leave)\s+(?<channel>\S+)/i,
33             },
34             sub {
35             my ( $bot, $in, $m ) = @_;
36              
37 0     0   0 if ( $m->{channel} =~ /^#\w+$/ ) {
38             $bot->reply_to( 'I will depart: ' . $m->{channel} );
39 0 0       0 $bot->part( $m->{channel} );
40 0         0 }
41 0         0 else {
42             $bot->reply_to( '"' . $m->{channel} . q{" doesn't appear to be a valid channel name.} );
43             }
44 0         0 },
45             );
46              
47 1         21 $bot->hook(
48             {
49             to_me => 1,
50             text => qr/^channels\b/i,
51             },
52             sub {
53             my ($bot) = @_;
54             my @channels = @{ $bot->store->get('channels') || [] };
55 0     0   0  
56 0 0       0 $bot->reply_to(
  0         0  
57             (@channels)
58             ? 'I am currently in the following channels: ' .
59             $bot->list( ', ', 'and', sort { $a cmp $b } @channels ) . '.'
60             : 'I am currently not in any channels.'
61 0 0       0 );
  0         0  
62             },
63             );
64              
65 1         18 $bot->helps( join => 'Join and part channels. Usage: join <channel>, part <channel>, channels.' );
66              
67 1         14 {
68             no strict 'refs';
69             for ( qw( join part ) ) {
70 1     1   1156 my $name = ref($bot) . '::' . $_;
  1         2  
  1         462  
  1         1  
71 1         2 *{ $name . '_super' } = *$name{CODE};
72 2         5 }
73 2         7 }
  2         7  
74              
75             $bot->subs(
76             join => sub {
77             my $bot = shift;
78             my @channels = @_;
79 0     0   0 my %channels = map { $_ => 1 } @{ $bot->store->get('channels') || [] };
80 0         0 @channels = keys %channels unless (@channels);
81 0 0       0  
  0         0  
  0         0  
82 0 0       0 my $join = $bot->settings('connect')->{join};
83             if ( not @channels and $join ) {
84 0         0 @channels = ( ref $join eq 'ARRAY' ) ? @$join : $join
85 0 0 0     0 }
86 0 0       0  
87             $bot->join_super(@channels);
88              
89 0         0 $channels{$_} = 1 for (@channels);
90             $bot->store->set( 'channels' => [ keys %channels ] );
91 0         0  
92 0         0 return $bot;
93             },
94 0         0 );
95              
96 1         7 $bot->subs(
97             part => sub {
98             my $bot = shift;
99             my %channels = map { $_ => 1 } @{ $bot->store->get('channels') || [] };
100 0     0   0  
101 0 0       0 $bot->part_super(@_);
  0         0  
  0         0  
102              
103 0         0 delete $channels{$_} for (@_);
104             $bot->store->set( 'channels' => [ keys %channels ] );
105 0         0  
106 0         0 return $bot;
107             },
108 0         0 );
109              
110 1         6 $bot->subs(
111             channels => sub {
112             return shift->store->get('channels') || [];
113             },
114 0   0 0     );
115             }
116 1         16  
117             1;
118              
119              
120             =pod
121              
122             =encoding UTF-8
123              
124             =head1 NAME
125              
126             Bot::IRC::Join - Bot::IRC join and part channels and remember channels state
127              
128             =head1 VERSION
129              
130             version 1.39
131              
132             =head1 SYNOPSIS
133              
134             use Bot::IRC;
135              
136             Bot::IRC->new(
137             connect => { server => 'irc.perl.org' },
138             plugins => ['Join'],
139             )->run;
140              
141             =head1 DESCRIPTION
142              
143             This L<Bot::IRC> plugin handles messages instructing the bot to join or
144             part channels. Tell the bot to join and part channels as such:
145              
146             =head2 join <channel>
147              
148             Join a given channel.
149              
150             =head2 part <channel>
151              
152             Depart a given channel.
153              
154             =head2 SEE ALSO
155              
156             L<Bot::IRC>
157              
158             =for Pod::Coverage init
159              
160             =head1 AUTHOR
161              
162             Gryphon Shafer <gryphon@cpan.org>
163              
164             =head1 COPYRIGHT AND LICENSE
165              
166             This software is Copyright (c) 2016-2050 by Gryphon Shafer.
167              
168             This is free software, licensed under:
169              
170             The Artistic License 2.0 (GPL Compatible)
171              
172             =cut