use Xchat;
-our $VERSION = '0.03';
+our $VERSION = '0.04';
use constant { COLOR_TAG => "\00307" };
+my @attributes;
+BEGIN {
+ @attributes = qw/tag name version desc author email url banner/;
+}
+
+local *PH;
+
sub new {
my $class = shift;
- $class = ref($class) || $class || return;
- return if @_ % 2;
- my %opts = @_;
+ $class = ref($class) || $class;
+ my %opts = @_;
my $caller = (caller 0)[0];
$opts{tag} ||= ($caller =~ /([^:]*):*$/) ? $1 : 'UNKNOWN';
|| '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;
+ $email = "<$email>" if defined $email;
+
+ my $who = join ', ', grep defined, $opts{author}, $email, $opts{url};
+ $who = " ($who)" if length $who;
+ $opts{banner} = $opts{desc} . $who;
my $ph = bless \do { local *PH }, $class;
tie *$ph, $ph, @_;
- *$ph->{$_} = $opts{$_} for qw/tag name version desc author email url banner/;
+ *$ph->{$_} = $opts{$_} for @attributes;
*$ph->{buf} = '';
Xchat::register(@opts{qw/name version banner/}, sub {
return $ph;
}
-eval "sub $_ { *\$_[0]->{$_} }"
- for qw/tag name version desc author email url banner/;
+eval "sub $_ { *\$_[0]->{$_} }" for @attributes;
sub print {
my $ph = shift;
- return unless $ph;
+
+ @_ = ($_) unless @_;
+
my $ret = 0;
- my $data = join '', *$ph->{buf},
- grep defined,
- (@_) ? @_ : ((defined) ? $_ : '');
+ 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 flush {
my ($ph) = @_;
- return unless $ph;
- $ph->print("\n") if length $ph->{buf};
+
+ if (length $ph->{buf}) {
+ $ph->print("\n");
+ } else {
+ return;
+ }
}
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(@_));
+ (defined $ph && $ph->isa(__PACKAGE__)) ? $ph : shift->new(@_);
}
-sub PRINT { shift->print(@_) }
+sub PRINT { shift->print(@_) }
sub PRINTF { shift->printf(@_) }