Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100755 361 lines (290 sloc) 9.524 kb
f1bbfe2 Andrew Fresh 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 Andrew Fresh Better messages for files with regress tests
authored
91 my $has_regress = 0;
92 my $has_non_regress = 0;
f1bbfe2 Andrew Fresh Add the script to git
authored
93 foreach my $key ( keys %{$commit} ) {
94 if ( $key =~ /^(\w+)\s+files$/ ) {
95 $changes{ lc $1 }++;
4e8fa04 Andrew Fresh 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 Andrew Fresh Add the script to git
authored
105 }
106 }
107 }
108
4e8fa04 Andrew Fresh 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 Andrew Fresh Add the script to git
authored
119 # Put them shortest first
120 @dirs = sort { length $a <=> length $b } @dirs;
121
122 my $match = shift @dirs;
4e8fa04 Andrew Fresh Better messages for files with regress tests
authored
123 $match //= '';
f1bbfe2 Andrew Fresh Add the script to git
authored
124 foreach my $dir (@dirs) {
125 chop $match while $dir !~ /^\Q$match/;
126 }
127
5902c80 Andrew Fresh Just match on files, easier that way
authored
128 $match =~ s{^[\.\/]+}{}; # No need for leading ./
129 $match =~ s{/+$}{}; # one less char most likely
f1bbfe2 Andrew Fresh Add the script to git
authored
130
4e8fa04 Andrew Fresh Better messages for files with regress tests
authored
131 my $message = $changed;
132 if ( !$match ) {
133 $message .= ' many things' if $has_non_regress;
134 $message .= ' including' if $has_regress and $has_non_regress;
135 $message .= ' regression tests' if $has_regress;
136 }
137 elsif ($has_regress) {
138 if ($has_non_regress) {
139 $message .= " $match and regression tests";
140 }
141 else {
142 $message .= " regress/$match";
143 }
144 }
145 else {
146 $message .= " $match";
147 }
f1bbfe2 Andrew Fresh Add the script to git
authored
148
4e8fa04 Andrew Fresh Better messages for files with regress tests
authored
149 return $message;
f1bbfe2 Andrew Fresh Add the script to git
authored
150 }
151
152 sub make_tweet {
153 my ($commit) = @_;
154 my %params = ( who => account_for( $commit->{'Module name'} ), );
155
156 my $by = $commit->{'Changes by'};
157 $by =~ s/\@.*$/\@/;
158
159 my $change = change_for($commit);
160
161 my $message = "$by $change: " . $commit->{'Log message'};
4d86cc5 Andrew Fresh collapse whitespace
authored
162 $message =~ s/\s+/ /gms;
f1bbfe2 Andrew Fresh Add the script to git
authored
163
164 return shorten($message), \%params;
165 }
166
167 sub shorten {
168 my ($message) = @_;
169 if ( length $message > 140 ) {
170 $message =~ s/^(.{137}).*/$1/ms;
171 $message =~ s/\s+$//ms;
172 $message .= '...';
173 }
174 return $message;
175 }
176
177 sub tweet {
178 my ( $message, $params ) = @_;
179
180 say "Tweeting $message";
181 eval { get_twitter_account( $params->{who} )->update($message) };
182 if ($@) {
183 warn $@;
184 return 0;
185 }
186 return 1;
187 }
188
189 sub parse_commit {
190 my ($file) = @_;
191 return {} unless -f $file;
192
193 my %commit;
194
195 my $in = 'HEADER';
196 open my $fh, '<', $file or die $!;
197 my $key = '';
198 my $dir = '';
199 while (<$fh>) {
200 chomp;
201
202 if ( $in eq 'HEADER' ) {
203 if (/^Message-ID:\s+(.+?)\s*$/i) { $commit{id} = $1 }
204 unless ($_) { $in = 'BODY' }
205 next;
206 }
207
208 if (/(CVSROOT|Module name|Changes by):\s+(.*)$/) {
209 $commit{$1} = $2;
210 next;
211 }
212 return unless $commit{CVSROOT}; # first thing should be CVSROOT
213
e453c04 Andrew Fresh Match Update commit messages
authored
214 if (/^(Update of)\s+(.*)\/([^\/]+)$/) {
215 $commit{'Updated files'}{$2} = [$3];
216 next;
217 }
218
27cb5f2 Andrew Fresh Split handling of Log Message out
authored
219 if (/^(\w+ files):/) {
f1bbfe2 Andrew Fresh Add the script to git
authored
220 $key = $1;
221 next;
222 }
223
224 if ($key) {
27cb5f2 Andrew Fresh Split handling of Log Message out
authored
225 chomp;
226 s/^\s+//;
227 unless ($_) { $key = ''; next; }
228
229 my (@files) = split /\s*:\s+/;
230 $dir = shift @files if @files > 1;
231 @files = map {split} @files;
232 next unless $dir;
233
234 push @{ $commit{$key}{$dir} }, @files;
235 }
236
237 if (/^Log [Mm]essage:/) {
238 $commit{'Log message'} .= $_ while <$fh>;
f1bbfe2 Andrew Fresh Add the script to git
authored
239 }
240 }
241 close $fh;
242
243 if ( my $changes = $commit{'Changes by'} ) {
244 my ( $who, $when ) = split /\s+/, $changes, 2;
245 $commit{'Changes by'} = $who;
246 $commit{'Changes on'} = $when;
247 }
248
249 $commit{'Log message'} =~ s/\s+$//ms;
250
251 return \%commit;
252 }
253
254 {
255 my $X;
256
257 sub load_seen {
258 $X = tie my %seen, 'DB_File', $seen_file or die;
259 return \%seen;
260 }
261
262 sub sync_seen {
263 $X->sync;
264 }
265
266 }
267
268 {
269 my %tokens;
270
271 sub get_access_tokens {
272 my ( $account, $nt ) = @_;
273
274 return $tokens{$account} if exists $tokens{$account};
275
276 open my $fh, '<', $auth_file or die $!;
277 while (<$fh>) {
278 chomp;
279 my ($account_from_file, $access_token, $access_token_secret,
280 $user_id, $screen_name
281 ) = split /\s+/;
282
283 if ( $account_from_file eq 'consumer' ) {
284 $tokens{$account_from_file} = {
285 consumer_key => $access_token,
286 consumer_secret => $access_token_secret,
287 };
288 }
289 else {
290 $tokens{$account_from_file} = {
291 access_token => $access_token,
292 access_token_secret => $access_token_secret,
293 user_id => $user_id,
294 screen_name => $screen_name,
295 };
296 }
297 }
298 close $fh;
299 return $tokens{$account} if exists $tokens{$account};
300
301 return unless $nt;
302
303 my $auth_url = $nt->get_authorization_url;
304 print
305 " Authorize $account for this application at:\n $auth_url\nThen, enter the PIN# provided to continue ";
306
307 my $pin = <STDIN>; # wait for input
308 chomp $pin;
309
310 # request_access_token stores the tokens in $nt AND returns them
311 my ( $access_token, $access_token_secret, $user_id, $screen_name )
312 = $nt->request_access_token( verifier => $pin );
313
314 # save the access tokens
315 $tokens{$account} = {
316 access_token => $access_token,
317 access_token_secret => $access_token_secret,
318 user_id => $user_id,
319 screen_name => $screen_name,
320 };
321
322 save_access_tokens();
323
324 return $tokens{$account};
325 }
326
327 sub save_access_tokens {
328 open my $fh;
329 foreach my $key ( sort keys %tokens ) {
330 my @keys
331 = $key eq 'consumer'
332 ? qw( consumer_key consumer_secret )
333 : qw( access_token access_token_secret user_id screen_name );
334 say join "\t", $key, @{ $tokens{$key} }{@keys};
335 }
336 close $fh;
337 }
338 }
339
340 sub get_twitter_account {
341 my ($account) = @_;
342
343 my $consumer_tokens = get_access_tokens('consumer');
344
345 my $nt = Net::Twitter->new(
346 traits => [qw/API::REST OAuth/],
347 %{$consumer_tokens}
348 );
349
350 my $tokens = get_access_tokens( $account, $nt );
351
352 $nt->access_token( $tokens->{access_token} );
353 $nt->access_token_secret( $tokens->{access_token_secret} );
354
355 #my $status = $nt->user_timeline( { count => 1 } );
356 #print Dumper $status;
357 #print Dumper $nt;
358
359 return $nt;
360 }
Something went wrong with that request. Please try again.