You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
73 lines
1.4 KiB
73 lines
1.4 KiB
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 = "<b>Milkbone %v(<a href=\"http://milkbone.batkins.com\">milkbone.batkins.com</a>)</b><br><br>A recent survey has concluded that 100% of all milkbone users would rather use milkbone than nothing at all.<br><br>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/<br>/\n/gi; |
|
|
|
return $text; |
|
} |