package Xchat::XPI; use strict; use warnings; use Tie::RefHash; use Xchat; use lib Xchat::get_info('xchatdir'); use Xchat::XPI::Utils qw; our $VERSION = '0.05'; use constant { COLOR_TAG => "\00307" }; my @attributes; BEGIN { @attributes = qw; } local *PH; sub new { my $class = shift; $class = ref($class) || $class; my %opts = @_; my $caller = (caller 0)[0]; unless (defined $opts{tag}) { $opts{tag} = ($caller =~ /([^:]*):*$/) ? $1 : 'UNKNOWN'; } unless (defined $opts{name}) { $opts{name} = $opts{tag}; } unless (defined $opts{desc}) { $opts{desc} = $opts{name}; } unless (defined $opts{version}) { my $version = do { no strict 'refs'; ${$caller.'::VERSION'} }; $version = '0.01' unless defined $version; $opts{version} = $version; } unless (defined $opts{banner}) { my $author = defined $opts{author} ? $opts{author} : 'unknown hacker'; my $email = defined $opts{email} ? "<$opts{email}>" : undef; my $who = join ', ', grep defined, $email, $opts{url}; $who = " ($who)" if length $who; $opts{banner} = $opts{desc} . " by $author$who"; } my $ph = bless \do { local *PH }, $class; tie *$ph, $ph, @_; *$ph->{$_} = $opts{$_} for @attributes; *$ph->{buf} = ''; called_from_script { Xchat::register(@opts{qw}, 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; } BEGIN { local $@; eval "sub $_ { my \$ph = \$_[0]; *\$ph->{$_} }; 1" or die $@ for @attributes; } sub print { my $ph = shift; @_ = ($_) unless @_; my $ret = 0; my $data = join '', *$ph->{buf}, @_; 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) = @_; if (length $ph->{buf}) { $ph->print("\n"); } else { return; } } sub add_atexit { my ($ph, $callback) = @_; 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) = @_; 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(@_) } 1;