10 our $VERSION = '0.03';
12 use constant { COLOR_TAG => "\00307" };
16 $class = ref($class) || $class || return;
20 my $caller = (caller 0)[0];
21 $opts{tag} ||= ($caller =~ /([^:]*):*$/) ? $1 : 'UNKNOWN';
22 $opts{name} ||= $opts{tag};
23 $opts{desc} ||= $opts{name};
24 $opts{version} ||= do { no strict 'refs'; ${$caller.'::VERSION'} }
27 my $email = $opts{email};
28 $email = '<' . $email . '>' if defined $email;
29 my $desc = join ', ', grep defined, $opts{author}, $email, $opts{url};
30 $desc = ' (' . $desc . ')' if length $desc;
31 $opts{banner} = $opts{desc} . $desc;
33 my $ph = bless \do { local *PH }, $class;
36 *$ph->{$_} = $opts{$_} for qw/tag name version desc author email url banner/;
39 Xchat::register(@opts{qw/name version banner/}, sub {
41 if (*$ph->{atexit_id}) {
42 my @callbacks = sort { *$ph->{atexit}{$b} <=> *$ph->{atexit}{$a} }
43 keys %{*$ph->{atexit}};
44 $_->($ph) for @callbacks;
48 $ph->add_atexit($opts{unload}) if $opts{unload};
50 $ph->print("\002", $ph->name, ' v', $ph->version,
51 " loaded\002 (", $ph->banner, ")\n");
71 return *$ph->{version};
83 return *$ph->{author};
101 return *$ph->{banner};
108 my $data = join '', *$ph->{buf},
110 (@_) ? @_ : ((defined) ? $_ : '');
111 while ((my $i = index $data, "\n") >= 0) {
112 Xchat::print(COLOR_TAG . $ph->tag . "\t" . (substr $data, 0, ($i + 1), ''));
119 sub printf { shift->print(sprintf @_) }
124 $ph->print("\n") if length $ph->{buf};
128 my ($ph, $callback) = @_;
129 return unless $ph && $callback && ref $callback eq 'CODE';
130 if (!*$ph->{atexit_id}) {
131 tie my %h, 'Tie::RefHash';
132 *$ph->{atexit} = \%h;
134 return *$ph->{atexit}{$callback} = ++*$ph->{atexit_id};
138 my ($ph, $callback) = @_;
139 return unless $ph && $callback;
140 if (exists *$ph->{atexit}{$callback}) {
141 delete *$ph->{atexit}{$callback};
149 ((defined $ph && $ph->isa(__PACKAGE__))
154 sub PRINT { shift->print(@_) }
156 sub PRINTF { shift->printf(@_) }
158 my $ph = __PACKAGE__->new(
159 name => 'Extended Xchat Perl Interface',
160 desc => 'Adds extended support for Perl scripts',
161 author => 'Vincent Pit (VPIT)',
162 email => 'perl@profvince.com',
163 url => 'http://www.profvince.com',