From: Vincent Pit Date: Fri, 20 Nov 2015 13:42:54 +0000 (-0200) Subject: Add better context handling helpers X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;ds=sidebyside;h=edd1cbfd1a969e16d8df9988eb448a53c97c02e7;p=perl%2Fscripts%2Fxchat.git Add better context handling helpers --- diff --git a/Xchat/XPI/Utils.pm b/Xchat/XPI/Utils.pm index 82699db..ad99f0f 100644 --- a/Xchat/XPI/Utils.pm +++ b/Xchat/XPI/Utils.pm @@ -23,10 +23,35 @@ sub dye_nick { return sprintf "\003%d%s", $rcolors[$col % @rcolors], $nick; } +sub save_context { + my $cur_cxt = get_context; + bless \$cur_cxt, 'Xchat::XPI::Utils::ContextGuard'; +} + +sub local_context { + return unless @_ >= 2; + my $code = pop; + my $new_cxt = (@_ == 1) ? $_[0] : find_context(@_); + my $cur_cxt = get_context; + if (set_context $new_cxt) { + my $guard = bless \$cur_cxt, 'Xchat::XPI::Utils::ContextGuard'; + return $code->(); + } else { + return undef; + } +} + +sub Xchat::XPI::Utils::ContextGuard::DESTROY { + set_context ${$_[0]}; +} + use base qw; our @EXPORT = (); -our %EXPORT_TAGS = ('funcs' => [ qw ]); +our %EXPORT_TAGS = ('funcs' => [ qw< + dye_nick + save_context local_context +> ]); our @EXPORT_OK = map { @$_ } values %EXPORT_TAGS; $EXPORT_TAGS{'all'} = [ @EXPORT_OK ]; diff --git a/clones.pl b/clones.pl index 20aecfa..fded636 100755 --- a/clones.pl +++ b/clones.pl @@ -10,6 +10,7 @@ use Xchat qw<:all>; use lib get_info 'xchatdir'; use Xchat::XPI; use Xchat::XPI::Events qw; +use Xchat::XPI::Utils qw; use constant { JOIN_DELAY => 1000, @@ -168,11 +169,10 @@ hook_server '315', sub { # WHO end return EAT_NONE if $fetched{$serv}{$chan}; - my $oldctxt = get_context; - set_context $chan, $serv or return EAT_NONE; - fetch $serv, $chan; - scan $serv, $chan; - set_context $oldctxt; + local_context $chan, $serv => sub { + fetch $serv, $chan; + scan $serv, $chan; + }; return EAT_NONE; }; @@ -186,20 +186,18 @@ hook_server 'JOIN', sub { my $chan = lc substr $_[0][2], 1; # starts with colon my $clones = add $nick, host($userhost), $serv, $chan; - if ($clones > 0) { - my $oldctxt = get_context; - if (set_context $chan, $serv) { - print $ph clone_enter_str $userhost, $nick, $clones; - set_context $oldctxt; - } else { - delay JOIN_DELAY, sub { - my $oldctxt = get_context; - return unless set_context $chan, $serv; + return EAT_NONE unless $clones > 0; + + local_context $chan, $serv => sub { + print $ph clone_enter_str $userhost, $nick, $clones; + 1 + } or do { + delay JOIN_DELAY, sub { + local_context $chan, $serv => sub { print $ph clone_enter_str $userhost, $nick, $clones; - set_context $oldctxt; - }; + } } - } + }; return EAT_NONE; }; @@ -248,8 +246,8 @@ hook_server 'QUIT', sub { get_list 'channels'; if (nickcmp get_info('nick'), $nick) { - my $oldctxt = get_context; - my $host = host $userhost; + my $guard = save_context; + my $host = host $userhost; for (@chans) { my $clones = remove $nick, $host, $serv, $_->[0]; if ($clones > 0) { @@ -257,7 +255,6 @@ hook_server 'QUIT', sub { print $ph clone_leave_str $userhost, $nick, $clones; } } - set_context $oldctxt; } else { flush $serv, $_->[0] for @chans; } diff --git a/net.pl b/net.pl index 13d73ed..80535e1 100755 --- a/net.pl +++ b/net.pl @@ -10,7 +10,8 @@ use Xchat qw<:all>; use lib get_info 'xchatdir'; use Xchat::XPI; -use Xchat::XPI::Net qw; +use Xchat::XPI::Net qw; +use Xchat::XPI::Utils qw; our $VERSION = '0.02'; @@ -59,7 +60,7 @@ hook_command 'DIG', sub { sub dig_print { my $p = $_[0]; my ($context, $req) = @{$_[1]}; - my $oldctxt = get_context; + my $guard = save_context; set_context $context; if ($p) { my @a = $p->answer; @@ -78,7 +79,6 @@ sub dig_print { } else { print $ph 'Request ' . $req->{host} . " timed out\n"; } - set_context $oldctxt; } hook_command 'NETWHOIS', sub { @@ -99,7 +99,7 @@ hook_command 'NETWHOIS', sub { sub netwhois_print { my $raw = $_[0]; my ($context, $req) = @{$_[1]}; - my $oldctxt = get_context; + my $guard = save_context; set_context $context; if ($raw) { $raw =~ s/.*(Domain|inetnum)/$1/s; @@ -112,7 +112,6 @@ sub netwhois_print { } else { output '*', 'No results for ' . $req->{host}; } - set_context $oldctxt; } hook_command 'TLD', sub { diff --git a/opers.pl b/opers.pl index 87a01c4..66c9c0b 100755 --- a/opers.pl +++ b/opers.pl @@ -7,6 +7,7 @@ use Xchat qw<:all>; use lib get_info 'xchatdir'; use Xchat::XPI; +use Xchat::XPI::Utils qw; our $VERSION = '0.03'; @@ -27,7 +28,7 @@ hook_server '352', sub { push @{$chans{$_->{type}}}, $_ for grep $_->{server} eq $serv, get_list 'channels'; - my $oldctxt = get_context; + my $guard = save_context; my $onachan; for (@{$chans{2}}) { @@ -45,8 +46,6 @@ hook_server '352', sub { print_op $nick, $host; } - set_context $oldctxt; - return EAT_NONE; }; diff --git a/services.pl b/services.pl index f04a80e..e9f13d6 100755 --- a/services.pl +++ b/services.pl @@ -7,6 +7,7 @@ use Xchat qw<:all>; use lib get_info 'xchatdir'; use Xchat::XPI; +use Xchat::XPI::Utils qw; our $VERSION = '0.03'; @@ -32,15 +33,14 @@ hook_command 'ID', sub { hook_command 'AID', sub { my $forcepasswd = $_[0][1]; - my $oldctxt = get_context; - my @contexts = get_servers_ctxt; + my @contexts = get_servers_ctxt; + my $guard = save_context; for (@contexts) { set_context $_; my $passwd = $forcepasswd || get_info 'nickserv'; next unless $passwd; command 'ID ' . $passwd; } - set_context $oldctxt; return EAT_ALL; }, { help_text => 'AID [password], identify you on all servers' @@ -63,8 +63,8 @@ hook_command 'AGHOST', sub { my $target = $_[0][1] || get_prefs 'irc_nick1'; return EAT_ALL unless $target; my $forcepasswd = $_[0][2]; - my $oldctxt = get_context; - my @contexts = get_servers_ctxt; + my @contexts = get_servers_ctxt; + my $guard = save_context; for (@contexts) { set_context $_; my $passwd = $forcepasswd || get_info 'nickserv'; @@ -73,7 +73,6 @@ hook_command 'AGHOST', sub { command join ' ', 'GHOST', $target, $passwd; } } - set_context $oldctxt; return EAT_ALL; }, { help_text => 'AGHOST [nick] [password], kill usurping clients on all servers' diff --git a/tools.pl b/tools.pl index b06f166..f7e5c4e 100755 --- a/tools.pl +++ b/tools.pl @@ -10,6 +10,7 @@ use Xchat qw<:all>; use lib get_info 'xchatdir'; use Xchat::XPI; +use Xchat::XPI::Utils qw; use constant MAX_MATCHES => 10; @@ -23,12 +24,11 @@ BEGIN { } hook_command 'TC', sub { - my $oldctxt = get_context; + my $guard = save_context; for (get_list 'channels') { set_context $_->{context}; command 'GUI COLOR 0'; } - set_context $oldctxt; return EAT_ALL; }, { help_text => 'TC, reset all tab color indicators'