1 #!/usr/bin/perl
2 =head1 NAME
3
4 twitterpost.pl - script to post RT ticket details to a twitter account.
5
6 =head1 SYNOPSIS
7
8 twitterpost.pl < /path/to/message
9
10 =head1 DESCRIPTION
11
12 Takes an RT notification email, turns it into a string, and uploads it to a
13 twitter account. It uses the Subject and RT-Originator headers. It will strip
14 the domain from the RT-Originator, and strip the [rt.some.host] blurb from the
15 subject, giving a string of: <ticketno>|<originator local_part>|<subject>.
16
17 =head1 BUGS
18
19 There is currently no testing done that the string sent to twitter is within
20 the required length limits (~160 chars).
21
22 There is no help function.
23
24 =head1 AUTHOR INFORMATION
25
26 Copyright 2007, Michael Howe <michael@michaelhowe.org>.
27
28 =cut
29
30 use strict;
31 use warnings;
32 use Net::Twitter;
33 use POSIX qw(strftime);
34
35 # You can override these in the config file:
36 our $username;
37 our $password;
38 # Set debug to non-zero to log
39 our $debug = 0;
40 # Logging is good
41 our $logfile = "/home/michael/.twitterpost.log";
42
43 my $config = "/home/michael/.twitter-worcgtrt.pl";
44
45 unless (my $return = do $config) {
46 warn "couldn't parse $config: $@" if $@;
47 warn "couldn't do $config: $!" unless defined $return;
48 warn "couldn't run $config" unless $return;
49 }
50
51
52 open( LOG, ">>$logfile" ) or die "Ack! Can't open logfile: $!";
53
54 my ( $subject, $originator, $ticketnumber );
55 debug("Script started");
56
57 while (<>) {
58 # Blank lines separate the headers from the body.
59 last if ( m{^$} );
60 # Subject test:
61 if ( m{^[Ss]ubject: } ) {
62 ( $subject ) = m{^Subject: (.*)$};
63 debug( "Subject found: $subject" );
64 }
65 # Originator test:
66 if ( m{^RT-Originator: } ) {
67 ( $originator ) = m{^RT-Originator: (.*)$};
68 debug( "Originator found: $originator" );
69 }
70 }
71 # Sanity tests
72 unless ( $subject ) {
73 debug( "Subject not set" );
74 die "Subject not set";
75 }
76 unless ( $originator ) {
77 debug( "Originator not set" );
78 die "Originator not set";
79 }
80
81 # Trim things:
82 #
83 ( $ticketnumber ) = ( $subject =~ m{\[rt.worc.ox.ac.uk #(\d+)]} );
84 $subject =~ s{\[rt.worc.ox.ac.uk #\d+] }{};
85 $originator =~ s{@.*$}{};
86
87 # We don't care if this is an autoreply:
88 #
89 if ( $subject =~ m{^AutoReply: } ) {
90 debug( "This is an autoreply - exiting" );
91 exit;
92 }
93
94 # Update twitter:
95 #
96 my $updatestring = "$ticketnumber|$originator|$subject";
97
98 debug( "Update string: $updatestring" );
99
100 my $twit = Net::Twitter->new( username => $username, password => $password );
101 my $result = $twit->update( $updatestring );
102
103 debug( "Update result: " . $result->{id} );
104 debug("Script ended");
105
106 close( LOG );
107
108 sub debug {
109 my ( $string ) = @_;
110 if ( $debug ) {
111 my $timestamp = strftime "%a %b %e %H:%M:%S", localtime;
112 print LOG "$timestamp: $$: $string\n";
113 }
114 }
115
116 =head1 SAMPLE CONFIG
117
118 cat ~/.twitter-worcgtrt.pl
119
120 $username = 'MyTwitterUser';
121 $password = 'SekritTwitterPassword';
122 $logfile = "/home/michael/.twitterpost.log";
123 $debug = 1;
124
125 =cut
syntax highlighted by Code2HTML, v. 0.9.1