Skip to content
Newer
Older
100755 383 lines (310 sloc) 10.1 KB
f1bbfe2 @afresh1 Add the script to git
authored
1 #!/usr/bin/perl
2 ########################################################################
3 # Copyright (c) 2012 Andrew Fresh <andrew@afresh1.com>
4 #
5 # Permission to use, copy, modify, and distribute this software for any
6 # purpose with or without fee is hereby granted, provided that the above
7 # copyright notice and this permission notice appear in all copies.
8 #
9 # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
10 # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
11 # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
12 # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
13 # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
14 # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
15 # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
16 ########################################################################
17 use strict;
18 use warnings;
19 use 5.010;
20
21 use DB_File;
22 use File::Basename;
23 use File::ChangeNotify;
24 use File::Find;
25 use Net::Twitter;
26
27 my $seen_file = $ENV{HOME} . '/.tweeted_changes';
28 my $auth_file = $ENV{HOME} . '/.auth_tokens';
29
30 my %accounts = (
31 cvs => 'openbsd_cvs',
32 src => 'openbsd_src',
33 ports => 'openbsd_ports',
34 xenocara => 'openbsd_xenocar',
35 www => 'openbsd_www',
36 );
37
38 # Login to twitter
39 foreach my $key ( sort keys %accounts ) {
40 my $account = $accounts{$key};
41 get_twitter_account($account);
42 }
43
44 my @dirs = (
45 'Maildir/.lists.openbsd.source-changes/',
46 'Maildir/.lists.openbsd.ports-changes/',
47 );
48
49 find( sub { check_message($_) }, @dirs );
50
51 my $watcher
52 = File::ChangeNotify->instantiate_watcher( directories => \@dirs, );
53 while ( my @events = $watcher->wait_for_events() ) {
54 foreach my $event (@events) {
55 next unless $event->type eq 'create';
56 check_message( $event->path );
57 }
58 }
59
60 sub check_message {
61 my ($file) = @_;
62 state $seen = load_seen();
63
64 my $commit = parse_commit($file);
65 return unless $commit;
66 return unless $commit->{id};
67
68 return if $seen->{ $commit->{id} };
69
70 my ( $message, $params ) = make_tweet($commit);
71 tweet( $message, $params );
72
73 if ( $params->{who} ne 'openbsd_cvs' ) {
74 tweet( shorten( $commit->{'Module name'} . ': ' . $message ),
75 { %{$params}, who => 'openbsd_cvs' } );
76 }
77 $seen->{ $commit->{id} } = time;
78 sync_seen();
79 }
80
81 sub account_for {
82 my ($module) = @_;
83 return $accounts{$module} || 'openbsd_cvs';
84 }
85
86 sub change_for {
87 my ($commit) = @_;
88 my %changes;
89 my @dirs;
90
4e8fa04 @afresh1 Better messages for files with regress tests
authored
91 my $has_regress = 0;
92 my $has_non_regress = 0;
f1bbfe2 @afresh1 Add the script to git
authored
93 foreach my $key ( keys %{$commit} ) {
94 if ( $key =~ /^(\w+)\s+files$/ ) {
95 $changes{ lc $1 }++;
4e8fa04 @afresh1 Better messages for files with regress tests
authored
96 foreach ( keys %{ $commit->{$key} } ) {
97 my $dir = $_;
98 my @files = @{ $commit->{$key}->{$dir} || [] };
99 @files = '' unless @files;
100
101 if ( $dir =~ s{^regress/}{} ) { $has_regress++ }
102 else { $has_non_regress++ }
103
104 push @dirs, map {"$dir/$_"} @files;
f1bbfe2 @afresh1 Add the script to git
authored
105 }
106 }
107 }
108
4e8fa04 @afresh1 Better messages for files with regress tests
authored
109 my @changes = keys %changes;
110 my $changed = @changes == 1 ? $changes[0] : 'changed';
111
112 unless (@dirs) {
113 if (@changes) {
114 return "$changed something";
115 }
116 return "did something the parser didn't understand";
117 }
118
f1bbfe2 @afresh1 Add the script to git
authored
119 # Put them shortest first
120 @dirs = sort { length $a <=> length $b } @dirs;
79a280d @afresh1 Friendlier wording when we don't know what was changed
authored
121 my $num_changed = @dirs;
f1bbfe2 @afresh1 Add the script to git
authored
122
123 my $match = shift @dirs;
4e8fa04 @afresh1 Better messages for files with regress tests
authored
124 $match //= '';
e869c04 @afresh1 Handle partial word chops better
authored
125
126 my $last = '/';
f1bbfe2 @afresh1 Add the script to git
authored
127 foreach my $dir (@dirs) {
e869c04 @afresh1 Handle partial word chops better
authored
128 $last = chop $match while $dir !~ /^\Q$match/;
f1bbfe2 @afresh1 Add the script to git
authored
129 }
e869c04 @afresh1 Handle partial word chops better
authored
130 $match .= '*' unless not $match or $last eq '/' or $match =~ s{/$}{};
f1bbfe2 @afresh1 Add the script to git
authored
131
5902c80 @afresh1 Just match on files, easier that way
authored
132 $match =~ s{^[\.\/]+}{}; # No need for leading ./
133 $match =~ s{/+$}{}; # one less char most likely
f1bbfe2 @afresh1 Add the script to git
authored
134
4e8fa04 @afresh1 Better messages for files with regress tests
authored
135 my $message = $changed;
136 if ( !$match ) {
79a280d @afresh1 Friendlier wording when we don't know what was changed
authored
137 if ($has_non_regress) {
138 if ( $num_changed > 5 ) { $message .= ' many things' }
139 elsif ( $num_changed > 2 ) { $message .= ' a few things' }
140 elsif ( $num_changed > 1 ) { $message .= ' a couple things' }
141 else { $message .= ' something' }
142 }
143 $message .= ' including' if $has_regress and $has_non_regress;
4e8fa04 @afresh1 Better messages for files with regress tests
authored
144 $message .= ' regression tests' if $has_regress;
145 }
146 elsif ($has_regress) {
147 if ($has_non_regress) {
148 $message .= " $match and regression tests";
149 }
150 else {
151 $message .= " regress/$match";
152 }
153 }
154 else {
155 $message .= " $match";
156 }
f1bbfe2 @afresh1 Add the script to git
authored
157
4e8fa04 @afresh1 Better messages for files with regress tests
authored
158 return $message;
f1bbfe2 @afresh1 Add the script to git
authored
159 }
160
161 sub make_tweet {
162 my ($commit) = @_;
163 my %params = ( who => account_for( $commit->{'Module name'} ), );
164
165 my $by = $commit->{'Changes by'};
166 $by =~ s/\@.*$/\@/;
167
168 my $change = change_for($commit);
169
170 my $message = "$by $change: " . $commit->{'Log message'};
4d86cc5 @afresh1 collapse whitespace
authored
171 $message =~ s/\s+/ /gms;
f1bbfe2 @afresh1 Add the script to git
authored
172
173 return shorten($message), \%params;
174 }
175
176 sub shorten {
177 my ($message) = @_;
178 if ( length $message > 140 ) {
179 $message =~ s/^(.{137}).*/$1/ms;
180 $message =~ s/\s+$//ms;
181 $message .= '...';
182 }
183 return $message;
184 }
185
186 sub tweet {
187 my ( $message, $params ) = @_;
188
189 say "Tweeting $message";
190 eval { get_twitter_account( $params->{who} )->update($message) };
191 if ($@) {
192 warn $@;
193 return 0;
194 }
195 return 1;
196 }
197
198 sub parse_commit {
199 my ($file) = @_;
200 return {} unless -f $file;
201
202 my %commit;
203
204 my $in = 'HEADER';
205 open my $fh, '<', $file or die $!;
206 my $key = '';
207 my $dir = '';
208 while (<$fh>) {
209 chomp;
210
211 if ( $in eq 'HEADER' ) {
212 if (/^Message-ID:\s+(.+?)\s*$/i) { $commit{id} = $1 }
213 unless ($_) { $in = 'BODY' }
214 next;
215 }
216
c3c4fc2 @afresh1 Handle Imports
authored
217 if (/(CVSROOT|Module name|Changes by|Release Tags):\s+(.*)$/) {
f1bbfe2 @afresh1 Add the script to git
authored
218 $commit{$1} = $2;
219 next;
220 }
221 return unless $commit{CVSROOT}; # first thing should be CVSROOT
222
c3c4fc2 @afresh1 Handle Imports
authored
223 if (/^\s*N\s+(.*)\/([^\/]+)/) {
224 push @{ $commit{'Imported files'}{$1} }, $2;
225 }
226
e453c04 @afresh1 Match Update commit messages
authored
227 if (/^(Update of)\s+(.*)\/([^\/]+)$/) {
228 $commit{'Updated files'}{$2} = [$3];
229 next;
230 }
231
27cb5f2 @afresh1 Split handling of Log Message out
authored
232 if (/^(\w+ files):/) {
f1bbfe2 @afresh1 Add the script to git
authored
233 $key = $1;
234 next;
235 }
236
237 if ($key) {
27cb5f2 @afresh1 Split handling of Log Message out
authored
238 chomp;
239 s/^\s+//;
240 unless ($_) { $key = ''; next; }
241
242 my (@files) = split /\s*:\s+/;
243 $dir = shift @files if @files > 1;
244 @files = map {split} @files;
245 next unless $dir;
246
247 push @{ $commit{$key}{$dir} }, @files;
c3c4fc2 @afresh1 Handle Imports
authored
248 next;
27cb5f2 @afresh1 Split handling of Log Message out
authored
249 }
250
251 if (/^Log [Mm]essage:/) {
c3c4fc2 @afresh1 Handle Imports
authored
252 while (<$fh>) {
253 if (/^\s*Vendor Tag:\s+(.*)$/) {
254 $commit{'Vendor Tag'} = $1;
255 $commit{'Log message'} =~ s/\s*Status:\s*$//ms;
256 last;
257 }
258 $commit{'Log message'} .= $_;
259 }
260 next;
f1bbfe2 @afresh1 Add the script to git
authored
261 }
262 }
263 close $fh;
264
265 if ( my $changes = $commit{'Changes by'} ) {
266 my ( $who, $when ) = split /\s+/, $changes, 2;
267 $commit{'Changes by'} = $who;
268 $commit{'Changes on'} = $when;
269 }
270
271 $commit{'Log message'} =~ s/\s+$//ms;
272
273 return \%commit;
274 }
275
276 {
277 my $X;
278
279 sub load_seen {
280 $X = tie my %seen, 'DB_File', $seen_file or die;
281 return \%seen;
282 }
283
284 sub sync_seen {
285 $X->sync;
286 }
287
288 }
289
290 {
291 my %tokens;
292
293 sub get_access_tokens {
294 my ( $account, $nt ) = @_;
295
296 return $tokens{$account} if exists $tokens{$account};
297
298 open my $fh, '<', $auth_file or die $!;
299 while (<$fh>) {
300 chomp;
301 my ($account_from_file, $access_token, $access_token_secret,
302 $user_id, $screen_name
303 ) = split /\s+/;
304
305 if ( $account_from_file eq 'consumer' ) {
306 $tokens{$account_from_file} = {
307 consumer_key => $access_token,
308 consumer_secret => $access_token_secret,
309 };
310 }
311 else {
312 $tokens{$account_from_file} = {
313 access_token => $access_token,
314 access_token_secret => $access_token_secret,
315 user_id => $user_id,
316 screen_name => $screen_name,
317 };
318 }
319 }
320 close $fh;
321 return $tokens{$account} if exists $tokens{$account};
322
323 return unless $nt;
324
325 my $auth_url = $nt->get_authorization_url;
326 print
327 " Authorize $account for this application at:\n $auth_url\nThen, enter the PIN# provided to continue ";
328
329 my $pin = <STDIN>; # wait for input
330 chomp $pin;
331
332 # request_access_token stores the tokens in $nt AND returns them
333 my ( $access_token, $access_token_secret, $user_id, $screen_name )
334 = $nt->request_access_token( verifier => $pin );
335
336 # save the access tokens
337 $tokens{$account} = {
338 access_token => $access_token,
339 access_token_secret => $access_token_secret,
340 user_id => $user_id,
341 screen_name => $screen_name,
342 };
343
344 save_access_tokens();
345
346 return $tokens{$account};
347 }
348
349 sub save_access_tokens {
350 open my $fh;
351 foreach my $key ( sort keys %tokens ) {
352 my @keys
353 = $key eq 'consumer'
354 ? qw( consumer_key consumer_secret )
355 : qw( access_token access_token_secret user_id screen_name );
356 say join "\t", $key, @{ $tokens{$key} }{@keys};
357 }
358 close $fh;
359 }
360 }
361
362 sub get_twitter_account {
363 my ($account) = @_;
364
365 my $consumer_tokens = get_access_tokens('consumer');
366
367 my $nt = Net::Twitter->new(
368 traits => [qw/API::REST OAuth/],
369 %{$consumer_tokens}
370 );
371
372 my $tokens = get_access_tokens( $account, $nt );
373
374 $nt->access_token( $tokens->{access_token} );
375 $nt->access_token_secret( $tokens->{access_token_secret} );
376
377 #my $status = $nt->user_timeline( { count => 1 } );
378 #print Dumper $status;
379 #print Dumper $nt;
380
381 return $nt;
382 }
Something went wrong with that request. Please try again.