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