10 our $VERSION = '0.05';
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, $file) = (caller 0)[0, 1];
28 unless (defined $opts{tag}) {
29 $opts{tag} = ($caller =~ /([^:]*):*$/) ? $1 : 'UNKNOWN';
31 unless (defined $opts{name}) {
32 $opts{name} = $opts{tag};
34 unless (defined $opts{desc}) {
35 $opts{desc} = $opts{name};
37 unless (defined $opts{version}) {
38 my $version = do { no strict 'refs'; ${$caller.'::VERSION'} };
39 $version = '0.01' unless defined $version;
40 $opts{version} = $version;
42 unless (defined $opts{banner}) {
43 my $author = defined $opts{author} ? $opts{author} : 'unknown hacker';
44 my $email = defined $opts{email} ? "<$opts{email}>" : undef;
45 my $who = join ', ', grep defined, $email, $opts{url};
46 $who = " ($who)" if length $who;
47 $opts{banner} = $opts{desc} . " by $author$who";
50 my $ph = bless \do { local *PH }, $class;
53 *$ph->{$_} = $opts{$_} for @attributes;
56 my $internal_pkg = Xchat::Embed::file2pkg($file);
57 no warnings 'redefine';
58 local *Xchat::Embed::find_pkg = sub { $internal_pkg, $caller };
59 local *HexChat::Embed::find_pkg = sub { $internal_pkg, $caller };
60 Xchat::register(@opts{qw<name version banner>}, sub {
62 if (*$ph->{atexit_id}) {
63 my @callbacks = sort { *$ph->{atexit}{$b} <=> *$ph->{atexit}{$a} }
64 keys %{*$ph->{atexit}};
65 $_->($ph) for @callbacks;
69 $ph->add_atexit($opts{unload}) if $opts{unload};
71 $ph->print("\002", $ph->name, ' v', $ph->version,
72 " loaded\002 (", $ph->banner, ")\n");
79 eval "sub $_ { my \$ph = \$_[0]; *\$ph->{$_} }; 1" or die $@ for @attributes;
88 my $data = join '', *$ph->{buf}, @_;
90 while ((my $i = index $data, "\n") >= 0) {
91 Xchat::print(COLOR_TAG . $ph->tag . "\t" . (substr $data, 0, ($i + 1), ''));
100 sub printf { shift->print(sprintf @_) }
105 if (length $ph->{buf}) {
113 my ($ph, $callback) = @_;
115 if (!*$ph->{atexit_id}) {
116 tie my %h, 'Tie::RefHash';
117 *$ph->{atexit} = \%h;
120 return *$ph->{atexit}{$callback} = ++*$ph->{atexit_id};
124 my ($ph, $callback) = @_;
126 if (exists *$ph->{atexit}{$callback}) {
127 delete *$ph->{atexit}{$callback};
136 (defined $ph && $ph->isa(__PACKAGE__)) ? $ph : shift->new(@_);
139 sub PRINT { shift->print(@_) }
141 sub PRINTF { shift->printf(@_) }