Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 140 lines (117 sloc) 3.893 kb
8bc4a0b Relay bot for commits (with colour removal).
Benjamin Smith authored
1 #!/usr/bin/env perl
2
3 use strict;
4 use warnings;
5 use POE qw(Component::IRC Component::IRC::Plugin::Connector
6 Component::IRC::Plugin::CTCP);
7
8 our $NICK = "poecommits";
9
10 our $IN_SERVER = "irc.freenode.net";
11 our $IN_CHANNEL = "#commits";
12 our $OUT_SERVER = "irc.perl.org";
13 our $OUT_CHANNEL = "#poe";
14
15 POE::Session->create(
16 package_states => [
b42ea1a @rcaputo Reflow commit messages for IRC.
authored
17 'My::Receiver' => [ qw(_start irc_001 irc_public shutdown flush_commit) ],
8bc4a0b Relay bot for commits (with colour removal).
Benjamin Smith authored
18 ],
19 );
20
21 POE::Session->create(
22 package_states => [
23 'My::Transmitter' => [ qw(_start irc_001 irc_public a_commit) ],
24 ],
25 );
26
27 {
28 package My::Receiver;
29 use POE;
b42ea1a @rcaputo Reflow commit messages for IRC.
authored
30
31 my %interesting_projects = (
32 poe => 1,
33 );
34
8bc4a0b Relay bot for commits (with colour removal).
Benjamin Smith authored
35 sub _start {
36 $_[KERNEL]->alias_set('receiver');
37 my $irc = $_[HEAP]->{irc} = POE::Component::IRC->spawn(
38 nick => $NICK,
39 server => $IN_SERVER,
40 ircname => "irc.perl.org #poe commit relay (IN)",
41 ) or die $!;
42 $irc->yield(register => qw(001 public));
43 $irc->plugin_add(Connector => POE::Component::IRC::Plugin::Connector->new);
44 $irc->plugin_add(CTCP => POE::Component::IRC::Plugin::CTCP->new);
45 $irc->yield(connect => {});
46 }
47 sub irc_001 {
48 $_[KERNEL]->post($_[SENDER] => join => $IN_CHANNEL);
49 }
50 sub irc_public {
b42ea1a @rcaputo Reflow commit messages for IRC.
authored
51 my ($kernel, $heap) = @_[KERNEL, HEAP];
52 my ($irc, $who, $where, $what) = ($heap->{irc}, @_[ARG0..ARG2]);
8bc4a0b Relay bot for commits (with colour removal).
Benjamin Smith authored
53 my $channel = $where->[0];
54 return unless $channel eq $IN_CHANNEL;
55 return unless $who =~ m/^CIA-\d+!.=cia@/i;
56 $what =~ s/\cC\d+(,\d+)*//g;
57 $what =~ tr/\x00-\x1f//d;
b42ea1a @rcaputo Reflow commit messages for IRC.
authored
58 my ($project) = $what =~ m/(\w+):/;
8bc4a0b Relay bot for commits (with colour removal).
Benjamin Smith authored
59 print "<$channel> <$who> <$project> <$what>\n";
b42ea1a @rcaputo Reflow commit messages for IRC.
authored
60 return unless $project and exists($interesting_projects{$project});
61
62 # Remove the project.
63 $what =~ s/\w+:\s*//;
64
65 # Find the start of a commit.
66 my ($committer, $revision) = $what =~ m/(\S+)\s*\*\s*(r\d+)/;
67 if ($revision) {
68
69 # If there's a previous commit, flush it.
70 if ($heap->{commit}{$project}) {
71 $kernel->alarm_remove($heap->{delay}{$project});
72 $kernel->post(transmitter => a_commit => $project, join(" ", $heap->{commit}));
73 print " signaled transmitter (previous commit)\n";
74 }
75
76 # Start the new commit.
77 $heap->{commit}{$project} = [ $what ];
78 $heap->{delay}{$project} = $kernel->delay_set(flush_commit => 5, $project);
79 return;
80 }
81
82 # Don't push new lines onto projects that haven't started.
83 return unless exists $heap->{commit}{$project};
84
85 push @{$heap->{commit}{$project}}, $what;
8bc4a0b Relay bot for commits (with colour removal).
Benjamin Smith authored
86 }
b42ea1a @rcaputo Reflow commit messages for IRC.
authored
87
88 sub flush_commit {
89 my ($kernel, $heap, $project) = @_[KERNEL, HEAP, ARG0];
90 $kernel->post(transmitter => a_commit => $project, join(" ", @{$heap->{commit}{$project}}));
91 delete $heap->{commit}{$project};
92 delete $heap->{delay}{$project};
93 print " signaled transmitter (flushed $project)\n";
94 }
95
8bc4a0b Relay bot for commits (with colour removal).
Benjamin Smith authored
96 sub shutdown {
97 $_[HEAP]->{irc}->yield('shutdown');
98 }
99 }
100
101 {
102 package My::Transmitter;
103 use POE;
b42ea1a @rcaputo Reflow commit messages for IRC.
authored
104
105 use Text::Wrap qw(wrap $columns $huge);
106 $columns = 475;
107 $huge = "wrap";
108
8bc4a0b Relay bot for commits (with colour removal).
Benjamin Smith authored
109 sub _start {
110 $_[KERNEL]->alias_set('transmitter');
111 my $irc = $_[HEAP]->{irc} = POE::Component::IRC->spawn(
112 nick => $NICK,
113 server => $OUT_SERVER,
114 ircname => "irc.perl.org #poe commit relay (OUT)",
115 ) or die $!;
116 $irc->yield(register => qw(001 public));
117 $irc->plugin_add(Connector => POE::Component::IRC::Plugin::Connector->new);
118 $irc->plugin_add(CTCP => POE::Component::IRC::Plugin::CTCP->new);
119 $irc->yield(connect => {});
120 }
121 sub irc_001 {
122 $_[KERNEL]->post($_[SENDER] => join => $OUT_CHANNEL);
123 }
124 sub irc_public { }
125 sub a_commit {
b42ea1a @rcaputo Reflow commit messages for IRC.
authored
126 my ($project, $message) = @_[ARG0, ARG1];
127 my @commit = wrap("","",$message);
128
129 print "got commit: $project: $message\n";
130
131 foreach (@commit) {
132 chomp;
133 print "a_commit <$project: $_>\n";
134 $_[HEAP]->{irc}->yield(privmsg => $OUT_CHANNEL => "($project) $_");
135 }
8bc4a0b Relay bot for commits (with colour removal).
Benjamin Smith authored
136 }
137 }
138
139 $poe_kernel->run;
Something went wrong with that request. Please try again.