1 8f7f2f4a 2021-12-17 jrmu #!/usr/bin/perl
 2 8f7f2f4a 2021-12-17 jrmu use strict;
 3 8f7f2f4a 2021-12-17 jrmu use warnings;
 4 8f7f2f4a 2021-12-17 jrmu 
 5 8f7f2f4a 2021-12-17 jrmu package MonopBot;
 6 8f7f2f4a 2021-12-17 jrmu use base qw(Bot::BasicBot);
 7 8f7f2f4a 2021-12-17 jrmu use Expect;
 8 8f7f2f4a 2021-12-17 jrmu $Expect::Log_Stdout = 0;
 9 8f7f2f4a 2021-12-17 jrmu $Expect::Multiline_Matching = 0;
10 8f7f2f4a 2021-12-17 jrmu my $command = 'monop';
11 8f7f2f4a 2021-12-17 jrmu my $timeout = 300;
12 8f7f2f4a 2021-12-17 jrmu my $exp = new Expect;
13 8f7f2f4a 2021-12-17 jrmu $exp->raw_pty(1);
14 8f7f2f4a 2021-12-17 jrmu $exp->spawn($command, ()) or die "Cannot spawn $command: $!\n";
15 8f7f2f4a 2021-12-17 jrmu 
16 8f7f2f4a 2021-12-17 jrmu my $output;
17 8f7f2f4a 2021-12-17 jrmu my @nicks;
18 8f7f2f4a 2021-12-17 jrmu 
19 8f7f2f4a 2021-12-17 jrmu # returns output from command
20 8f7f2f4a 2021-12-17 jrmu sub readcmd {
21 8f7f2f4a 2021-12-17 jrmu 	my @results = $exp->expect($timeout, -re => '^[\n\s[:print:]]+$');
22 8f7f2f4a 2021-12-17 jrmu 	my ($pos, $error, $match, $before, $after) = @results;
23 8f7f2f4a 2021-12-17 jrmu 	return $before.$match.$after;
24 8f7f2f4a 2021-12-17 jrmu }
25 8f7f2f4a 2021-12-17 jrmu 
26 8f7f2f4a 2021-12-17 jrmu sub got_names {
27 8f7f2f4a 2021-12-17 jrmu 	my $self      = shift;
28 8f7f2f4a 2021-12-17 jrmu 	my $arguments = shift;
29 8f7f2f4a 2021-12-17 jrmu 	@nicks = keys(%{$arguments->{names}});
30 8f7f2f4a 2021-12-17 jrmu }
31 8f7f2f4a 2021-12-17 jrmu 
32 8f7f2f4a 2021-12-17 jrmu sub chanjoin {
33 8f7f2f4a 2021-12-17 jrmu 	my $self      = shift;
34 8f7f2f4a 2021-12-17 jrmu 	my $arguments = shift;
35 8f7f2f4a 2021-12-17 jrmu 	my $nick = $arguments->{who};
36 8f7f2f4a 2021-12-17 jrmu 	if ($nick eq $self->pocoirc->nick_name()) { # bot itself joins
37 8f7f2f4a 2021-12-17 jrmu 		$output = readcmd();
38 8f7f2f4a 2021-12-17 jrmu 		return $output;
39 8f7f2f4a 2021-12-17 jrmu 	}
40 8f7f2f4a 2021-12-17 jrmu 	return;
41 8f7f2f4a 2021-12-17 jrmu }
42 8f7f2f4a 2021-12-17 jrmu 
43 8f7f2f4a 2021-12-17 jrmu sub said {
44 8f7f2f4a 2021-12-17 jrmu 	my $self      = shift;
45 8f7f2f4a 2021-12-17 jrmu 	my $arguments = shift;
46 8f7f2f4a 2021-12-17 jrmu 	if (scalar(@nicks) && grep /^$arguments->{who}$/, @nicks) {
47 8f7f2f4a 2021-12-17 jrmu 		print $exp "$arguments->{body}\n";
48 8f7f2f4a 2021-12-17 jrmu 		$output = readcmd();
49 8f7f2f4a 2021-12-17 jrmu 		return $output;
50 8f7f2f4a 2021-12-17 jrmu 	}
51 8f7f2f4a 2021-12-17 jrmu 	return;
52 8f7f2f4a 2021-12-17 jrmu }
53 8f7f2f4a 2021-12-17 jrmu 
54 8f7f2f4a 2021-12-17 jrmu package main;
55 8f7f2f4a 2021-12-17 jrmu 
56 8f7f2f4a 2021-12-17 jrmu my $bot = MonopBot->new(
57 8f7f2f4a 2021-12-17 jrmu 	server      => 'irc.example.com',
58 8f7f2f4a 2021-12-17 jrmu 	port        => '6667',
59 8f7f2f4a 2021-12-17 jrmu 	channels    => ['#perl105'],
60 8f7f2f4a 2021-12-17 jrmu 	nick        => 'nickname',
61 8f7f2f4a 2021-12-17 jrmu 	name        => 'username',
62 8f7f2f4a 2021-12-17 jrmu );
63 8f7f2f4a 2021-12-17 jrmu 
64 8f7f2f4a 2021-12-17 jrmu local $SIG{INT} = sub {
65 8f7f2f4a 2021-12-17 jrmu 	$exp->hard_close();
66 8f7f2f4a 2021-12-17 jrmu 	print "Quitting program...\n";
67 8f7f2f4a 2021-12-17 jrmu 	$bot->shutdown("Quitting...");
68 8f7f2f4a 2021-12-17 jrmu };
69 8f7f2f4a 2021-12-17 jrmu $bot->run();