10 our $VERSION = '0.04';
12 use constant { COLOR_TAG => "\00307" };
16 @attributes = qw/tag name version desc author email url banner/;
23 $class = ref($class) || $class;
26 my $caller = (caller 0)[0];
27 $opts{tag} ||= ($caller =~ /([^:]*):*$/) ? $1 : 'UNKNOWN';
28 $opts{name} ||= $opts{tag};
29 $opts{desc} ||= $opts{name};
30 $opts{version} ||= do { no strict 'refs'; ${$caller.'::VERSION'} }
33 my $email = $opts{email};
34 $email = "<$email>" if defined $email;
36 my $who = join ', ', grep defined, $opts{author}, $email, $opts{url};
37 $who = " ($who)" if length $who;
38 $opts{banner} = $opts{desc} . $who;
40 my $ph = bless \do { local *PH }, $class;
43 *$ph->{$_} = $opts{$_} for @attributes;
46 Xchat::register(@opts{qw/name version banner/}, sub {
48 if (*$ph->{atexit_id}) {
49 my @callbacks = sort { *$ph->{atexit}{$b} <=> *$ph->{atexit}{$a} }
50 keys %{*$ph->{atexit}};
51 $_->($ph) for @callbacks;
55 $ph->add_atexit($opts{unload}) if $opts{unload};
57 $ph->print("\002", $ph->name, ' v', $ph->version,
58 " loaded\002 (", $ph->banner, ")\n");
63 eval "sub $_ { *\$_[0]->{$_} }" for @attributes;
71 my $data = join '', *$ph->{buf}, @_;
73 while ((my $i = index $data, "\n") >= 0) {
74 Xchat::print(COLOR_TAG . $ph->tag . "\t" . (substr $data, 0, ($i + 1), ''));
83 sub printf { shift->print(sprintf @_) }
88 if (length $ph->{buf}) {
96 my ($ph, $callback) = @_;
98 if (!*$ph->{atexit_id}) {
99 tie my %h, 'Tie::RefHash';
100 *$ph->{atexit} = \%h;
103 return *$ph->{atexit}{$callback} = ++*$ph->{atexit_id};
107 my ($ph, $callback) = @_;
109 if (exists *$ph->{atexit}{$callback}) {
110 delete *$ph->{atexit}{$callback};
119 (defined $ph && $ph->isa(__PACKAGE__)) ? $ph : shift->new(@_);
122 sub PRINT { shift->print(@_) }
124 sub PRINTF { shift->printf(@_) }
126 my $ph = __PACKAGE__->new(
127 name => 'Extended Xchat Perl Interface',
128 desc => 'Adds extended support for Perl scripts',
129 author => 'Vincent Pit (VPIT)',
130 email => 'perl@profvince.com',
131 url => 'http://www.profvince.com',