#!/usr/local/bin/perl
# pudge@pobox.com
# 2005.10.25
# what's happening!
# you need to create glues for all apps you will script, of course,
# see Mac::Glue docs to learn how to do "gluemac $path".
use strict;
use warnings;
no warnings 'utf8', 'uninitialized';
use Encode 'from_to';
use File::Basename;
use File::Path;
use File::Spec::Functions;
use File::Temp ();
use Mac::Apps::Launch;
use Mac::Glue 1.15;
use Mac::Glue ':all';
use Mac::Files;
use Mac::PropertyList 'parse_plist';
use URI::Escape;
use URI::file;
$SIG{CHLD} = 'IGNORE';
our $DEBUG = 0;
my $pid;
if (1) {
$pid = fork;
if ($pid) {
print "Running background process ($pid)\n";
exit;
}
}
END {
output() unless $pid;
remove_art_files();
}
my(%apps, %versions, %objs);
my($art, $artold, $artchanged, $artcapschanged, @artcaps, @artoldcaps, $artorig,
$itunes_slot, $icns_data);
###
### config section
###
my $tmp = FindFolder(kUserDomain, kTemporaryFolderType, kCreateFolder);
my $pics = FindFolder(kUserDomain, kPictureDocumentsFolderType, kDontCreateFolder);
my $file = catfile($tmp, 'mystatus'); # status
my $extra = catfile($tmp, 'myextra'); # extra text to append to status
my $skip = catfile($tmp, 'myskip'); # if file exists, don't update anything temporarily
my $artf = catdir($tmp, 'myart'); # for growl, or whatever
my $arts = catdir($tmp, 'myscreens'); # screen saver or desktop background folder
my $artorig_path = catfile($pics, 'default.tiff'); # the default user picture
my $dragthing = 0;
my $growl = 0; # send growl notification (requires Growl 0.6 or above)
my $captions = 1; # save large images with captions
my $use_version = 0; # version of app in status
my $random = 0; # display random app name (ha)
my $sleep = 10; # how long between loop iterations
my $timeout = 10; # how long before Apple events time out
my @chatapps = ('Adium', 'iChat'); # iChat and Adium are supported
my $eyetvdir = '/Volumes/Martinez/EyeTV Archive';
my $fortune = '/sw/bin/fortune';
# for images with captions
my $gfont = '/Library/Fonts/Arial Black';
my $main_x = 1440;
my $main_y = 900;
my %hosts = ( # host => username
'sweeney.local' => [ pudge => 501 ],
'orr.local' => [ home => 0 ],
);
my @hosts = qw(sweeney.local orr.local);
my @ihosts = qw(sweeney.local); # host for images
# http://en.wikipedia.org/wiki/List_of_fictional_curse_words
my %badwords = (
'102 117 99 107' => 'frell',
'115 104 105 116' => 'dren',
'98 105 116 99 104' => 'tralk',
);
# comment out the ones you won't use
my @subs = (
\&dvd,
\&vlc,
\&eyetv,
\&itunes,
);
# how to handle specific apps
my %processes = (
default => sub { #return 0;
my($glue) = @_;
my $obj = $objs{$glue->{APPNAME}} ||= $glue->prop(name => window => 1);
$obj->get;
},
Terminal => sub { return 0;
my($glue) = @_;
my($procs, $title) = @{ $objs{$glue->{APPNAME}} ||= [
$glue->prop(processes => window => 1),
$glue->prop(custom_title => window => 1)
] };
my @procs = $procs->get;
my @good;
for (@procs) {
push @good, $_;
@good = () if @good > 1 && $good[-2] eq 'login' && !/^ssh$/ && /^\w*sh$/;
}
return $good[0] || $procs[-1];
},
MacCvsX => sub { #return 0;
my($glue) = @_;
my $obj = $objs{$glue->{APPNAME}} ||= $glue->prop(name => window => 2);
$obj->get;
},
Camino => sub { return 0;
my($glue) = @_;
my $obj = $objs{$glue->{APPNAME}} ||= $glue->prop(url => browser_window => 1);
my $url = $obj->get;
return URI->new($url)->host if $url;
},
ircle => sub { return 0;
sprintf("%s:%s",
$_[0]->prop('currentchannel')->get,
$_[0]->prop(servername => connection =>
$_[0]->prop('currentconnection')->get
)->get
)
},
Safari => sub { return 0;
my($glue) = @_;
my $obj = $objs{$glue->{APPNAME}} ||= $glue->prop(url => document => 1 => window => 1);
my $url = $obj->get;
return URI->new($url)->host if $url;
},
# ignore these
DragThing => 0,
Eudora => 0,
iChat => 0,
iTunes => 0,
iCal => 0,
'Address Book' => 0,
VLC => 0,
OmniWeb => 0,
Adium => 0,
);
$processes{iTerm} = sub {
return 0;
my $name = $processes{default}->(@_);
$name =~ s/^\w+\@//;
return $name;
};
###
### initialization
###
$captions &&= eval 'require Imager' ? 1 : 0;
remove_art_files();
if ($artorig_path && -f $artorig_path) {
local $/;
if (open my $fh, '<', $artorig_path) {
$artold = $artorig = <$fh>;
}
}
$hosts{$_} = [0, 0, $hosts{$_}] for keys %hosts;
for my $bad (keys %badwords) {
my $replacement = delete $badwords{$bad};
$bad = join '', map chr $_, split ' ', $bad;
$badwords{$bad} = $replacement;
}
###
### main loop
###
my $count = 0;
while (1) {
unless (skip()) {
my $output;
for (@subs) {
$output = $_->();
last if $output;
}
for my $str (frontmost(), extra()) {
if (defined $str && length $str) {
if (defined $output && length $output) {
$output = $str . '; ' . $output
unless $str =~ /^.?iTunes$/;
} else {
$output = $str;
}
}
}
$output = fortune() unless defined $output && length $output;
artwork();
output($output);
}
sleep($sleep);
}
###
### main functions
###
sub fortune {
return unless -x $fortune;
chomp(my $t = `$fortune -sn44`);
$t =~ s/ +/ /g;
return $t;
}
{ my($eyetv_name);
sub eyetv {
my $eyetv = get_app('EyeTV') or return;
return unless IsRunning($eyetv->{CREATOR_ID});
$eyetv_name ||= $eyetv->prop(name => player_window => 1);
my $prog = $eyetv_name->get or return;
$prog =~ s/^EyeTV - (?:\d+)?\s*//;
if ($prog =~ /^(\w+)\.mpg$/) {
my $file = $1;
my $eyetvdir = quotemeta($eyetvdir);
($file) = glob(catfile($eyetvdir, '*', "$file.eyetvr"));
my $dirname = quotemeta(dirname($file));
($file) = glob(catfile($dirname, '*.eyetvp'));
if (-e $file) {
my $info = get_plist($file);
$prog = $info->{value}{title}{value}
if $info->{value}{title}{value};
}
}
return "\x{2605}$prog";
}}
{ my($vlc_name);
sub vlc {
my $vlc = get_app('VLC') or return;
return unless IsRunning($vlc->{CREATOR_ID});
$vlc_name ||= $vlc->prop(name => window => 1,
windows => whose(AND =>
[visible => equals => 1],
[NOT => [name => equals => 'VLC - Controller']],
[NOT => [name => equals => 'About VLC Media Player']],
[NOT => [name => equals => 'Messages']],
[NOT => [name => equals => 'Playlist']],
)
);
my $prog = $vlc_name->get or return;
if ($prog =~ s/ \xD1 .+$//) {
$prog = uri_unescape($prog);
}
$prog =~ s/\.(\w+)$//;
return "\x{2605}$prog";
}}
{ my($dvd_state);
sub dvd {
my $dvd = get_app('DVD Player') or return;
return unless IsRunning($dvd->{CREATOR_ID});
$dvd_state ||= $dvd->prop('dvd state');
return unless $dvd_state->get eq 'playing';
my($line) = grep m|^/dev/disk1 on /Volumes/|, `mount`;
$line =~ m|/Volumes/(\w+)|;
(my $title = $1) =~ s/_/ /g;
$title =~ s/(\w+)/\L\u$1/g;
return "\x{2605}$title";
}}
{ my($state, $track, $class, $old_id, %props);
sub itunes {
undef $art;
@artcaps = ();
my $itunes = get_app('iTunes') or return;
my $remote;
$state ||= $itunes->prop('player state');
my $found = 0;
if (IsRunning($itunes->{CREATOR_ID})) {
$itunes->ADDRESS;
$found = 1 if $state->get eq 'playing';
}
$found ||= get_remote($itunes, $state, 'playing');
$old_id = 0, return unless $found;
$track ||= $itunes->prop('current track');
$class ||= $track->prop('class');
my %info;
my $new_id = $track->prop('database id')->get;
# don't keep fetching if we have same track
if ($new_id ne $old_id) {
$old_id = $new_id;
%props = map { $_ => $track->prop($_) } qw(name artist album bit_rate)
unless keys %props;
for my $prop (keys %props) {
$info{$prop} = $props{$prop}->get;
}
my $newtrack = $track;
if ($class->get eq 'cShT') { # shared track
$found = 0;
if ($found = get_remote($itunes, '', '', \@ihosts)) {
$newtrack = $itunes->obj(
track => 1,
tracks => whose(AND => map {
[$_ => equals => $info{$_}]
} keys %info),
library_playlist => 1
);
}
}
if ($found) {
$art = $newtrack->prop(data => artwork => 1)->get;
@artcaps = @info{qw(name artist album)};
}
} elsif ($artold || @artoldcaps) {
$art = $artold;
@info{qw(name artist album)} = @artcaps = @artoldcaps;
} else { # ???
return;
}
my $str = $info{artist}
? "$info{artist} - $info{name}"
: "$info{name}";
from_to($str, "MacRoman", "iso-8859-9");
return $str = "\x{266C}$str";
}}
{ my(%versions);
sub frontmost {
my $front = get_front();
return unless $front;
my $output = "\x{261B}" . $front;
my $app = exists $processes{$front} ? $front : 'default';
my $glue = get_app($front);
if ($glue && $use_version) {
$versions{$app} ||= $glue->prop('version');
my $version = $versions{$app}->get;
$output .= " $version" if $version;
}
if (0 && $glue && ref($processes{$app})) {
eval {
my $specific = $processes{$app}->($glue);
$output .= " ($specific)" if $specific;
}
}
return $output;
}}
{ my($app);
sub get_front {
my $system = get_app('System Events') or return;
$app ||= $system->prop(name => item => 1,
$random
? (application_process => gAny)
: (application_process => whose(frontmost => equals => 1))
);
return $app->get;
}}
{ my($status, %message, %image, %chat_props);
sub ichat {
my($output) = @_;
%chat_props = (
iChat => {
status => 'status',
status_message => 'status message',
image => 'image'
},
Adium => {
status => 'my status',
status_message => 'my status message',
image => 'default image'
}
) unless keys %chat_props;
my($seen1, $seen2);
for my $chatapp (@chatapps) {
my $set_chat = 1;
my $chat = get_app($chatapp) or next; #return;
#print "0:$chatapp:$set_chat\n";
$set_chat = 0 unless IsRunning($chat->{CREATOR_ID});
#print "1:$chatapp:$set_chat\n";
$status ||= $chat->prop($chat_props{$chatapp}{status}) if $set_chat;
#print "2:$chatapp:$set_chat\n";
# $set_chat = 0 unless $set_chat && $status && $status->get eq 'available';
# $set_chat = 0 unless $set_chat && $status && $status->get ne 'offline';
if ($set_chat && $status) {
#print "3:$chatapp:$set_chat\n";
my $curr = $status->get;
if (!$curr || $curr eq 'offline' || $curr eq 'away_and_idle') {
$set_chat = 0;
}
} else {
#print "4:$chatapp:$set_chat\n";
$set_chat = 0;
}
#print "5:$chatapp:$set_chat\n";
next unless $set_chat; # return
#print "6:$chatapp:$set_chat\n";
my $message = $message{$chatapp} ||= $chat->prop($chat_props{$chatapp}{status_message});
$message->set(to => $output);
my $image = $image{$chatapp} ||= $chat->prop($chat_props{$chatapp}{image});
if (!$seen1) {
$artorig ||= $image->get;
$seen1 = 1;
}
if ($artchanged) {
if ($art) {
if (!$seen2) {
$artorig ||= $image->get;
$seen2 = 1;
}
$image->set(to => param_type(TIFF => $art));
} else {
$image->set(to => param_type(TIFF => $artorig)) if $artorig;
}
}
}
}}
{ my($itunes_orig, $bgd, $pic, $image);
sub dragthing {
return unless $dragthing;
return if $itunes_slot eq '-1';
$dragthing = get_app('DragThing') or return;
# $dragthing->ERRORS(1);
unless ($itunes_slot) {
OUTER: for my $dock ($dragthing->obj('docks')->get) {
# next unless $dock->prop('name')->get eq 'Process Dock';
for my $layer ($dock->obj('layers')->get) {
for my $slot ($layer->obj('slots')->get) {
next if $slot->prop('empty')->get;
if ($slot->prop('name')->get eq 'iTunes') {
$itunes_slot = $slot->prop('icon');
last OUTER;
}
}
}
}
if (!$itunes_slot) {
$itunes_slot = -1;
return;
}
}
$itunes_orig ||= $itunes_slot->get;
if ($art && $icns_data) {
$itunes_slot->set(to => param_type(icns => $icns_data));
} else {
$itunes_slot->set(to => param_type(icns => $itunes_orig));
}
}}
{ my($registered, $application_name, $notification_name);
sub growl {
return unless $growl;
$application_name ||= basename($0);
$notification_name ||= 'Now Playing';
$growl = get_app('GrowlHelperApp') or return;
$growl->register(
all_notifications => [param_type(typeChar, $notification_name)],
default_notifications => [param_type(typeChar, $notification_name)],
as_application => $application_name,
icon_of_application => 'iTunes',
) unless $registered;
$registered = 1;
my %params = (
application_name => $application_name,
title => $artcaps[0],
with_name => $notification_name,
description => "$artcaps[1]\n$artcaps[2]",
);
for (qw(title description)) {
from_to($params{$_}, "MacRoman", "iso-8859-9");
}
my $filename = catfile($artf, 'IMG0000');
my $url = URI::file->new($filename);
if (-e $filename && $url) {
(my $url_string = $url->as_string) =~ s|file:/(?!/)|file:///|;
$params{image_from_location} = param_type(typeChar, $url_string);
}
$growl->notify(%params);
}}
###
### artwork utility functions
###
sub artwork {
$artcapschanged = join($;, @artoldcaps) ne join($;, @artcaps);
if ($art) {
if (!$artold || $art ne $artold || $artcapschanged) {
$artchanged = 1;
$artold = $art;
save_art();
} else {
$artchanged = 0;
}
} else {
if ($artold) {
$artchanged = 1;
remove_art_files() unless $artcapschanged;
undef $artold;
} else {
$artchanged = 0;
}
if ($artcapschanged) {
save_art();
}
}
@artoldcaps = @artcaps;
}
sub save_art {
my $file = remove_art_files(1);
if ($art) {
open(my($fh), '>', $file) or die $!;
(my $save = $art) =~ s/^.+\x00\x18\xFF\xFF//s;
print $fh $save;
close $fh;
save_art_icns($file) if $dragthing;
}
save_art_captions($file) if $captions;
}
sub remove_art_files {
my($getnew) = @_;
my $new = 'IMG0000';
for my $dir ($artf, $arts) {
mkdir $dir;
opendir(my $dh, $dir) or return;
unlink map { catfile($dir, $_) } grep { /^IMG/ } readdir($dh);
closedir $dh;
}
if ($getnew) {
return catfile($artf, $new);
} elsif ($captions) {
save_art_dummy(catfile($arts, $new));
}
}
{my($image, $bgd, $pic, $white, $black, $type, $font, $x, $y);
sub save_art_captions {
my($filename) = @_;
$bgd ||= Imager->new(xsize => $main_x, ysize => $main_y);
$white ||= Imager::Color->new("#FFFFFF");
$black ||= Imager::Color->new("#000000");
$type ||= 'ft2'; #$gfont =~ /\.dfont$/ ? 'ft2' : undef;
$font ||= Imager::Font->new(file => $gfont, type => $type) or return;
$pic ||= new Imager;
my $opened = $pic->open(file => $filename);
$pic = $pic->scale(ypixels => $main_y) if $opened;
$image = $bgd->copy;
$image->paste(left => ($main_x - $pic->getwidth), img => $pic) if $opened;
($x, $y) = ($image->getwidth, $image->getheight);
my $ratio = 720 / $y;
my @strings = reverse grep $_, @artcaps;
for my $i (0 .. $#strings) {
my $string = $strings[$i];
my $size = ($#strings == $i ? 38 : 30) / $ratio;
my $space = 37 / $ratio;
$space += 2 / $ratio if $#strings == $i;
while (($font->bounding_box(string => $string, size => $size))[2] >= ($x - 20/$ratio)) {
printf("%s : %s : %s\n",
($font->bounding_box(string => $string, size => $size))[2],
($x + 20/$ratio),
$string
) if $DEBUG;
$string =~ s/.(\.\.\.)?$/.../;
}
from_to($string, "MacRoman", "iso-8859-9");
for my $color ($black, $white) {
my $tx = 10 / $ratio;
my $ty = ($y - 10/$ratio) - (($i+1) * $space);
if ($color eq $black) {
$tx += 3;
$ty += 3;
}
$image->string(
font => $font,
text => $string,
'x' => $tx,
'y' => $ty,
size => $size,
color => $color,
aa => 1,
) or warn $image->errstr;
}
}
mkdir $arts;
(my $newfile = $filename) =~ s/\Q$artf/$arts/;
$image->write(file => $newfile, type => 'png') or warn $image->errstr;
}
sub save_art_dummy {
my($filename) = @_;
$bgd ||= Imager->new(xsize => $main_x, ysize => $main_y);
$bgd->write(file => $filename, type => 'png') or warn $image->errstr;
}
{ my($bgd);
sub save_art_icns {
my($filename) = @_;
$icns_data = '';
$pic ||= new Imager;
if ($pic->open(file => $filename)) {
$pic = $pic->scale(xpixels => 128, ypixels => 128);
$bgd ||= Imager->new(xsize => 128, ysize => 128);
$image = $bgd->copy;
$image->paste(img => $pic);
$filename .= 'SMALL';
$image->write(file => $filename, type => 'tiff');
}
my $icns_file = $filename . '.icns';
system('/usr/bin/tiff2icns', '-noLarge', $filename, $icns_file);
open my $fh, '<', $icns_file;
{ local $/;
$icns_data = <$fh>;
}
close $fh;
}}
}
###
### other utility functions
###
sub output {
my($output) = @_;
$output = filter_badwords($output);
open my $fh, '>', $file;
print $fh $output;
close $fh;
ichat($output);
if (($artchanged && $art) || ($artcapschanged && @artcaps)) {
growl();
}
dragthing() if $artchanged;
}
# skip everything by creating temp file
sub skip {
return -e $skip;
}
# some extra text to drop in, if desired
sub extra {
open my $fh, '<', $extra or return;
{
local $/;
my $text = <$fh>;
$text =~ s/[\r\n]+$//s;
return $text;
}
}
sub get_remote {
my($app, $prop, $value, $hostlist) = @_;
$hostlist ||= \@hosts;
my $found = 0;
my $check = $prop ? 1 : 0;
for my $host (@$hostlist) {
# only check "bad" hosts every minute or so
next unless $hosts{$host}[$check] + 60 < time();
my @args = (eppc => $app->{APPNAME} => $host);
my $user = $hosts{$host}[2][0] || '';
my $uid = $hosts{$host}[2][1] || 0;
push @args, $uid, 0, $user if $uid || $user;
$app->ADDRESS(@args);
my $test;
if ($prop) {
$test = $prop->get eq $value;
} else {
my $version = $versions{$app->{APPNAME}} ||= $app->prop('version');
$test = $version->get;
}
$found = 1, last if $test;
$hosts{$host}[$check] = time();
}
$app->ADDRESS unless $found;
return $found;
}
sub get_app {
my($app) = @_;
if ($apps{$app}) {
if ($apps{$app} eq 'NA') {
return;
} else {
return $apps{$app};
}
} else {
eval { $apps{$app} = new Mac::Glue $app };
if ($@) {
$apps{$app} = 'NA'; # cache the failure
return; # fail silently
}
$apps{$app}->TIMEOUT($timeout);
return $apps{$app};
}
}
sub get_plist {
my($file) = @_;
open my $fh, '<', $file or die "Can't open '$file': $!";
my $data = do { local $/; <$fh> };
# flatten
$data =~ s{ [^<]+\s+ }{}sgx;
$data =~ s{ (?!\n) }{}sgx;
return Mac::PropertyList::parse_plist($data);
}
sub filter_badwords {
my($text) = @_;
for my $bad (keys %badwords) {
$text =~ s[($bad)][do{
my $x = $1;
if (ord substr($x, -1, 1) < 97) {
uc($badwords{$bad});
} elsif (ord substr($x, 0, 1) < 97) {
ucfirst($badwords{$bad});
} else {
$badwords{$bad};
}
}]gei;
}
return $text;
}
__END__