package Xchat::XPI;

use strict;
use warnings;

use Tie::RefHash;

use Xchat;

our $VERSION = '0.03';

use constant { COLOR_TAG => "\00307" };

sub new {
 my $class = shift;
 $class = ref($class) || $class || return;
 return if @_ % 2;
 my %opts = @_;

 my $caller = (caller 0)[0];
 $opts{tag}     ||= ($caller =~ /([^:]*):*$/) ? $1 : 'UNKNOWN';
 $opts{name}    ||= $opts{tag};
 $opts{desc}    ||= $opts{name};
 $opts{version} ||= do { no strict 'refs'; ${$caller.'::VERSION'} }
                || '0.01';

 my $email = $opts{email};
 $email = '<' . $email . '>' if defined $email;
 my $desc = join ', ', grep defined, $opts{author}, $email, $opts{url};
 $desc = ' (' . $desc . ')' if length $desc;
 $opts{banner} = $opts{desc} . $desc;

 my $ph = bless \do { local *PH }, $class;
 tie *$ph, $ph, @_;

 *$ph->{$_}  = $opts{$_} for qw/tag name version desc author email url banner/;
 *$ph->{buf} = '';

 Xchat::register(@opts{qw/name version banner/}, sub {
  $ph->flush;
  if (*$ph->{atexit_id}) {
   my @callbacks = sort { *$ph->{atexit}{$b} <=> *$ph->{atexit}{$a} }
                    keys %{*$ph->{atexit}};
   $_->($ph) for @callbacks;
  }
  undef $ph;
 });
 $ph->add_atexit($opts{unload}) if $opts{unload};

 $ph->print("\002", $ph->name, ' v', $ph->version,
            " loaded\002 (", $ph->banner, ")\n");

 return $ph;
}

eval "sub $_ { *\$_[0]->{$_} }"
                          for qw/tag name version desc author email url banner/;

sub print {
 my $ph = shift;
 return unless $ph;
 my $ret  = 0;
 my $data = join '', *$ph->{buf},
                     grep defined,
                      (@_) ? @_ : ((defined) ? $_ : '');
 while ((my $i = index $data, "\n") >= 0) {
  Xchat::print(COLOR_TAG . $ph->tag . "\t" . (substr $data, 0, ($i + 1), ''));
  $ret = 1;
 }
 *$ph->{buf} = $data;
 return $ret;
}

sub printf { shift->print(sprintf @_) }

sub flush {
 my ($ph) = @_;
 return unless $ph;
 $ph->print("\n") if length $ph->{buf};
}

sub add_atexit {
 my ($ph, $callback) = @_;
 return unless $ph && $callback && ref $callback eq 'CODE';
 if (!*$ph->{atexit_id}) {
  tie my %h, 'Tie::RefHash';
  *$ph->{atexit} = \%h;
 }
 return *$ph->{atexit}{$callback} = ++*$ph->{atexit_id};
}

sub remove_atexit {
 my ($ph, $callback) = @_;
 return unless $ph && $callback;
 if (exists *$ph->{atexit}{$callback}) {
  delete *$ph->{atexit}{$callback};
  return 1;
 }
 return 0;
}

sub TIEHANDLE {
 my $ph = shift;
 ((defined $ph && $ph->isa(__PACKAGE__))
  ? $ph
  : shift->new(@_));
}

sub PRINT { shift->print(@_) }

sub PRINTF { shift->printf(@_) }

my $ph = __PACKAGE__->new(
 name   => 'Extended Xchat Perl Interface',
 desc   => 'Adds extended support for Perl scripts',
 author => 'Vincent Pit (VPIT)',
 email  => 'perl@profvince.com',
 url    => 'http://www.profvince.com',
);

1;
