#!/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{ <key>[^<]+</key>\s+<dict> }{}sgx;
	$data =~ s{ </dict>(?!\n</plist>)     }{}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__