Make sure local_context() runs the code only when the context was found

[perl/scripts/xchat.git] / Xchat / XPI.pm

diff --git a/Xchat/XPI.pm b/Xchat/XPI.pm
index 6927d83b59e83e425ff03143dec7e70072c8c1e9..0733175382a71dde90c6e0d775e1af8a7d818fa6 100644 (file)
--- a/Xchat/XPI.pm
+++ b/Xchat/XPI.pm
@@ -7,13 +7,16 @@ use Tie::RefHash;
 
 use Xchat;
 
+use lib Xchat::get_info('xchatdir');
+use Xchat::XPI::Utils qw<called_from_script>;
+
 our $VERSION = '0.05';
 
 use constant { COLOR_TAG => "\00307" };
 
 my @attributes;
 BEGIN {
- @attributes = qw/tag name version desc author email url banner/;
+ @attributes = qw<tag name version desc author email url banner>;
 }
 
 local *PH;
@@ -24,18 +27,28 @@ sub new {
  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 $who = join ', ', grep defined, $opts{author}, $email, $opts{url};
- $who    = " ($who)" if length $who;
- $opts{banner} = $opts{desc} . $who;
+ 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 $author     = defined $opts{author} ? $opts{author}    : 'unknown hacker';
+  my $email      = defined $opts{email}  ? "<$opts{email}>" : undef;
+  my $who        = join ', ', grep defined, $email, $opts{url};
+  $who           = " ($who)"  if length $who;
+  $opts{banner}  = $opts{desc} . " by $author$who";
+ }
 
  my $ph = bless \do { local *PH }, $class;
  tie *$ph, $ph, @_;
@@ -43,15 +56,17 @@ sub new {
  *$ph->{$_}  = $opts{$_} for @attributes;
  *$ph->{buf} = '';
 
- Xchat::register(@opts{qw/name version banner/}, sub {
-  $ph->flush;
-  if (*$ph->{atexit_id}) {
-   my @callbacks = sort { *$ph->{atexit}{$b} <=> *$ph->{atexit}{$a} }
-                    keys %{*$ph->{atexit}};
-   $_->($ph) for @callbacks;
-  }
-  undef $ph;
- });
+ called_from_script {
+  Xchat::register(@opts{qw<name version banner>}, sub {
+   $ph->flush;
+   if (*$ph->{atexit_id}) {
+    my @callbacks = sort { *$ph->{atexit}{$b} <=> *$ph->{atexit}{$a} }
+                     keys %{*$ph->{atexit}};
+    $_->($ph) for @callbacks;
+   }
+   undef $ph;
+  })
+ };
  $ph->add_atexit($opts{unload}) if $opts{unload};
 
  $ph->print("\002", $ph->name, ' v', $ph->version,