Xchat/XPI.pm

   1 package Xchat::XPI;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Tie::RefHash;
   7
   8 use Xchat;
   9
  10 use lib Xchat::get_info('xchatdir');
  11 use Xchat::XPI::Utils qw<called_from_script>;
  12
  13 our $VERSION = '0.05';
  14
  15 use constant { COLOR_TAG => "\00307" };
  16
  17 my @attributes;
  18 BEGIN {
  19  @attributes = qw<tag name version desc author email url banner>;
  20 }
  21
  22 local *PH;
  23
  24 sub new {
  25  my $class = shift;
  26  $class    = ref($class) || $class;
  27  my %opts  = @_;
  28
  29  my $caller = (caller 0)[0];
  30
  31  unless (defined $opts{tag}) {
  32   $opts{tag}     = ($caller =~ /([^:]*):*$/) ? $1 : 'UNKNOWN';
  33  }
  34  unless (defined $opts{name}) {
  35   $opts{name}    = $opts{tag};
  36  }
  37  unless (defined $opts{desc}) {
  38   $opts{desc}    = $opts{name};
  39  }
  40  unless (defined $opts{version}) {
  41   my $version    = do { no strict 'refs'; ${$caller.'::VERSION'} };
  42   $version       = '0.01' unless defined $version;
  43   $opts{version} = $version;
  44  }
  45  unless (defined $opts{banner}) {
  46   my $author     = defined $opts{author} ? $opts{author}    : 'unknown hacker';
  47   my $email      = defined $opts{email}  ? "<$opts{email}>" : undef;
  48   my $who        = join ', ', grep defined, $email, $opts{url};
  49   $who           = " ($who)"  if length $who;
  50   $opts{banner}  = $opts{desc} . " by $author$who";
  51  }
  52
  53  my $ph = bless \do { local *PH }, $class;
  54  tie *$ph, $ph, @_;
  55
  56  *$ph->{$_}  = $opts{$_} for @attributes;
  57  *$ph->{buf} = '';
  58
  59  called_from_script {
  60   Xchat::register(@opts{qw<name version banner>}, sub {
  61    $ph->flush;
  62    if (*$ph->{atexit_id}) {
  63     my @callbacks = sort { *$ph->{atexit}{$b} <=> *$ph->{atexit}{$a} }
  64                      keys %{*$ph->{atexit}};
  65     $_->($ph) for @callbacks;
  66    }
  67    undef $ph;
  68   })
  69  };
  70  $ph->add_atexit($opts{unload}) if $opts{unload};
  71
  72  $ph->print("\002", $ph->name, ' v', $ph->version,
  73             " loaded\002 (", $ph->banner, ")\n");
  74
  75  return $ph;
  76 }
  77
  78 BEGIN {
  79  local $@;
  80  eval "sub $_ { my \$ph = \$_[0]; *\$ph->{$_} }; 1" or die $@ for @attributes;
  81 }
  82
  83 sub print {
  84  my $ph = shift;
  85
  86  @_ = ($_) unless @_;
  87
  88  my $ret  = 0;
  89  my $data = join '', *$ph->{buf}, @_;
  90
  91  while ((my $i = index $data, "\n") >= 0) {
  92   Xchat::print(COLOR_TAG . $ph->tag . "\t" . (substr $data, 0, ($i + 1), ''));
  93   $ret = 1;
  94  }
  95
  96  *$ph->{buf} = $data;
  97
  98  return $ret;
  99 }
 100
 101 sub printf { shift->print(sprintf @_) }
 102
 103 sub flush {
 104  my ($ph) = @_;
 105
 106  if (length $ph->{buf}) {
 107   $ph->print("\n");
 108  } else {
 109   return;
 110  }
 111 }
 112
 113 sub add_atexit {
 114  my ($ph, $callback) = @_;
 115
 116  if (!*$ph->{atexit_id}) {
 117   tie my %h, 'Tie::RefHash';
 118   *$ph->{atexit} = \%h;
 119  }
 120
 121  return *$ph->{atexit}{$callback} = ++*$ph->{atexit_id};
 122 }
 123
 124 sub remove_atexit {
 125  my ($ph, $callback) = @_;
 126
 127  if (exists *$ph->{atexit}{$callback}) {
 128   delete *$ph->{atexit}{$callback};
 129   return 1;
 130  }
 131
 132  return 0;
 133 }
 134
 135 sub TIEHANDLE {
 136  my $ph = shift;
 137  (defined $ph && $ph->isa(__PACKAGE__)) ? $ph : shift->new(@_);
 138 }
 139
 140 sub PRINT  { shift->print(@_) }
 141
 142 sub PRINTF { shift->printf(@_) }
 143
 144 1;