Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100755 410 lines (331 sloc) 10.997 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
79e8a6c @afresh1 Sort the email we find by mtime before sending
authored
49 {
50 my %files;
51 find( sub { return unless -f; $files{$File::Find::name} = -M _ }, @dirs );
52 check_message($_) for sort { $files{$b} <=> $files{$a} } keys %files;
53 sleep 10;
54 retweet();
55 }
f1bbfe2 @afresh1 Add the script to git
authored
56
57 my $watcher
58 = File::ChangeNotify->instantiate_watcher( directories => \@dirs, );
59 while ( my @events = $watcher->wait_for_events() ) {
60 foreach my $event (@events) {
61 next unless $event->type eq 'create';
62 check_message( $event->path );
63 }
8e85794 @afresh1 ReTweet other accounts on OpenBSD_cvs instead of real content
authored
64 sleep 10;
65 retweet();
f1bbfe2 @afresh1 Add the script to git
authored
66 }
67
68 sub check_message {
69 my ($file) = @_;
7bfb42b @afresh1 Convert get_seen() to just seen()
authored
70 my $seen = seen();
f1bbfe2 @afresh1 Add the script to git
authored
71
72 my $commit = parse_commit($file);
73 return unless $commit;
74 return unless $commit->{id};
75
76 return if $seen->{ $commit->{id} };
77
78 my ( $message, $params ) = make_tweet($commit);
a85c0ee @afresh1 Die if we can't send the tweet
authored
79 tweet( $message, $params ) or die "Unable to send tweet\n";
f1bbfe2 @afresh1 Add the script to git
authored
80
81 $seen->{ $commit->{id} } = time;
82 sync_seen();
83 }
84
85 sub account_for {
86 my ($module) = @_;
87 return $accounts{$module} || 'openbsd_cvs';
88 }
89
90 sub change_for {
91 my ($commit) = @_;
92 my %changes;
93 my @dirs;
94
4e8fa04 @afresh1 Better messages for files with regress tests
authored
95 my $has_regress = 0;
96 my $has_non_regress = 0;
f1bbfe2 @afresh1 Add the script to git
authored
97 foreach my $key ( keys %{$commit} ) {
98 if ( $key =~ /^(\w+)\s+files$/ ) {
99 $changes{ lc $1 }++;
4e8fa04 @afresh1 Better messages for files with regress tests
authored
100 foreach ( keys %{ $commit->{$key} } ) {
101 my $dir = $_;
102 my @files = @{ $commit->{$key}->{$dir} || [] };
103 @files = '' unless @files;
104
105 if ( $dir =~ s{^regress/}{} ) { $has_regress++ }
106 else { $has_non_regress++ }
107
108 push @dirs, map {"$dir/$_"} @files;
f1bbfe2 @afresh1 Add the script to git
authored
109 }
110 }
111 }
112
4e8fa04 @afresh1 Better messages for files with regress tests
authored
113 my @changes = keys %changes;
114 my $changed = @changes == 1 ? $changes[0] : 'changed';
115
116 unless (@dirs) {
117 if (@changes) {
118 return "$changed something";
119 }
120 return "did something the parser didn't understand";
121 }
122
f1bbfe2 @afresh1 Add the script to git
authored
123 # Put them shortest first
124 @dirs = sort { length $a <=> length $b } @dirs;
79a280d @afresh1 Friendlier wording when we don't know what was changed
authored
125 my $num_changed = @dirs;
f1bbfe2 @afresh1 Add the script to git
authored
126
127 my $match = shift @dirs;
4e8fa04 @afresh1 Better messages for files with regress tests
authored
128 $match //= '';
e869c04 @afresh1 Handle partial word chops better
authored
129
130 my $last = '/';
f1bbfe2 @afresh1 Add the script to git
authored
131 foreach my $dir (@dirs) {
e869c04 @afresh1 Handle partial word chops better
authored
132 $last = chop $match while $dir !~ /^\Q$match/;
f1bbfe2 @afresh1 Add the script to git
authored
133 }
e869c04 @afresh1 Handle partial word chops better
authored
134 $match .= '*' unless not $match or $last eq '/' or $match =~ s{/$}{};
f1bbfe2 @afresh1 Add the script to git
authored
135
5902c80 @afresh1 Just match on files, easier that way
authored
136 $match =~ s{^[\.\/]+}{}; # No need for leading ./
137 $match =~ s{/+$}{}; # one less char most likely
f1bbfe2 @afresh1 Add the script to git
authored
138
4e8fa04 @afresh1 Better messages for files with regress tests
authored
139 my $message = $changed;
140 if ( !$match ) {
79a280d @afresh1 Friendlier wording when we don't know what was changed
authored
141 if ($has_non_regress) {
142 if ( $num_changed > 5 ) { $message .= ' many things' }
143 elsif ( $num_changed > 2 ) { $message .= ' a few things' }
144 elsif ( $num_changed > 1 ) { $message .= ' a couple things' }
145 else { $message .= ' something' }
146 }
147 $message .= ' including' if $has_regress and $has_non_regress;
4e8fa04 @afresh1 Better messages for files with regress tests
authored
148 $message .= ' regression tests' if $has_regress;
149 }
150 elsif ($has_regress) {
151 if ($has_non_regress) {
152 $message .= " $match and regression tests";
153 }
154 else {
155 $message .= " regress/$match";
156 }
157 }
158 else {
159 $message .= " $match";
160 }
f1bbfe2 @afresh1 Add the script to git
authored
161
4e8fa04 @afresh1 Better messages for files with regress tests
authored
162 return $message;
f1bbfe2 @afresh1 Add the script to git
authored
163 }
164
165 sub make_tweet {
166 my ($commit) = @_;
167 my %params = ( who => account_for( $commit->{'Module name'} ), );
168
169 my $by = $commit->{'Changes by'};
170 $by =~ s/\@.*$/\@/;
171
172 my $change = change_for($commit);
173
174 my $message = "$by $change: " . $commit->{'Log message'};
4d86cc5 @afresh1 collapse whitespace
authored
175 $message =~ s/\s+/ /gms;
f1bbfe2 @afresh1 Add the script to git
authored
176
177 return shorten($message), \%params;
178 }
179
180 sub shorten {
181 my ($message) = @_;
182 if ( length $message > 140 ) {
183 $message =~ s/^(.{137}).*/$1/ms;
184 $message =~ s/\s+$//ms;
185 $message .= '...';
186 }
187 return $message;
188 }
189
190 sub tweet {
191 my ( $message, $params ) = @_;
192
193 say "Tweeting $message";
194 eval { get_twitter_account( $params->{who} )->update($message) };
195 if ($@) {
196 warn $@;
197 return 0;
198 }
199 return 1;
200 }
201
8e85794 @afresh1 ReTweet other accounts on OpenBSD_cvs instead of real content
authored
202 sub retweet {
203
204 my $opts = { count => 100, trim_user => 1 };
205 my $since_id = seen()->{openbsd_cvs_last_retweet} || 0;
206 $opts->{since_id} = $since_id if $since_id;
207
208 my $nt = get_twitter_account('openbsd_cvs');
209 my $tokens = get_access_tokens('openbsd_cvs');
210 my $tweets = $nt->home_timeline($opts);
211
212 foreach my $tweet ( reverse @{$tweets} ) {
213 next if $tweet->{user}->{id_str} == $tokens->{user_id};
214 next if $tweet->{retweeted};
215 $nt->retweet( $tweet->{id_str} );
216 seen()->{openbsd_cvs_last_retweet} = $tweet->{id_str};
217 }
218 sync_seen();
219 }
220
f1bbfe2 @afresh1 Add the script to git
authored
221 sub parse_commit {
222 my ($file) = @_;
223 return {} unless -f $file;
224
225 my %commit;
226
227 my $in = 'HEADER';
228 open my $fh, '<', $file or die $!;
229 my $key = '';
230 my $dir = '';
231 while (<$fh>) {
232 chomp;
233
234 if ( $in eq 'HEADER' ) {
235 if (/^Message-ID:\s+(.+?)\s*$/i) { $commit{id} = $1 }
236 unless ($_) { $in = 'BODY' }
237 next;
238 }
239
9dcc09e @afresh1 Anchor the match so we don't get quoted commits
authored
240 if (/^\s*(CVSROOT|Module name|Changes by|Release Tags):\s+(.*)$/) {
f1bbfe2 @afresh1 Add the script to git
authored
241 $commit{$1} = $2;
242 next;
243 }
244 return unless $commit{CVSROOT}; # first thing should be CVSROOT
245
c3c4fc2 @afresh1 Handle Imports
authored
246 if (/^\s*N\s+(.*)\/([^\/]+)/) {
247 push @{ $commit{'Imported files'}{$1} }, $2;
248 }
249
e453c04 @afresh1 Match Update commit messages
authored
250 if (/^(Update of)\s+(.*)\/([^\/]+)$/) {
251 $commit{'Updated files'}{$2} = [$3];
252 next;
253 }
254
27cb5f2 @afresh1 Split handling of Log Message out
authored
255 if (/^(\w+ files):/) {
f1bbfe2 @afresh1 Add the script to git
authored
256 $key = $1;
257 next;
258 }
259
260 if ($key) {
27cb5f2 @afresh1 Split handling of Log Message out
authored
261 chomp;
262 s/^\s+//;
263 unless ($_) { $key = ''; next; }
264
265 my (@files) = split /\s*:\s+/;
266 $dir = shift @files if @files > 1;
267 @files = map {split} @files;
268 next unless $dir;
269
270 push @{ $commit{$key}{$dir} }, @files;
c3c4fc2 @afresh1 Handle Imports
authored
271 next;
27cb5f2 @afresh1 Split handling of Log Message out
authored
272 }
273
274 if (/^Log [Mm]essage:/) {
c3c4fc2 @afresh1 Handle Imports
authored
275 while (<$fh>) {
276 if (/^\s*Vendor Tag:\s+(.*)$/) {
277 $commit{'Vendor Tag'} = $1;
278 $commit{'Log message'} =~ s/\s*Status:\s*$//ms;
279 last;
280 }
281 $commit{'Log message'} .= $_;
282 }
283 next;
f1bbfe2 @afresh1 Add the script to git
authored
284 }
285 }
286 close $fh;
287
288 if ( my $changes = $commit{'Changes by'} ) {
289 my ( $who, $when ) = split /\s+/, $changes, 2;
290 $commit{'Changes by'} = $who;
291 $commit{'Changes on'} = $when;
292 }
293
294 $commit{'Log message'} =~ s/\s+$//ms;
295
296 return \%commit;
297 }
298
299 {
300 my $X;
7bfb42b @afresh1 Convert get_seen() to just seen()
authored
301 my %seen;
302
303 sub seen {
304 return \%seen if %seen;
305
306 $X = tie %seen, 'DB_File', $seen_file or die;
f1bbfe2 @afresh1 Add the script to git
authored
307
308 return \%seen;
309 }
310
311 sub sync_seen {
312 $X->sync;
313 }
314
315 }
316
317 {
318 my %tokens;
319
320 sub get_access_tokens {
321 my ( $account, $nt ) = @_;
322
323 return $tokens{$account} if exists $tokens{$account};
324
325 open my $fh, '<', $auth_file or die $!;
326 while (<$fh>) {
327 chomp;
328 my ($account_from_file, $access_token, $access_token_secret,
329 $user_id, $screen_name
330 ) = split /\s+/;
331
332 if ( $account_from_file eq 'consumer' ) {
333 $tokens{$account_from_file} = {
334 consumer_key => $access_token,
335 consumer_secret => $access_token_secret,
336 };
337 }
338 else {
339 $tokens{$account_from_file} = {
340 access_token => $access_token,
341 access_token_secret => $access_token_secret,
342 user_id => $user_id,
343 screen_name => $screen_name,
344 };
345 }
346 }
347 close $fh;
348 return $tokens{$account} if exists $tokens{$account};
349
350 return unless $nt;
351
352 my $auth_url = $nt->get_authorization_url;
353 print
354 " Authorize $account for this application at:\n $auth_url\nThen, enter the PIN# provided to continue ";
355
356 my $pin = <STDIN>; # wait for input
357 chomp $pin;
358
359 # request_access_token stores the tokens in $nt AND returns them
360 my ( $access_token, $access_token_secret, $user_id, $screen_name )
361 = $nt->request_access_token( verifier => $pin );
362
363 # save the access tokens
364 $tokens{$account} = {
365 access_token => $access_token,
366 access_token_secret => $access_token_secret,
367 user_id => $user_id,
368 screen_name => $screen_name,
369 };
370
371 save_access_tokens();
372
373 return $tokens{$account};
374 }
375
376 sub save_access_tokens {
377 open my $fh;
378 foreach my $key ( sort keys %tokens ) {
379 my @keys
380 = $key eq 'consumer'
381 ? qw( consumer_key consumer_secret )
382 : qw( access_token access_token_secret user_id screen_name );
383 say join "\t", $key, @{ $tokens{$key} }{@keys};
384 }
385 close $fh;
386 }
387 }
388
389 sub get_twitter_account {
390 my ($account) = @_;
391
392 my $consumer_tokens = get_access_tokens('consumer');
393
394 my $nt = Net::Twitter->new(
395 traits => [qw/API::REST OAuth/],
396 %{$consumer_tokens}
397 );
398
399 my $tokens = get_access_tokens( $account, $nt );
400
401 $nt->access_token( $tokens->{access_token} );
402 $nt->access_token_secret( $tokens->{access_token_secret} );
403
404 #my $status = $nt->user_timeline( { count => 1 } );
405 #print Dumper $status;
406 #print Dumper $nt;
407
408 return $nt;
409 }
Something went wrong with that request. Please try again.