#!/usr/bin/perl -w
# -*- cperl; cperl-indent-level: 4 -*-
use strict;
use warnings;
use charnames qw(:full);
# $Id: trowel 372 2010-11-28 19:50:11Z roland $
# $Revision: 372 $
# $HeadURL: svn+ssh://ipenburg.xs4all.nl/srv/svnroot/benedict/trunk/trowel $
# $Date: 2010-11-28 20:50:11 +0100 (Sun, 28 Nov 2010) $
use utf8;
use 5.008000;
our $VERSION = '0.04';
use AnyEvent;
use Date::Format;
use Digest::MD5;
use Encode;
use English qw(-no_match_vars);
use File::Basename;
use File::HomeDir;
use File::Slurp;
use File::Spec;
use File::stat;
use Getopt::ArgvFile justload => 1;
use Getopt::Long;
use IO::File;
use IPC::Cmd;
use Imager;
use List::Util;
use LWP::Simple;
use Log::Log4perl qw(:easy get_logger);
use Mac::Growl;
use Mac::OSA::Simple;
use Net::Twitter;
use Pod::Usage;
use Proc::Daemon;
use Regexp::Common qw(URI);
use Set::Scalar;
use URI::Escape;
use Readonly ();
Readonly::Scalar my $EMPTY => q{};
Readonly::Scalar my $NEWLINE => qq{\n};
Readonly::Scalar my $COMMA => qq{\N{COMMA}};
Readonly::Scalar my $UNDERSCORE => qq{\N{LOW LINE}};
Readonly::Scalar my $ESCAPE => qq{\N{PERCENT SIGN}};
Readonly::Scalar my $UNSAFE => join $EMPTY,
(
qq{\n}, qq{\N{LESS-THAN SIGN}},
qq{\N{GREATER-THAN SIGN}}, qq{\N{APOSTROPHE}},
qq{\N{QUOTATION MARK}}, qq{\N{VERTICAL LINE}},
qq{\N{AMPERSAND}}, qq{\N{SPACE}},
);
Readonly::Scalar my $CONTINUATION => qq{\N{NOT SIGN}};
Readonly::Scalar my $LONG_OPT => q{--};
Readonly::Scalar my $SET => q{set};
Readonly::Scalar my $CUR => -2;
Readonly::Scalar my $APPLICATION => q{Growl+Twitter=trowel};
Readonly::Scalar my $NOTIFICATION_NAME => q{New Tweet};
Readonly::Scalar my $GROWLNOTIFY_CMD => q{/usr/local/bin/growlnotify};
Readonly::Scalar my $DEFAULT_FORMAT => q{%u: %t};
Readonly::Scalar my $MAX_TWEETS => 200; # Twitter API restriction
Readonly::Scalar my $MAX_TWEETS_INIT => 5;
Readonly::Scalar my $DISPLAY_INTERVAL => 4;
Readonly::Scalar my $PURGE_INTERVAL => 3600;
Readonly::Scalar my $POLL_INTERVAL => 37;
Readonly::Scalar my $AVATAR_WIDTH => 32;
Readonly::Scalar my $AVATAR_HEIGHT => $AVATAR_WIDTH;
Readonly::Scalar my $AVATAR_ALPHA => .8;
Readonly::Scalar my $DEFAULT_BROWSER => q{Default};
Readonly::Scalar my $TARGET_RATIO => 1;
Readonly::Scalar my $STICKY_OPTION => q{sticky};
Readonly::Scalar my $FILE_OPTION => q{config};
Readonly::Scalar my $RC_FILE => q{.trowelrc};
Readonly::Scalar my $TOKEN_FILE => q{token};
Readonly::Scalar my $RECV_TID_FILE => q{last_tweet_received.id};
Readonly::Scalar my $DISP_TID_FILE => q{last_tweet_displayed.id};
Readonly::Scalar my $FOLLOWERS_FILE => q{followers.id};
Readonly::Scalar my $CACHE_DIR =>
File::Spec->catdir( File::HomeDir->my_home(), qw{Library Caches Trowel} );
Readonly::Scalar my $STALE_CACHE => 60 * 60 * 24 * 7 * 2; # two weeks
Readonly::Scalar my $AVATAR_TYPE => q{png};
Readonly::Scalar my $CACHE_FORMAT => qq{%s_%03u_%03u_%0.3f.$AVATAR_TYPE};
Readonly::Scalar my $PROTOCOL => q{://};
Readonly::Scalar my $GUESSED_LINK => q{www\.};
Readonly::Scalar my $DEFAULT_SCHEME => q{http};
Readonly::Scalar my $VALID_SCHEMES => $DEFAULT_SCHEME . q{s?}; # http(s)
Readonly::Scalar my $LINK_MATCH =>
qr{((?:$VALID_SCHEMES$PROTOCOL|$GUESSED_LINK)[[:^space:]]+)}ismx;
Readonly::Scalar my $ENCODING => q{utf8};
Readonly::Scalar my $ERR_MODE_SLURP => q{quiet};
Readonly::Scalar my $GAINED_FOLLOWER => q{Gained "%s"};
Readonly::Scalar my $LOST_FOLLOWER => q{Lost "%s"};
Readonly::Scalar my $MUTATION_STICKY => 1;
Readonly::Scalar my $MUTATION_PRIORITY => 1;
Readonly::Scalar my $LOG_CONF => q{trowel_log.conf};
Readonly::Hash my %LOG => (
GROWL_NOT_FOUND => q{The growlnotify command was not found at '%s'},
MKDIR_FAILED => q{Couldn't create directory "%s"},
OPENDIR_FAILED => q{Couldn't open directory "%s"},
GOT_PASSWORD => q{Got password "%s"},
LAST_TWEET_RECEIVED => q{The id of the last received tweet was %s},
LAST_TWEET_DISPLAYED => q{The id of the last displayed tweet was %s},
ROLL_BACK => q{Not all received tweets could be displayed, rolling back},
GETTING_TIMELINE =>
q{Getting timeline for user "%s" since tweet with id %s},
PROCESSING_TWEET => q{Processing tweet with id %s},
SKIPPABLE_TWEET => q{Skipping tweet with id %s},
UPDATING_CONFIG => q{Reloading configuration every %s seconds},
CONFIG_CHANGED => q{Configuration of "%s" changed from "%s" to "%s"},
USING_MAP => q{Using "%s" as map for format},
UNSAFE_BROWSER => q{The browser name "%s" contains special characters},
OPENING_URL => q{Opening URL "%s" as "%s" in %s browser},
CACHING_AVATAR => q{Caching avatar in file "%s"},
CACHE_MISS => q{Cache miss for user "%s" <%s>},
CACHE_HIT => q{Cache hit for user "%s" <%s>},
CACHE_PURGE => q{Purged "%s" from cache},
FOLLOWERS => q{The current set of followers is %s},
FOLLOWERS_GAINED => q{The set of gained followers is %s},
FOLLOWERS_LOST => q{The set of lost followers is %s},
IGNORED_GAINING => q{Ignoring gaining all followers at once},
IGNORED_LOSING => q{Ignoring losing all followers at once},
TWEETS_UNDEF => q{Status poll returned undef. Is the password correct?},
RATE_LIMIT => q{The remaining rate is %s},
INTERVAL_PAIR => q{Target interval is %s, currently using %s},
RELOAD_POLLERS => q{Creating new pollers with interval %s},
FOUND_VALID_URLS => q{Found %s valid URLs in the tweet},
);
## no critic qw(RequireASCII)
Readonly::Scalar my $OSA_PASSWORD_FORMAT => <<'SCRIPT';
property entered_password: ""
set no_password to ""
set default_hint to "Please enter the pin for the twitter application"
set hint to default_hint
repeat while entered_password is no_password
tell application "System Events"
display dialog hint default answer no_password buttons ¬
{"Cancel", "OK"} default button 2 with icon 0 with hidden answer
end tell
set entered_password to the text returned of the result as string
if entered_password is no_password then
beep
set hint to "No password entered" & return & default_hint
end if
end repeat
entered_password
SCRIPT
## use critic
Readonly::Array my @CSV_OPTS =>
qw(exclude include sticky follow nofollow skip naggers);
Readonly::Array my @NET_TWITTER_TRAITS =>
qw(OAuth API::REST InflateObjects RateLimit Legacy);
Readonly::Array my @DEBUG_LEVELS => ( $FATAL, $INFO, $WARN, $DEBUG );
Readonly::Array my @GETOPT_CONFIG =>
qw(no_ignore_case bundling auto_version auto_help);
Readonly::Array my @GETOPT_ARGV_CONFIG => (
fileOption => $FILE_OPTION,
startupFilename => $RC_FILE,
default => 1,
home => 1,
current => 1,
);
Readonly::Array my @GETOPTIONS => (
q{consumerkey|k=s}, q{consumersecret|s=s},
q{interval|i=i}, q{poll|l=i},
q{exclude|x=s@}, q{sticky|t=s@},
q{include|I=s@}, q{output|o},
q{initials|n=i}, q{format|f=s},
qq{$FILE_OPTION|g=s}, q{retrieve|r=i},
q{help|h}, q{verbose|v+},
q{exclude_self|X}, q{width=i},
q{height=i}, q{follow=s@},
q{nofollow=s@}, q{browser=s},
q{alpha|a=f}, q{skip=s@},
q{naggers=s@}, q{daemonize|d},
);
Readonly::Hash my %OSA => (
default => q[do shell script "open" & quoted form of "%s"],
firefox => <<'OSA',
tell application "Firefox"
activate
Get URL "%s"
end tell
OSA
opera => <<'OSA',
tell application "Opera"
activate
OpenURL "%s"
end tell
OSA
safari => <<'OSA',
tell application "Safari"
open location "%s"
end tell
OSA
);
Readonly::Hash my %OPTS_DEFAULT => (
format => $DEFAULT_FORMAT,
poll => $POLL_INTERVAL,
interval => $DISPLAY_INTERVAL,
initials => $MAX_TWEETS_INIT,
retrieve => $MAX_TWEETS,
browser => $DEFAULT_BROWSER,
width => $AVATAR_WIDTH,
height => $AVATAR_HEIGHT,
alpha => $AVATAR_ALPHA,
);
Getopt::Long::Configure(@GETOPT_CONFIG);
my @option_files;
Getopt::ArgvFile::argvFile( @GETOPT_ARGV_CONFIG, array => \@option_files );
my %opts_file = %OPTS_DEFAULT;
# Store the options as defined by only the option files so we can track
# changes in the option files after the script is launched:
Getopt::Long::GetOptionsFromArray( \@option_files, \%opts_file, @GETOPTIONS );
my %opts = %OPTS_DEFAULT;
Getopt::ArgvFile::argvFile(@GETOPT_ARGV_CONFIG);
Getopt::Long::GetOptions( \%opts, @GETOPTIONS ) or Pod::Usage::pod2usage(2);
add_sets_to_opts();
if ( -r $LOG_CONF ) {
Log::Log4perl::init_and_watch($LOG_CONF);
}
else {
Log::Log4perl::easy_init($ERROR);
}
my $log = Log::Log4perl->get_logger( File::Basename::basename $PROGRAM_NAME );
$log->level( $DEBUG_LEVELS[ $opts{verbose} || 0 ] );
$opts{daemonize} && Proc::Daemon::Init;
my $growl = growler();
( -d $CACHE_DIR )
|| ( mkdir $CACHE_DIR
or $log->logcroak( sprintf $LOG{MKDIR_FAILED}, $CACHE_DIR ) );
my $cv = AnyEvent->condvar;
my @timeline;
my @gained;
my @lost;
my @rates = ( 0, undef );
my %followers;
my $browsed_urls = Set::Scalar->new();
my $last_tweet_received = 0;
my $last_tweet_displayed = 0;
my $screen_name;
my $twitter_poller = create_twitter_poller();
my $notifier = create_notifier();
my $config_poller = create_config_poller();
my $cache_purger = create_cache_purger();
$cv->recv;
undef $config_poller;
undef $twitter_poller;
undef $notifier;
undef $cache_purger;
# Connect to twitter and update the timeline array with fresh tweets:
sub create_twitter_poller {
return AnyEvent->timer(
after => $rates[0],
interval => $rates[0] || $opts{poll},
cb => sub {
my $twitter = Net::Twitter->new(
decode_html_entities => 1,
traits => \@NET_TWITTER_TRAITS,
consumer_key => $opts{consumerkey},
consumer_secret => $opts{consumersecret},
);
authorize($twitter);
$last_tweet_received || restore_state();
$log->debug( sprintf $LOG{GETTING_TIMELINE},
$screen_name, $last_tweet_received );
my $ratio = $twitter->rate_limit ? $twitter->rate_ratio : 0;
$log->log( $ratio < 1 ? $WARN : $INFO,
sprintf $LOG{RATE_LIMIT}, $ratio );
unshift @rates,
List::Util::max( $ratio ? $twitter->until_rate($TARGET_RATIO) : 0,
$opts{poll} );
$log->debug( sprintf $LOG{INTERVAL_PAIR}, $rates[0], $rates[$CUR] );
my $fresh_tweets;
my $ret = eval {
$fresh_tweets = $twitter->home_timeline(
$last_tweet_received
? {
count => $MAX_TWEETS,
since_id => $last_tweet_received
}
: { count => $opts{initials} }
);
1;
};
if ($EVAL_ERROR) {
$log->warn(qq{$EVAL_ERROR});
}
if ( !defined $fresh_tweets ) {
$log->warn( $LOG{TWEETS_UNDEF} );
}
my $follower_ids;
$ret = eval {
$follower_ids = $twitter->followers_ids($screen_name);
1;
};
if ($EVAL_ERROR) {
$log->warn(qq{$EVAL_ERROR});
}
if ( defined $follower_ids ) {
$followers{fresh} = Set::Scalar->new( @{$follower_ids} );
# Ignore mutations from stale twitter server:
$followers{fresh} =
$followers{fresh}->difference( $opts{$SET}{naggers} );
$log->debug( sprintf $LOG{FOLLOWERS}, $followers{fresh} );
my $mutations = Set::Scalar->new();
$mutations = $followers{fresh}->difference( $followers{stale} );
$log->debug( sprintf $LOG{FOLLOWERS_GAINED}, qq{$mutations} );
# Avoid gaining all followers at once:
if ( $mutations->size == $followers{fresh}->size ) {
$log->warn( $LOG{IGNORED_GAINING} );
}
else {
push @gained,
map { $twitter->show_user($_) } $mutations->members;
}
$mutations = $followers{stale}->difference( $followers{fresh} );
$log->debug( sprintf $LOG{FOLLOWERS_LOST}, qq{$mutations} );
# Avoid losing all followers at once:
if ( $mutations->size
&& ( $mutations->size == $followers{stale}->size ) )
{
$log->warn( $LOG{IGNORED_LOSING} );
}
else {
push @lost,
map { $twitter->show_user($_) } $mutations->members;
}
if ( !$followers{stale}->is_equal( $followers{fresh} ) ) {
$followers{stale} = $followers{fresh};
store_followers( $followers{stale}->members );
}
}
my @timeline_update = reverse @{ $fresh_tweets || [] };
( 0 + @timeline_update ) || return;
$last_tweet_received = $timeline_update[-1]{id};
push @timeline, @timeline_update;
store_tid( $RECV_TID_FILE, $last_tweet_received );
},
);
}
# Take tweets from the timeline array and display them:
sub create_notifier {
return AnyEvent->timer(
interval => $opts{interval},
cb => sub {
if ( my $gained = shift @gained ) {
$growl->(
sprintf( $GAINED_FOLLOWER,
Encode::encode( $ENCODING, $gained->screen_name ) ),
Encode::encode(
$ENCODING, $gained->description || $gained->name
),
$MUTATION_STICKY,
$MUTATION_PRIORITY,
get_avatar($gained),
);
return;
}
if ( my $lost = shift @lost ) {
$growl->(
sprintf( $LOST_FOLLOWER,
Encode::encode( $ENCODING, $lost->screen_name ) ),
Encode::encode(
$ENCODING, $lost->description || $lost->name
),
$MUTATION_STICKY,
$MUTATION_PRIORITY,
get_avatar($lost),
);
return;
}
my $tweet = ( shift @timeline ) || return;
$log->debug( sprintf $LOG{PROCESSING_TWEET}, $tweet->id );
( skippable($tweet) ) && return;
my %tweet_data = get_data($tweet);
my $urls = browsable($tweet);
if ( $opts{output} ) {
print $tweet_data{body}, $NEWLINE;
}
else {
$growl->(
$tweet_data{n}, $tweet_data{body}, stick( $tweet, $urls ),
0, get_avatar( $tweet->user )
);
}
while ( defined( my $url = $urls->each ) ) {
browse($url);
}
$last_tweet_displayed = $tweet->id;
store_tid( $DISP_TID_FILE, $last_tweet_displayed );
},
);
}
# Periodically re-read the configuration files:
sub create_config_poller {
return AnyEvent->timer(
after => $rates[$CUR] / 2,
interval => $rates[$CUR] || $opts{poll},
cb => sub {
my $reload_pollers;
$log->debug( sprintf $LOG{UPDATING_CONFIG},
$rates[$CUR] || $opts{poll} );
my @fresh;
if ( defined $opts{$FILE_OPTION} ) {
@fresh = ( qq{$LONG_OPT$FILE_OPTION}, $opts{$FILE_OPTION} );
}
my %opts_fresh = %OPTS_DEFAULT;
Getopt::ArgvFile::argvFile( @GETOPT_ARGV_CONFIG, array => \@fresh );
Getopt::Long::GetOptionsFromArray( \@fresh, \%opts_fresh,
@GETOPTIONS );
while ( my ( $key => $value ) = each %opts ) {
my $fresh = as_str( $opts_fresh{$key} );
my $file = as_str( $opts_file{$key} );
if ( $fresh ne $file ) {
$log->info(
sprintf $LOG{CONFIG_CHANGED}, $key,
as_str( $opts{$key} ), $fresh
);
$opts{$key} = $opts_fresh{$key};
if ( $key eq q{poll} ) {
$reload_pollers = 1;
}
( $key eq q{interval} )
&& ( $notifier = create_notifier() );
}
}
add_sets_to_opts();
%opts_file = %opts_fresh;
$log->level( $DEBUG_LEVELS[ $opts{verbose} || 0 ] );
if ( $rates[0] != $rates[$CUR] ) {
$#rates = 1;
$reload_pollers = 1;
}
if ($reload_pollers) {
$log->debug( sprintf $LOG{RELOAD_POLLERS}, $rates[0] );
$twitter_poller = create_twitter_poller();
$config_poller = create_config_poller();
}
},
);
}
sub create_cache_purger {
return AnyEvent->timer(
after => 0,
interval => $PURGE_INTERVAL,
cb => sub {
opendir( my $dir, $CACHE_DIR )
|| $log->logcroak( sprintf $LOG{OPENDIR_FAILED}, $CACHE_DIR );
my @files = grep { /\.$AVATAR_TYPE$/smx } readdir $dir;
while ( my $file = shift @files ) {
$file = File::Spec->catfile( ($CACHE_DIR), $file );
my $stat = stat $file;
if ( time - $stat->atime > $STALE_CACHE ) {
$log->info( sprintf $LOG{CACHE_PURGE}, $file );
unlink $file;
}
}
closedir $dir;
},
);
}
sub authorize {
my $twitter = shift;
my ( $access_token, $access_token_secret );
( $access_token, $access_token_secret, $screen_name ) = get_token();
if ( $access_token && $access_token_secret ) {
$twitter->access_token($access_token);
$twitter->access_token_secret($access_token_secret);
}
if ( !$twitter->authorized ) {
browse( $twitter->get_authorization_url );
( $access_token, $access_token_secret, undef, $screen_name ) =
$twitter->request_access_token( verifier => ask_for_password() );
store_token( $access_token, $access_token_secret, $screen_name );
}
return $twitter->authorized;
}
sub restore_state {
$last_tweet_received =
List::Util::max( $last_tweet_received, get_tid($RECV_TID_FILE) || 0 );
$log->debug( sprintf $LOG{LAST_TWEET_RECEIVED}, $last_tweet_received );
$last_tweet_displayed =
List::Util::max( $last_tweet_displayed, get_tid($DISP_TID_FILE) || 0 );
$log->debug( sprintf $LOG{LAST_TWEET_DISPLAYED}, $last_tweet_displayed );
if ( $last_tweet_displayed < $last_tweet_received ) {
$log->warn( $LOG{ROLL_BACK} );
$last_tweet_received = $last_tweet_displayed;
}
%followers = ( stale => Set::Scalar->new( get_followers() ) );
return;
}
sub get_data {
my $tweet = shift;
my %tweet_data = (
n => $tweet->user->name,
u => $tweet->user->screen_name,
t => $tweet->text,
d => $tweet->created_at,
l => $tweet->user->location,
);
while ( my ( $key => $value ) = each %tweet_data ) {
( defined $value )
&& ( $tweet_data{$key} = Encode::encode( $ENCODING, $value ) );
}
$tweet_data{$ESCAPE} = $ESCAPE;
my $map =
qq{(?trace( sprintf $LOG{USING_MAP}, $map );
my $re = qr{$map}ismx;
$tweet_data{body} = $opts{format};
## no critic qw(ProhibitUselessRegexModifiers RequireLineBoundaryMatching)
$tweet_data{body} =~ s{ $re }{$tweet_data{$1}}gxs;
## use critic
return %tweet_data;
}
sub skippable {
my $tweet = shift;
my $skippable =
( $opts{$SET}{exclude}->has( $tweet->user->screen_name )
|| !$opts{$SET}{include}->is_null )
&& !$opts{$SET}{include}->has( $tweet->user->screen_name )
&& !$opts{$SET}{sticky}->has( $tweet->user->screen_name );
$skippable && $log->debug( sprintf $LOG{SKIPPABLE_TWEET}, $tweet->id );
return $skippable;
}
sub browsable {
my $tweet = shift;
# Look for unbrowsed URLs, also strings starting with www.:
my $urls = Set::Scalar->new(
grep {
m{^$RE{URI}{HTTP}{-keep}{ -scheme => $VALID_SCHEMES }$}smx
&& !$opts{$SET}{skip}->has($3)
}
map { m{^$GUESSED_LINK}smx ? qq{$DEFAULT_SCHEME$PROTOCOL$_} : $_ }
$tweet->text =~ m{$LINK_MATCH}gsxm
);
(
grep {
m{^$RE{URI}{HTTP}{-keep}{ -scheme => $VALID_SCHEMES }$}smx
&& $opts{$SET}{skip}->has($3)
}
map { m{^$GUESSED_LINK}smx ? qq{$DEFAULT_SCHEME$PROTOCOL$_} : $_ }
$tweet->source =~ m{$LINK_MATCH["]}gsxm
) && $urls->clear;
$log->debug( sprintf $LOG{FOUND_VALID_URLS}, $urls->size );
$urls = $urls->difference($browsed_urls);
(
exists $OSA{ lc $opts{browser} }
&& $urls->size
&& ( ( !$opts{$SET}{nofollow}->has( $tweet->user->screen_name ) )
|| ( $opts{$SET}{follow}->has( $tweet->user->screen_name ) ) )
)
|| $urls->clear;
my $good_urls = Set::Scalar->new();
while ( defined( my $url = $urls->each ) ) {
if ( LWP::Simple::head($url) ) {
$good_urls->insert($url);
}
}
return $good_urls;
}
sub growler {
my @names = ($NOTIFICATION_NAME);
my $growler;
if ( $opts{daemonize} ) {
IPC::Cmd::can_run($GROWLNOTIFY_CMD)
|| $log->logcroak( sprintf $LOG{GROWL_NOT_FOUND}, $GROWLNOTIFY_CMD );
$growler = sub {
my ( $label, $message, $stick, $priority, $avatar ) = @_;
IPC::Cmd::run(
command => [
$GROWLNOTIFY_CMD,
q{--name},
$APPLICATION,
q{--identifier},
$names[0],
q{--message},
$message =~ /[[:space:]]/gsmx
? $message
: quotemeta $message,
$stick ? qq{$LONG_OPT$STICKY_OPTION} : $EMPTY,
q{--priority},
$priority,
q{--image},
$avatar,
q{--title},
$label,
]
);
}
}
else {
Mac::Growl::RegisterNotifications( $APPLICATION, \@names,
[ $names[0] ] );
$growler = sub {
my ( $label, $message, $stick, $priority, $avatar ) = @_;
Mac::Growl::PostNotification( $APPLICATION, $names[0], $label,
$message, $stick, $priority, $avatar );
}
}
return $growler;
}
sub ask_for_password {
my ( $password, $osa_password_format );
# Fold AppleScript continuation characters:
( $osa_password_format = $OSA_PASSWORD_FORMAT ) =~
s{$CONTINUATION\n}{\ }gismx;
# Strip quotes from the returned value:
( $password = Mac::OSA::Simple::applescript($osa_password_format) ) =~
s{(^\N{QUOTATION MARK}|\N{QUOTATION MARK}$)}{}gsmx;
$log->debug( sprintf $LOG{GOT_PASSWORD}, $password );
return $password;
}
# Gather comma seperated items or items from multiple opts into a set:
sub add_sets_to_opts {
foreach my $set (@CSV_OPTS) {
( $opts{$set} ) || ( $opts{$set} = [] );
$opts{$SET}{$set} =
Set::Scalar->new( split /$COMMA/sxm, join $COMMA, @{ $opts{$set} } );
}
$opts{exclude_self}
&& $opts{$SET}{exclude}->insert($screen_name);
return;
}
sub browse {
my $raw_url = shift;
my $url = URI::Escape::uri_escape_utf8( $raw_url, $UNSAFE );
my $browser = $opts{browser};
$browser =~ s{[$UNSAFE]}{}gsmx;
if ( $browser ne $opts{browser} ) {
$log->warn( sprintf $LOG{UNSAFE_BROWSER}, $opts{browser} );
}
$log->debug( sprintf $LOG{OPENING_URL}, $raw_url, $url, $browser );
if ( $opts{daemonize} ) {
my $command = [ 'open', $url ];
if ( $browser ne $DEFAULT_BROWSER ) {
$command = [ 'open', '-a', $browser, $url ];
}
IPC::Cmd::run( command => $command );
}
else {
Mac::OSA::Simple::applescript( sprintf $OSA{ quotemeta lc $browser },
$url );
}
return $browsed_urls->insert($raw_url);
}
sub stick {
my ( $tweet, $urls ) = @_;
return ( $opts{$SET}{sticky}->has( $tweet->user->screen_name ) || $urls )
? 1
: 0;
}
sub get_avatar {
my $user = shift;
my $avatar_url = $user->profile_image_url->as_string;
my $avatar_file = File::Spec->catfile(
($CACHE_DIR),
sprintf $CACHE_FORMAT,
Digest::MD5::md5_hex($avatar_url),
$opts{width}, $opts{height}, $opts{alpha}
);
my $fh = IO::File->new();
if ( !$fh->open(qq{< $avatar_file}) ) {
$log->debug( sprintf $LOG{CACHE_MISS},
$user->screen_name, $avatar_file );
LWP::Simple::mirror( $avatar_url, $avatar_file );
my $img = Imager->new( file => $avatar_file );
my $thumb = $img->scale(
xpixels => $opts{width},
ypixels => $opts{height}
);
$thumb = $thumb->convert(
matrix => $thumb->getchannels() == 1
? [ [ 1, 0 ], [ 0, $opts{alpha} ], ]
: [
[ 1, 0, 0, 0 ],
[ 0, 1, 0, 0 ],
[ 0, 0, 1, 0 ],
[ 0, 0, 0, $opts{alpha} ]
]
);
$thumb->write( file => $avatar_file, type => $AVATAR_TYPE );
}
else {
$log->debug( sprintf $LOG{CACHE_HIT}, $user->screen_name,
$avatar_file );
}
$fh->close();
return $avatar_file;
}
sub get_followers {
my $csv_followers = File::Slurp::read_file(
File::Spec->catfile(
$CACHE_DIR, $screen_name . $UNDERSCORE . $FOLLOWERS_FILE
),
err_mode => $ERR_MODE_SLURP
) || $EMPTY;
$csv_followers =~ s{[[:space:]]}{}gismx;
return split m{$COMMA}sxm, $csv_followers;
}
sub store_followers {
my @ids = @_;
return File::Slurp::write_file(
File::Spec->catfile(
$CACHE_DIR, $screen_name . $UNDERSCORE . $FOLLOWERS_FILE
),
join $COMMA,
@ids
);
}
sub get_tid {
my $filename = $screen_name . $UNDERSCORE . shift;
return File::Slurp::read_file( File::Spec->catfile( $CACHE_DIR, $filename ),
err_mode => $ERR_MODE_SLURP );
}
sub store_tid {
my $filename = $screen_name . $UNDERSCORE . shift;
my $tid = shift;
return File::Slurp::write_file(
File::Spec->catfile( $CACHE_DIR, $filename ), $tid );
}
sub get_token {
-r File::Spec->catfile( $CACHE_DIR, $TOKEN_FILE ) || return ();
return split /[[:space:]]+/sxm,
File::Slurp::read_file( File::Spec->catfile( $CACHE_DIR, $TOKEN_FILE ),
err_mode => $ERR_MODE_SLURP );
}
sub store_token {
my @args = @_;
return File::Slurp::write_file(
File::Spec->catfile( $CACHE_DIR, $TOKEN_FILE ),
join qq{\N{SPACE}}, @args );
}
# Make strings or array references comparable:
sub as_str {
my $ar_or = shift;
return (
ref $ar_or eq q{ARRAY}
? join $COMMA, @{$ar_or}
: ( $ar_or || $EMPTY )
);
}
exit;
__END__
=encoding utf8
=for stopwords microblogging Ipenburg Stelling timeline tweep twitter's Twitter's TODO
AnyEvent Imager Readonly API OAuth AppleScripts
=head1 NAME
trowel - display Twitter messages with Growl.
=head1 VERSION
This is version 0.04. It's based on the original trowel script
L
by Richard Stelling L.
=head1 SYNOPSIS
trowel [opts]
=head1 DESCRIPTION
Shows the tweets entering a users Twitter timeline as Growl notifications,
including the avatar of the tweep. The format is the message in the
notification is configurable and the avatars are scaled to fit in the standard
Smoke Theme and cached locally.
=head1 DEPENDENCIES
L
L
L
L
L
L
L
L
L
L
L
L
L
L
L
L
L
L
L
L
L
L
Issue the following command in a Terminal to install these modules:
C
=head1 INCOMPATIBILITIES
=over 4
=item * File::HomeDir fails tests when it is being installed as root because
the user root doesn't have some special Folders only normal users have. It can
be installed as root by forcing the install with the C<-fi> option.
=back
=head1 DIAGNOSTICS
This module uses Log::Log4perl for logging.
=head1 BUGS AND LIMITATIONS
=over 4
=item * This script aims to be compatible with the original version or trowel,
but it it not bug-compatible. Since the twitter API has deprecated Basic
Authentication in favor of OAuth compatibility using the older user name and
password options is no longer available.
=item * The format processing is improved so C<%%> can be used to display a
single C<%> and substitutes containing formats aren't clobbered.
=item * The location is not the location of the tweet, but of the account
=item * The reload of the configuration is timer based and not triggered by
events in the file system the configuration files reside in.
=item * Mac::Growl can't be used in a forked script so when used as a daemon
it falls back to using C, which doesn't seem to stack the message
boxes.
=back
=head1 CONFIGURATION
To use this script you'll need an account at the Twitter microblogging
service, and a personal twitter application providing a C and
C to allow you to connect to your own account through the API.
The avatars used are scaled to 32x32 to fit as graphic in the default Smoke
theme of Growl. The scaled avatars and the file containing the id of the most
recent tweet displayed are stored in the cache folder in
L<~/Library/Caches/Trowel>.
The configuration files are handled by L.
Changes in the files are updated in the running script so it would for example
be possible to update the behavior without restarting the script.
A configuration file named C<.trowelrc> can be placed in $HOME or the current
working directory, or in any of the possibilities described by
L.
=head1 USAGE
trowel
=head1 REQUIRED ARGUMENTS
The minimum requirements for the script to be useful is the C and
C of a twitter application, which can also be defined in the
configuration file. You should create these tokens in your twitter account
because it makes no sense to distribute this application with those tokens
included. Using those tokens you can run this script identifying it to twitter
as your very own application and allow it to access your account. The first
time you run this script it will open a browser with twitter's page asking you
for allowing your application to access your data, and then you can copy a PIN
into the application to have the application get to it.
=back
=head1 OPTIONS
=over 4
=item C<-k> C<--consumerkey> C of your twitter application
=item C<-s> C<--consumersecret> C of your twitter application
=item C<-i> interval between displaying tweets
=item C<-l> time between polls of Twitter feed. To avoid hitting Twitter's
Rate Limit of 150 requests per hour keep this well above 24
=item C<-x> list of users to exclude
=item C<-X> C<--exclude-self> exclude yourself
=item C<-t> list of users who's tweets are sticky, -x and -i will override
this
=item C<-l> list of users to include
=item C<--follow> list of users who's links in tweets to open in a browser.
The tweets that open a link are displayed as sticky.
=item C<--nofollow> list of users who's links in tweets not to open in a
browser
=item C<--skip> list of applications who's links in tweets not to open in a
browser, for example 4sq.com
=item C<--browser> C<-b> [Safari|Firefox|Opera|Default|none] the name of the
browser application to open the links in. Setting it not to one of the
browsers that is supported suppresses the following of links altogether.
=item C<-o> output to C only, by-passing Growl, use this for piping to
another application
=item C<-n> initial number of Tweets to request, default is 5
=item C<-f""> format of the Tweet
%u - user
%t - tweet
%d - date time
%l - location
%% - single %
=item C<--width> B<-w> Width of the avatar in pixels (32 for Smoke theme)
=item C<--height> B<-h> Height of the avatar in pixels (32 for Smoke theme)
=item C<--alpha> B<-a> Alpha transparency of the avatar between 0.00 and 1.00
(default .8)
=item C<--daemonize> C<-d> Run as daemon
=item C<-g> C<--config> a configuration file that sets command line
parameters
=item C<-h> C<-help>
=item C<-v> verbose mode
=item C<-vv> very verbose mode
=item C<-vvv> debug verbose mode
=back
=head1 EXIT STATUS
The exit status is determined by L
=over 4
=item * 1
=item * 2
=back
=head1 EXAMPLES
trowel -i5 -l180 -f"%t %d"
-ttwitter,stephenfry,rjstelling
-Iguykawasaki,twitter,stephenfry,TechCrunch,rjstelling
=head1 AUTHOR
Original by Richard Stelling L
Adapted and expanded by Roland van Ipenburg C<< >>
=head1 TODO
=over
=item * Add better AppleScripts that open URLs in various browsers in a new
tab or a background tab.
=back
=head1 LICENSE AND COPYRIGHT
Copyright (C) 2010 by Roland van Ipenburg
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.0 or,
at your option, any later version of Perl 5 you may have available.
=head1 DISCLAIMER OF WARRANTY
BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
NECESSARY SERVICING, REPAIR, OR CORRECTION.
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENSE, BE
LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.
=cut
# vim:set filetype=perl