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.
46 lines
860 B
46 lines
860 B
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;
|
|
|