package TkProfile; use Milkbone::Profile; use Milkbone; use strict; use warnings; my $mw = hook("tk_getmain"); register_hook("get_profile", sub { my $who = $ARGS{-user}; $who =~ s/ //g; $who =~ tr/A-Z/a-z/; my $prof = $mw->MBProfile(-title => "Profile for $who"); $prof->init($who); hook("protocol_request_info", -user => $who); hook("protocol_request_away", -user => $who); $prof->focus; register_hook("protocol_info_received_$who", sub { return unless $ARGS{-self}; my $self = $ARGS{-self}; if(defined $ARGS{-profile}) { $self->on_receive_prof($ARGS{-profile}); $self->{prof_rec} = 1; } if(defined $ARGS{-away}) { $self->on_receive_away($ARGS{-away}); $self->{away_rec} = 1; } }, {-self => $prof}); }); register_hook("remove_profile", sub { deregister_hook("protocol_info_received_" . $ARGS{-who}); }); 1;