X-Git-Url: http://git.vpit.fr/?p=perl%2Fscripts%2Fxchat.git;a=blobdiff_plain;f=Xchat%2FXPI.pm;h=ff98ec762b9150f59e1ed50a680eded1469113d5;hp=f71bb1e84efcaf1cd77c83eaba6f433f8f481d52;hb=bc7fad34cd01ea436368b5e099cede0aa17abab6;hpb=263b6777b90548951a13bd56419fa911b010eb9b

diff --git a/Xchat/XPI.pm b/Xchat/XPI.pm
index f71bb1e..ff98ec7 100644
--- a/Xchat/XPI.pm
+++ b/Xchat/XPI.pm
@@ -7,36 +7,52 @@ use Tie::RefHash;
 
 use Xchat;
 
-our $VERSION = '0.03';
+our $VERSION = '0.05';
 
 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';
- $opts{name}    ||= $opts{tag};
- $opts{desc}    ||= $opts{name};
- $opts{version} ||= do { no strict 'refs'; ${$caller.'::VERSION'} }
-                || '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;
+ unless (defined $opts{tag}) {
+  $opts{tag}     = ($caller =~ /([^:]*):*$/) ? $1 : 'UNKNOWN';
+ }
+ unless (defined $opts{name}) {
+  $opts{name}    = $opts{tag};
+ }
+ unless (defined $opts{desc}) {
+  $opts{desc}    = $opts{name};
+ }
+ unless (defined $opts{version}) {
+  my $version    = do { no strict 'refs'; ${$caller.'::VERSION'} };
+  $version       = '0.01' unless defined $version;
+  $opts{version} = $version;
+ }
+ unless (defined $opts{banner}) {
+  my $email      = $opts{email};
+  $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 {
+ Xchat::register(@opts{qw<name version banner>}, sub {
   $ph->flush;
   if (*$ph->{atexit_id}) {
    my @callbacks = sort { *$ph->{atexit}{$b} <=> *$ph->{atexit}{$a} }
@@ -53,66 +69,26 @@ sub new {
  return $ph;
 }
 
-sub tag {
- my $ph = shift;
- return unless $ph;
- return *$ph->{tag};
-}
-
-sub name {
- my $ph = shift;
- return unless $ph;
- return *$ph->{name};
-}
-
-sub version {
- my $ph = shift;
- return unless $ph;
- return *$ph->{version};
-}
-
-sub desc {
- my $ph = shift;
- return unless $ph;
- return *$ph->{desc};
-}
-
-sub author {
- my $ph = shift;
- return unless $ph;
- return *$ph->{author};
+BEGIN {
+ local $@;
+ eval "sub $_ { my \$ph = \$_[0]; *\$ph->{$_} }; 1" or die $@ for @attributes;
 }
 
-sub email {
- my $ph = shift;
- return unless $ph;
- return *$ph->{email};
-}
-
-sub url {
+sub print {
  my $ph = shift;
- return unless $ph;
- return *$ph->{url};
-}
 
-sub banner {
- my $ph = shift;
- return unless $ph;
- return *$ph->{banner};
-}
+ @_ = ($_) unless @_;
 
-sub print {
- my $ph = shift;
- return unless $ph;
  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;
 }
 
@@ -120,45 +96,43 @@ sub printf { shift->print(sprintf @_) }
 
 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(@_) }
 
-my $ph = new __PACKAGE__, name   => 'Extended Xchat Perl Interface',
-                          desc   => 'Adds extended support for Perl scripts',
-                          author => 'Vincent Pit (VPIT)',
-                          email  => 'perl@profvince.com',
-                          url    => 'http://www.profvince.com';
-
 1;