The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#  You may distribute under the terms of the GNU General Public License
#
#  (C) Paul Evans, 2008-2013 -- leonerd@leonerd.org.uk

package Circle::Net::IRC::User;

use strict;
use warnings;
use base qw( Circle::Net::IRC::Target );

use Carp;

# Don't reprint RPL_USERISAWAY message within 1 hour
# TODO: Some sort of config setting system
my $awaytime_print = 3600;

sub default_message_level
{
   my $self = shift;
   my ( $hints ) = @_;

   return 3;
}

sub on_message
{
   my $self = shift;
   my ( $command, $message, $hints ) = @_;

   # Numerics come from the server; real commands come from the user
   if( $command !~ m/^(\d+)$/ ) {
      my $ident    = $hints->{prefix_user};
      my $hostname = $hints->{prefix_host};

      $self->update_ident( "$ident\@$hostname" );
   }

   return $self->SUPER::on_message( @_ );
}

sub update_ident
{
   my $self = shift;
   my ( $ident ) = @_;

   return if defined $self->get_prop_ident and $self->get_prop_ident eq $ident;
   $self->set_prop_ident( $ident );
}

sub on_message_NICK
{
   my $self = shift;
   my ( $message, $hints ) = @_;

   my $oldnick = $self->name;
   my $newnick = $hints->{new_nick};

   $self->push_displayevent( "irc.nick", { oldnick => $oldnick, newnick => $newnick } );
   $self->bump_level( 1 );

   $self->set_prop_name( $newnick );
   $self->set_prop_tag( $newnick );

   my $oldnick_folded = $self->{irc}->casefold_name( $oldnick );

   $self->fire_event( "change_nick", $oldnick, $oldnick_folded, $newnick, $hints->{new_nick_folded} );

   return 1;
}

sub on_message_QUIT
{
   my $self = shift;
   my ( $message, $hints ) = @_;

   my $nick    = $self->name;
   my $quitmsg = $hints->{text};

   defined $quitmsg or $quitmsg = "";

   my $net = $self->{net};
   my $quitmsg_formatted = $net->format_text( $quitmsg );

   my $userhost = "$hints->{prefix_user}\@$hints->{prefix_host}";

   $self->push_displayevent( "irc.quit", { nick => $nick, userhost => $userhost, quitmsg => $quitmsg_formatted } );
   $self->bump_level( 1 );

   return 1;
}

sub on_message_RPL_AWAY
{
   my $self = shift;
   my ( $message, $hints ) = @_;

   my $nick    = $self->name;
   my $awaymsg = $hints->{text};

   defined $awaymsg or $awaymsg = "";

   # Surpress the message if it's already been printed and it's quite soon
   my $now = time;
   if( defined $self->{printed_awaymsg} and
       $self->{printed_awaymsg} eq $awaymsg and
       $now < $self->{printed_awaytime} + $awaytime_print ) {
      return 1;
   }

   my $net = $self->{net};
   my $awaymsg_formatted = $net->format_text( $awaymsg );

   my $userhost = "$hints->{prefix_user}\@$hints->{prefix_host}";

   $self->push_displayevent( "irc.away", { nick => $nick, userhost => $userhost, text => $awaymsg_formatted } );
   $self->bump_level( 1 );

   $self->{printed_awaymsg} = $awaymsg;
   $self->{printed_awaytime} = $now;

   return 1;
}

sub command_close
   : Command_description("Close the window")
{
   my $self = shift;

   $self->destroy;
}

sub make_widget_pre_scroller
{
   my $self = shift;
   my ( $box ) = @_;

   my $registry = $self->{registry};

   my $identlabel = $registry->construct(
      "Circle::Widget::Label",
      classes => [qw( ident )],
   );
   $self->watch_property( "ident",
      on_updated => sub { $identlabel->set_prop_text( $_[1] ) }
   );

   $box->add( $identlabel );
}

sub get_widget_statusbar
{
   my $self = shift;

   my $registry = $self->{registry};
   my $net = $self->{net};

   my $statusbar = $registry->construct(
      "Circle::Widget::Box",
      classes => [qw( status )],
      orientation => "horizontal",
   );

   $statusbar->add( $net->get_widget_netname );

   return $statusbar;
} 

0x55AA;