10 changed files with 77 additions and 67 deletions
@ -1,46 +1,46 @@
@@ -1,46 +1,46 @@
|
||||
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; |
||||
|
||||
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; |
||||
|
Loading…
Reference in new issue