package TkFile; use Milkbone; use Milkbone::File; use Tk; use warnings; use strict; my $mw = hook("tk_getmain"); register_hook "edit_file", sub { my $file = $mw->MBFile; my $type = $ARGS{-type}; my ($prof_file, $away_file, $prof, $away) = get_all(); if($type eq "profile") { $file->init($mw, $prof, $prof_file, $type); } else { $file->init($mw, $away, $away_file, $type); } $file->focus; }; register_hook "on_set_profile", sub { hook("edit_file", -type => "profile"); }; register_hook "on_set_away", sub { hook("edit_file", -type => "away"); }; register_hook "signed_in", sub { $ARGS{-type} = 'profile'; &get_all; $ARGS{-type} = 'away'; &get_all; }; sub get_all{ my $away_file = user_file("away.txt"); my $prof_file = user_file("profile.txt"); my $away = pre_read(slurp($away_file, 1)); my $prof = pre_read(slurp($prof_file, 1)); if($prof eq "FAILED") { $prof = "Milkbone %v(milkbone.org)

A recent survey has concluded that 100% of all milkbone users would rather use milkbone than nothing at all.

I'm listening to %a - %s"; } if($away eq "FAILED") { $away = "I cannot be bothered at this time."; } hook("protocol_set_prof", -data => $prof); hook("protocol_set_away", -data => $away); return ($prof_file, $away_file, $prof, $away); } sub pre_read { my ($text) = @_; $text =~ s/
/\n/gi; return $text; }