# milkbone - profile dialog package Milkbone::Profile; use Milkbone; our $VERSION = '1.0'; use Tk::widgets qw(Frame Browser); use base qw(Tk::Toplevel); use strict; use warnings; Construct Tk::Widget 'MBProfile'; sub ClassInit { my ($class, $mw) = @_; $class->SUPER::ClassInit($mw); } sub Populate { my ($self, $args) = @_; $self->SUPER::Populate($args); $self->ConfigSpecs('DEFAULT' => ['SELF']); } sub on_receive_away { my ($self, $away) = @_; $away = $self->process($away); $self->{text}->insertHTML('0.0', "\n-------------------------\n"); $self->{text}->insertHTML('0.0', $away); $self->{close}->focus; } sub on_receive_prof { my ($self, $prof) = @_; $prof = $self->process($prof); $self->{text}->insertHTML('end', $prof); $self->{close}->focus; } sub on_destroy { my ($self) = @_; $self->{destroyed} = 1; hook("remove_profile", -who => $self->{who}); } sub set_buddy { my ($self, $buddy) = @_; $self->{buddy} = $buddy; } sub process { my ($self, $str) = @_; $str =~ s/\%n/data("me")/eg; return $str; } sub init { my ($self, $who) = @_; my ($mins, $hrs, $days); $self->{who} = $who; my $on_time = time - hook("protocol_on_since", -who => $who); (undef, $mins, $hrs, $days, undef, undef, undef) = gmtime($on_time); $days--; $self->Label(-text => "$who has been online for $days days, $hrs hours, $mins minutes")->pack(-ipady => 1, -anchor => 'w'); if(hook("protocol_idle_since", -who => $who)) { use integer; my $idle_time = hook("protocol_idle_since", -who => $who); my ($mins, $hrs, $days); $mins = $idle_time / 60; $hrs = $mins / 60; $mins %= 60; $days = $hrs / 24; $hrs %= 24; $self->Label(-text => "$who has been idle for $days days, $hrs hours, $mins minutes")->pack(-ipady => 1, -anchor => 'w'); } $self->Label(-text => "Profile Text:", -font => 'arial 9 bold')->pack(-ipady => 1, -anchor => 'w'); $self->{text} = $self->Frame->pack(-expand => 1, -fill => 'both')-> Scrolled("Browser", -scrollbars => 'oe', -background => 'white', -wrap => 'word')-> pack(-expand => 1, -fill => 'both'); $self->{text}->tagConfigure('away', -foreground => 'blue', -font => 'arial 10 bold'); $self->{text}->tagConfigure('prof', -foreground => 'black', -font => 'arial 10 bold'); $self->{close} = $self->Button(-text => "Close", -command => [$self, "destroy"])->pack; hook("tk_bindwheel", -window => $self->{text}); $self->OnDestroy([\&on_destroy, $self]); $self->bind("", [$self, "destroy"]); hook("tk_seticon", -wnd => $self); }