Xchat/XPI/Utils.pm

   1 package Xchat::XPI::Utils;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Xchat qw<:all>;
   7
   8 our $VERSION = '0.02';
   9
  10 sub irc_lc {
  11  my ($bytes) = @_;
  12
  13  $bytes =~ y/A-Z[\\]^/a-z{|}~/;
  14
  15  return $bytes;
  16 }
  17
  18 my @rcolors;
  19 BEGIN {
  20  if (nickcmp(get_info('version'), '2.4.0') < 0) {
  21   @rcolors = (3, 4, 6, 8, 9, 10, 11, 12, 13);
  22  } else {
  23   @rcolors = (19, 20, 22, 24, 25, 26, 27, 28, 29);
  24  }
  25 }
  26
  27 sub dye_nick {
  28  my $nick = $_[0];
  29  my $col  = 0;
  30  $col    += ord for split //, $nick;
  31  return sprintf "\003%d%s", $rcolors[$col % @rcolors], $nick;
  32 }
  33
  34 my %gui_commands = (
  35  'clear'     => [ 'COLOR 0' ],
  36  'highlight' => [ 'FLASH' => 'COLOR 3' ],
  37 );
  38
  39 sub gui {
  40  my $commands = $gui_commands{$_[0] || 'nope'};
  41  die 'Invalid command' unless defined $commands;
  42  command "GUI $_" for @$commands;
  43 }
  44
  45 sub save_context {
  46  my $cur_cxt = get_context;
  47  bless \$cur_cxt, 'Xchat::XPI::Utils::ContextGuard';
  48 }
  49
  50 sub local_context {
  51  return unless @_ >= 2;
  52  my $code    = pop;
  53  my $new_cxt = (@_ == 1) ? $_[0] : find_context(@_);
  54  return undef unless defined $new_cxt;
  55  my $cur_cxt = get_context;
  56  my $guard   = bless \$cur_cxt, 'Xchat::XPI::Utils::ContextGuard';
  57  if (set_context $new_cxt) {
  58   return $code->();
  59  } else {
  60   return undef;
  61  }
  62 }
  63
  64 sub Xchat::XPI::Utils::ContextGuard::DESTROY {
  65  set_context ${$_[0]};
  66 }
  67
  68 sub called_from_script (&) {
  69  my $code  = shift;
  70  my $level = 0;
  71  my ($package, $filename);
  72  while (1) {
  73   my @frame = caller $level;
  74   last unless @frame;
  75   if ($frame[0] !~ /^(?:Xchat|HexChat)::XPI\b/) {
  76    ($package, $filename) = @frame[0, 1];
  77    last;
  78   }
  79   ++$level;
  80  }
  81  if (defined $filename) {
  82   my $internal_package = Xchat::Embed::file2pkg($filename);
  83   my $mock = sub { $internal_package, $package };
  84   no warnings 'redefine';
  85   local *Xchat::Embed::find_pkg   = $mock;
  86   local *HexChat::Embed::find_pkg = $mock;
  87   $code->();
  88  }
  89 }
  90
  91 use base qw<Exporter>;
  92
  93 our @EXPORT         = ();
  94 our %EXPORT_TAGS    = ('funcs' => [ qw<
  95  irc_lc
  96  dye_nick
  97  gui
  98  save_context local_context
  99  called_from_script
 100 > ]);
 101 our @EXPORT_OK      = map { @$_ } values %EXPORT_TAGS;
 102 $EXPORT_TAGS{'all'} = [ @EXPORT_OK ];
 103
 104 1;