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;
}