diff options
Diffstat (limited to '')
| -rw-r--r-- | feature-tests/augment_inputline.pl | 9 | ||||
| -rw-r--r-- | feature-tests/bindings.pl | 114 | ||||
| -rw-r--r-- | feature-tests/easy_exec.pl | 59 | ||||
| -rw-r--r-- | feature-tests/exec.pl | 442 | ||||
| -rw-r--r-- | feature-tests/format-test.pl | 23 | ||||
| -rw-r--r-- | feature-tests/key_sig.pl | 51 | ||||
| -rw-r--r-- | feature-tests/local_input_capture.pl | 50 | ||||
| -rw-r--r-- | feature-tests/pipes.pl | 87 | ||||
| -rw-r--r-- | feature-tests/redir-input.pl | 9 | ||||
| -rw-r--r-- | feature-tests/sig_unbind.pl | 58 | ||||
| -rw-r--r-- | feature-tests/signal_logger.pl | 170 | ||||
| -rw-r--r-- | feature-tests/signal_redir.pl | 116 | ||||
| -rw-r--r-- | feature-tests/template.pl | 56 |
13 files changed, 1206 insertions, 38 deletions
diff --git a/feature-tests/augment_inputline.pl b/feature-tests/augment_inputline.pl index 577f756..97a129e 100644 --- a/feature-tests/augment_inputline.pl +++ b/feature-tests/augment_inputline.pl @@ -1,3 +1,12 @@ +=pod + +=head1 NAME + +test + +=cut + + use strict; use Irssi; use Irssi::TextUI; # for sbar_items_redraw diff --git a/feature-tests/bindings.pl b/feature-tests/bindings.pl new file mode 100644 index 0000000..ece220d --- /dev/null +++ b/feature-tests/bindings.pl @@ -0,0 +1,114 @@ +use strict; +use warnings; + + +use Irssi; +use Irssi::Irc; +use Irssi::TextUI; + +use Data::Dumper; + + +our $VERSION = '0.1'; +our %IRSSI = ( + authors => 'shabble', + contact => 'shabble+irssi@metavore.org', + name => '', + description => '', + licence => q(GNU GPLv2 or later), + + ); + +# code taken from adv_windowlist + +my $keymap; + +sub STATE_HEADER () { 0 } +sub STATE_BODY () { 1 } +sub STATE_END () { 2 } +my $parse_state = STATE_HEADER; + +my $binding_formats = {}; + +init(); + +sub init { + + $keymap = {}; + + Irssi::command_bind('showbinds', 'cmd_showbinds'); + Irssi::signal_add('command bind' => 'watch_keymap'); + + $binding_formats = get_binding_formats(); + + capture_bind_data(); +} + +sub get_binding_formats { + my $theme = Irssi::current_theme(); + my @keys = qw/bind_header bind_list bind_command_list + bind_footer bind_unknown_id/; + + my $ret = {}; + foreach my $key (@keys) { + my $tmp = $theme->get_format('fe-common/core', $key); + #$tmp =~ s/%/%%/g; # escape colour codes? + $ret->{$key} = $tmp; + } + return $ret; +} + +sub cmd_showbinds { + my ($args, @rest) = @_; + + my $win = Irssi::active_win(); + $win->print("Change window bindings:", Irssi::MSGLEVEL_CLIENTCRAP); + for my $w (sort keys %$keymap) { + my $x = $keymap->{$w}; + $win->print("$w ==> $x", Irssi::MSGLEVEL_CLIENTCRAP); + } + $win->print("Done showing window bindings:", Irssi::MSGLEVEL_CLIENTCRAP); + +} + +sub sig_print_text { + my ($text_dest, $str, $str_stripped) = @_; + + return unless $text_dest->{level} == Irssi::MSGLEVEL_CLIENTCRAP; + return unless $text_dest->{target} eq ''; + return unless not defined $text_dest->{server}; + + # if ($parse_state = STATE_HEADER) { + # if ($str =~ m/\Q$binding_formats->{bind_header}\E/) { + # $parse_state = STATE_BODY; + # } + # } elsif ($parse_state = STATE_BODY) { + print "Data is: $str_stripped"; + if ($str_stripped =~ m/^.*?(\S{,20})\s+(\S+)\s+(\S+)/) { + $keymap->{$1} = "$2, $3"; + print "Parsed $1 as $2, $3"; + } + Irssi::signal_stop(); + # } elsif ($str =~ m/$binding_formats->{bind_footer}\E/) { + # $parse_state = STATE_END; + # } + # } +} + + +sub capture_bind_data { + Irssi::signal_remove('command bind' => 'watch_keymap'); + Irssi::signal_add_first('print text' => 'sig_print_text'); + Irssi::command('bind'); # stolen from grep + Irssi::signal_remove('print text' => 'sig_print_text'); + +} + + +# watch keymap changes +sub watch_keymap { + Irssi::timeout_add_once(1000, 'capture_bind_data', undef); +} + + + diff --git a/feature-tests/easy_exec.pl b/feature-tests/easy_exec.pl index 669a00b..d342516 100644 --- a/feature-tests/easy_exec.pl +++ b/feature-tests/easy_exec.pl @@ -2,7 +2,7 @@ use strict; use warnings; # export everything. -use Irssi; #(@Irssi::EXPORT_OK); +use Irssi; use Irssi::Irc; use Irssi::TextUI; @@ -18,33 +18,38 @@ our %IRSSI = ( license => 'Public Domain', ); -#Irssi::signal_add_first 'command script exec', \&better_exec; -Irssi::command_bind('script exec', \&better_exec); - -sub better_exec { - my ($args, $serv, $witem) = @_; - # todo: handle permanent arg? - my $perm = 0; - print "Args: $args"; - if ($args =~ s/^\s*-permanent\s*(.*)$/$1/) { - $perm = 1; - } - print "Args now: $args"; - -# eval $args; - my $str = "//script exec " . - ($perm ? '-permanent' : '') - . 'use Irssi (@Irssi::EXPORT_OK); ' . $args; - print "Running: $str"; - -# Irssi::command($str); - Irssi::signal_continue($str, @_[1..$#_]); -} +# TODO: make this more tab-complete friendly +init(); + +sub init { + Irssi::command('/alias se script exec use Data::Dumper\;' + .' use Irssi (@Irssi::EXPORT_OK)\; $0-'); + Irssi::command('/alias sep script exec -permanent ' + . 'use Data::Dumper\; use Irssi (@Irssi::EXPORT_OK)\; $0-'); -sub Dump { - print Dumper(\@_); + Irssi::signal_add_last ('complete word', 'sig_complete_word'); } -sub test() { - print "This is a test"; +sub sig_complete_word { + my ($strings, $window, $word, $linestart, $want_space) = @_; + # only provide these completions if the input line is otherwise empty. + my $cmdchars = Irssi::settings_get_str('cmdchars'); + my $quoted = quotemeta($cmdchars); + #print "Linestart: $linestart"; + return unless ($linestart =~ /^${quoted}(?:se|sep)/); + + my $clean_word = $word; + $clean_word =~ s/^"//g; + $clean_word =~ s/"$//g; + $clean_word =~ s/->$//g; + + + + my @expansions = @Irssi::EXPORT_OK; + push @$strings, grep { $_ =~ m/^\Q$clean_word\E/ } @expansions; + print "Sebug: " . join(", ", @$strings); + $$want_space = 0; + + + Irssi::signal_stop() if (@$strings); } diff --git a/feature-tests/exec.pl b/feature-tests/exec.pl new file mode 100644 index 0000000..f6d6377 --- /dev/null +++ b/feature-tests/exec.pl @@ -0,0 +1,442 @@ +# exec.pl +# a (currently stupid) alternative to the built-in /exec, because it's broken +# on OSX. This thing stll needs a whole bunch of actual features, but for now, +# you can actually run commands. + +# Obviously, that's pretty dangerous. Use at your own risk. + +# EXEC [-] [-nosh] [-out | -msg <target> | -notice <target>] [-name <name>] <cmd line> +# EXEC -out | -window | -msg <target> | -notice <target> | -close | -<signal> %<id> +# EXEC -in %<id> <text to send to process> +# +# -: Don't print "process terminated ..." message +# +# -nosh: Don't start command through /bin/sh +# +# -out: Send output to active channel/query +# +# -msg: Send output to specified nick/channel +# +# -notice: Send output to specified nick/channel as notices +# +# -name: Name the process so it could be accessed easier +# +# -window: Move the output of specified process to active window +# +# -close: Forcibly close (or "forget") a process that doesn't die. +# This only removes all information from irssi concerning the +# process, it doesn't send SIGKILL or any other signal +# to the process. +# +# -<signal>: Send a signal to process. <signal> can be either numeric +# or one of the few most common ones (hup, term, kill, ...) +# +# -in: Send text to standard input of the specified process +# +# -interactive: Creates a query-like window item. Text written to it is +# sent to executed process, like /EXEC -in. +# +# Execute specified command in background. Output of process is printed to +# active window by default, but can be also sent as messages or notices to +# specified nick or channel. +# +# Processes can be accessed either by their ID or name if you named it. Process +# identifier must always begin with '%' character, like %0 or %name. +# +# Once the process is started, its output can still be redirected elsewhere with +# the -window, -msg, etc. options. You can send text to standard input of the +# process with -in option. +# +# -close option shouldn't probably be used if there's a better way to kill the +# process. It is meant to remove the processes that don't die even with +# SIGKILL. This option just closes the pipes used to communicate with the +# process and frees all memory it used. +# +# EXEC without any arguments displays the list of started processes. +# + + + +use 5.010; # 5.10 or above, necessary to get the return value from a command. + +use strict; +use warnings; +use English '-no_match_vars'; + +use Irssi; +use POSIX; +use Time::HiRes qw/sleep/; +use IO::Handle; +use IO::Pipe; +use IPC::Open3; +use Symbol 'geniosym'; + +use Data::Dumper; + +our $VERSION = '0.1'; +our %IRSSI = ( + authors => 'shabble', + contact => 'shabble+irssi@metavore.org', + name => 'exec.pl', + description => '', + license => 'Public Domain', + ); + +my @processes = (); +sub get_processes { return @processes } + +# the /exec command, nothing to do with the actual command being run. +my $command; +my $command_options; + +sub get_new_id { + my $i = 1; + foreach my $proc (@processes) { + if ($proc->{id} != $i) { + next; + } + $i++; + } + return $i; +} + +sub add_process { + #my ($pid) = @_; + my $id = get_new_id(); + + my $new = { + id => $id, + pid => 0, + in_tag => 0, + out_tag => 0, + err_tag => 0, + s_in => geniosym(), #IO::Handle->new, + s_err => geniosym(), #IO::Handle->new, + s_out => geniosym(), #IO::Handle->new, + cmd => '', + opts => {}, + }; + + # $new->{s_in}->autoflush(1); + # $new->{s_out}->autoflush(1); + # $new->{s_err}->autoflush(1); + + push @processes, $new; + + _msg("New process item created: $id"); + return $new; +} + +sub find_process_by_id { + my ($id) = @_; + my @matches = grep { $_->{id} == $id } @processes; + _error("wtf, multiple id matches for $id. BUG") if @matches > 1; + + return $matches[0]; + +} +sub find_process_by_pid { + my ($pid) = @_; + my @matches = grep { $_->{pid} == $pid } @processes; + _error("wtf, multiple pid matches for $pid. BUG") if @matches > 1; + + return $matches[0]; +} + +sub remove_process { + my ($id, $verbose) = @_; + my $del_index = 0; + foreach my $proc (@processes) { + if ($id == $proc->{id}) { + last; + } + $del_index++; + } + print "remove: del index: $del_index"; + if ($del_index <= $#processes) { + my $dead = splice(@processes, $del_index, 1, ()); + #_msg("removing " . Dumper($dead)); + + Irssi::input_remove($dead->{err_tag}); + Irssi::input_remove($dead->{out_tag}); + + close $dead->{s_out}; + close $dead->{s_in}; + close $dead->{s_err}; + + } else { + $verbose = 1; + if ($verbose) { + print "remove: No such process with ID $id"; + } + } +} + +sub show_current_processes { + if (@processes == 0) { + print "No processes running"; + return; + } + foreach my $p (@processes) { + printf("ID: %d, PID: %d, Command: %s", $p->{id}, $p->{pid}, $p->{cmd}); + } +} + +sub parse_options { + my ($args) = @_; + my @options = Irssi::command_parse_options($command, $args); + if (@options) { + my $opt_hash = $options[0]; + my $rest = $options[1]; + + $rest =~ s/^\s*(.*?)\s*$/$1/; # trim surrounding space. + + #print Dumper([$opt_hash, $rest]); + if (length $rest) { + return ($opt_hash, $rest); + } else { + show_current_processes(); + return (); + } + } else { + _error("Error parsing $command options"); + return (); + } +} + +sub schedule_cleanup { + my $fd = shift; + Irssi::timeout_add_once(100, sub { $_[0]->close }, $fd); +} + +sub do_fork_and_exec { + my ($rec) = @_; + + #Irssi::timeout_add_once(100, sub { die }, {}); + + return unless exists $rec->{cmd}; + drop_privs(); + + _msg("Executing command " . join(", ", @{ $rec->{cmd} })); + my $c = join(" ", @{ $rec->{cmd} }); + my $pid = open3($rec->{s_sin}, $rec->{s_out}, $rec->{s_err}, $c); + + _msg("PID is $pid"); + $rec->{pid} = $pid; + + # _msg("Pid %s, in: %s, out: %s, err: %s, cmd: %s", + # $pid, $sin, $sout, $serr, $cmd); + + # _msg("filenos, Pid %s, in: %s, out: %s, err: %s", + # $pid, $sin->fileno, $sout->fileno, $serr->fileno); + + if (not defined $pid) { + + _error("open3 failed: $! Aborting"); + + close($_) for ($rec->{s_in}, $rec->{s_err}, $rec->{s_out}); + undef($_) for ($rec->{s_in}, $rec->{s_err}, $rec->{s_out}); + + return; + } + + # parent + if ($pid) { + +# eval { + print "fileno is " . fileno($rec->{s_out}); + $rec->{out_tag} = Irssi::input_add( fileno($rec->{s_out}), + Irssi::INPUT_READ, + \&child_output, + $rec); + #die unless $rec->{out_tag}; + + $rec->{err_tag} = Irssi::input_add(fileno($rec->{s_err}), + Irssi::INPUT_READ, + \&child_error, + $rec); + #die unless $rec->{err_tag}; + + # }; + + + Irssi::pidwait_add($pid); + die "input_add failed to initialise: $@" if $@; + } +} + +sub drop_privs { + my @temp = ($EUID, $EGID); + my $orig_uid = $UID; + my $orig_gid = $GID; + $EUID = $UID; + $EGID = $GID; + # Drop privileges + $UID = $orig_uid; + $GID = $orig_gid; + # Make sure privs are really gone + ($EUID, $EGID) = @temp; + die "Can't drop privileges" + unless $UID == $EUID && $GID eq $EGID; +} + +sub child_error { + my $rec = shift; + + my $err_fh = $rec->{s_err}; + + my $done = 0; + + while (not $done) { + my $data = ''; + _msg("Stderr: starting sysread"); + my $bytes_read = sysread($err_fh, $data, 256); + if (not defined $bytes_read) { + _error("stderr: sysread failed:: $!"); + $done = 1; + } elsif ($bytes_read == 0) { + _msg("stderr: sysread got EOF"); + $done = 1; + } elsif ($bytes_read < 256) { + # that's all, folks. + _msg("%%_stderr:%%_ read %d bytes: %s", $bytes_read, $data); + } else { + # we maybe need to read some more + _msg("%%_stderr:%%_ read %d bytes: %s, maybe more", $bytes_read, $data); + } + } + + _msg('removing input stderr tag'); + Irssi::input_remove($rec->{err_tag}); + +} + +sub sig_pidwait { + my ($pidwait, $status) = @_; + my @matches = grep { $_->{pid} == $pidwait } @processes; + foreach my $m (@matches) { + _msg("PID %d has terminated. Status %d (or maybe %d .... %d)", + $pidwait, $status, $?, ${^CHILD_ERROR_NATIVE} ); + + remove_process($m->{id}); + } +} + +sub child_output { + my $rec = shift; + my $out_fh = $rec->{s_out}; + + my $done = 0; + + while (not $done) { + my $data = ''; + _msg("Stdout: starting sysread"); + my $bytes_read = sysread($out_fh, $data, 256); + if (not defined $bytes_read) { + _error("stdout: sysread failed:: $!"); + $done = 1; + } elsif ($bytes_read == 0) { + _msg("stdout: sysread got EOF"); + $done = 1; + } elsif ($bytes_read < 256) { + # that's all, folks. + _msg("%%_stdout:%%_ read %d bytes: %s", $bytes_read, $data); + } else { + # we maybe need to read some more + _msg("%%_stdout:%%_ read %d bytes: %s, maybe more", $bytes_read, $data); + } + } + + _msg('removing input stdout tag'); + Irssi::input_remove($rec->{out_tag}); + + #schedule_cleanup($stdout_reader); + #$stdout_reader->close; +} + +sub _error { + my ($msg, @params) = @_; + my $win = Irssi::active_win(); + my $str = sprintf($msg, @params); + $win->print($str, Irssi::MSGLEVEL_CLIENTERROR); +} + +sub _msg { + my ($msg, @params) = @_; + my $win = Irssi::active_win(); + my $str = sprintf($msg, @params); + $win->print($str, Irssi::MSGLEVEL_CLIENTCRAP); +} + +sub cmd_exec { + + my ($args, $server, $witem) = @_; + Irssi::signal_stop; + my @options = parse_options($args); + + if (@options) { + my $rec = add_process(); + my ($options, $cmd) = @options; + + $cmd = [split ' ', $cmd]; + + if (not exists $options->{nosh}) { + unshift @$cmd, ("/bin/sh -c"); + } + + $rec->{opts} = $options; + $rec->{cmd} = $cmd; + + do_fork_and_exec($rec) + } + +} + +sub cmd_input { + my ($args) = @_; + my $rec = $processes[0]; # HACK, make them specify. + if ($rec->{pid}) { + print "INput writing to $rec->{pid}"; + my $fh = $rec->{s_in}; + + my $ret = syswrite($fh, "$args\n"); + if (not defined $ret) { + print "Error writing to process $rec->{pid}: $!"; + } else { + print "Wrote $ret bytes to $rec->{pid}"; + } + + } else { + _error("no execs are running to accept input"); + } +} + +sub exec_init { + $command = "exec"; + $command_options = join ' ', + ( + '!-', 'interactive', 'nosh', '+name', '+msg', + '+notice', 'window', 'close', '+level', 'quiet' + ); + + Irssi::command_bind($command, \&cmd_exec); + Irssi::command_set_options($command, $command_options); + Irssi::command_bind('input', \&cmd_input); + + Irssi::signal_add('pidwait', \&sig_pidwait); +} + + exec_init(); + +package Irssi::UI; + +{ + no warnings 'redefine'; + + sub processes() { + return Irssi::Script::exec::get_processes(); + } + +} + +1; diff --git a/feature-tests/format-test.pl b/feature-tests/format-test.pl index d8be412..7a38d9f 100644 --- a/feature-tests/format-test.pl +++ b/feature-tests/format-test.pl @@ -3,7 +3,7 @@ use warnings; use Irssi; - +use Data::Dumper; our $VERSION = '0.1'; our %IRSSI = ( @@ -14,13 +14,26 @@ our %IRSSI = ( license => 'Public Domain', ); +sub actually_printformat { + my ($win, $level, $module, $format, @args) = @_; + my $ret = ''; + { + # deeeeeeep black magic. + local *CORE::GLOBAL::caller = sub { $module }; + $win->printformat($level, $format, @args); + + $ret = Irssi::current_theme()->get_format($module, $format); + } + return $ret; +} + init(); sub init { - Irssi::command_bind('ft', \&format_test); -} + my $win = Irssi::active_win(); + my $moo = actually_printformat($win, Irssi::MSGLEVEL_CLIENTCRAP, 'fe-common/irc', + "kill_server", "foo", "bar", "horse", "cake"); + print Dumper($moo); -sub format_test { - my ($args, $win, $server) = @_; } diff --git a/feature-tests/key_sig.pl b/feature-tests/key_sig.pl new file mode 100644 index 0000000..ef69d45 --- /dev/null +++ b/feature-tests/key_sig.pl @@ -0,0 +1,51 @@ +use strict; +use warnings 'all'; + +use Irssi; +use Irssi::Irc; +use Irssi::TextUI; + +use Data::Dumper; + + +our $VERSION = '0.1'; +our %IRSSI = ( + authors => 'shabble', + contact => 'shabble+irssi@metavore.org', + name => '', + description => '', + license => 'Public Domain', + ); + +my $bacon = 10; + +Irssi::signal_register({'key created' => [qw/Irssi::UI::Key/ ] }); + +Irssi::signal_add('key created', \&sig_key_created); +Irssi::signal_register({'key command' => [qw/string/]}); +Irssi::signal_add_first('key command' => \&sig_key_cmd); + +Irssi::signal_register({'key nothing' => [qw/string/]}); +Irssi::signal_add_first('key nothing' => \&sig_key_cmd); + +Irssi::signal_register({'keyboard created' => [qw/Irssi::UI::Keyboard/]}); +Irssi::signal_add_first('keyboard created' => \&sig_keyboard); + +sub sig_keyboard { + my ($data) = @_; + print "keyboard: " . Dumper($data); +} + +sub sig_key_cmd { + my ($data) = @_; + print "key cmd: " . Dumper($data); + +} + +sub sig_key_created { + my @args = @_; + + print "Key Created, Args: " . Dumper(\@args); +} + +Irssi::command("bind meta-q /echo moo"); diff --git a/feature-tests/local_input_capture.pl b/feature-tests/local_input_capture.pl new file mode 100644 index 0000000..847ff07 --- /dev/null +++ b/feature-tests/local_input_capture.pl @@ -0,0 +1,50 @@ +use strict; +use warnings; + + +use Irssi; +use Irssi::Irc; +use Irssi::TextUI; + +use Data::Dumper; + + +our $VERSION = '0.1'; +our %IRSSI = ( + authors => 'shabble', + contact => 'shabble+irssi@metavore.org', + name => '', + description => '', + license => 'Public Domain', + ); + +my $buffer = ''; +init(); + +sub init { + + Irssi::signal_add_first 'print text', 'sig_print_text'; + Irssi::command 'echo Hello there'; + Irssi::signal_remove 'print text', 'sig_print_text'; + Irssi::command_bind 'showbuf', 'cmd_showbuf'; +} + +sub cmd_showbuf { + my ($args, $server, $win_item) = @_; + my $win; + if (defined $win_item) { + $win = $win_item->window(); + } else { + $win = Irssi::active_win(); + } + + $win->print("buffer is: $buffer"); + $buffer = ''; +} + +sub sig_print_text { + my ($text_dest, $str, $stripped_str) = @_; + + $buffer .= $stripped_str; + Irssi::signal_stop; +} diff --git a/feature-tests/pipes.pl b/feature-tests/pipes.pl new file mode 100644 index 0000000..50bff53 --- /dev/null +++ b/feature-tests/pipes.pl @@ -0,0 +1,87 @@ +use strict; +use warnings; + +use Irssi; +use POSIX; +use Time::HiRes qw/sleep/; + +my $forked = 0; + +sub pipe_and_fork { + my ($read_handle, $write_handle); + + pipe($read_handle, $write_handle); + + my $oldfh = select($write_handle); + $| = 1; + select $oldfh; + + return if $forked; + + my $pid = fork(); + + if (not defined $pid) { + _error("Can't fork: Aborting"); + close($read_handle); + close($write_handle); + return; + } + + $forked = 1; + + if ($pid > 0) { # this is the parent (Irssi) + close ($write_handle); + Irssi::pidwait_add($pid); + my $job = $pid; + my $tag; + my @args = ($read_handle, \$tag, $job); + $tag = Irssi::input_add(fileno($read_handle), + Irssi::INPUT_READ, + \&child_input, + \@args); + + } else { # child + # make up some data - block if we like. + for (1..10) { + sleep rand 1; + print $write_handle "Some data: $_\n"; + } + print $write_handle "__DONE__\n"; + close $write_handle; + + POSIX::_exit(1); + } +} + +sub child_input { + my $args = shift; + my ($read_handle, $input_tag_ref, $job) = @$args; + + my $data = <$read_handle>; + + if ($data =~ m/__DONE__/) { + close($read_handle); + Irssi::input_remove($$input_tag_ref); + _msg("child finished"); + + $forked = 0; + + } else { + _msg("Received from child: $data"); + } + +} + +sub _error { + my ($msg) = @_; + my $win = Irssi::active_win(); + $win->print($msg, Irssi::MSGLEVEL_CLIENTERROR); +} + +sub _msg { + my ($msg) = @_; + my $win = Irssi::active_win(); + $win->print($msg, Irssi::MSGLEVEL_CLIENTCRAP); +} + +Irssi::command_bind("start_pipes", \&pipe_and_fork); diff --git a/feature-tests/redir-input.pl b/feature-tests/redir-input.pl index 94ca523..ed77d3c 100644 --- a/feature-tests/redir-input.pl +++ b/feature-tests/redir-input.pl @@ -20,11 +20,14 @@ our %IRSSI = ( Irssi::command_bind("ri", \&cmd_ri); - +Irssi::signal_register({ 'gui entry redirect' => [ qw/string string intptr intptr/]}); sub cmd_ri { my ($args, $server, $witem) = @_; my $win = Irssi::active_win(); - + my ($x, $y) = (0, 0); + Irssi::signal_emit('gui entry redirect', 'sub_blah', "bacon", $x, $y); #my $ref = Irssi::windows_refnum_last - $win->format_create_dest(Irssi::MSGLEVEL_ClIENTCRAP()); +# $win->format_create_dest(Irssi::MSGLEVEL_ClIENTCRAP()); } + +sub sub_blah { print "Moo" } diff --git a/feature-tests/sig_unbind.pl b/feature-tests/sig_unbind.pl new file mode 100644 index 0000000..3123182 --- /dev/null +++ b/feature-tests/sig_unbind.pl @@ -0,0 +1,58 @@ +use strict; +use warnings; + + +use Irssi (@Irssi::EXPORT_OK); +use Irssi::Irc; +use Irssi::TextUI; + +use Data::Dumper; + + +our $VERSION = '0.1'; +our %IRSSI = ( + authors => 'shabble', + contact => 'shabble+irssi@metavore.org', + name => '', + description => '', + license => 'Public Domain', + ); + +command_bind("dosig_r", + sub { + my $ref = \&cmd_oink; + _print("binding oink to $ref"); + signal_add("command oink", $ref); + }); + +command_bind("undosig_r", + sub { + my $ref = \&cmd_oink; + + _print("unbinding oink from $ref"); + + signal_remove("command oink", $ref); + }); + +command_bind("dosig_s", + sub { + signal_add("command oink", 'cmd_oink'); + }); + +command_bind("undosig_s", + sub { + signal_remove("command oink", 'cmd_oink'); + }); + +sub cmd_oink { + Irssi::active_win()->print("Oink:"); +} + +sub _print { + Irssi::active_win()->print($_[0]); +} + +command("dosig_r"); +command("oink"); +command("undosig_r"); +command("oink"); diff --git a/feature-tests/signal_logger.pl b/feature-tests/signal_logger.pl new file mode 100644 index 0000000..3b3b9ad --- /dev/null +++ b/feature-tests/signal_logger.pl @@ -0,0 +1,170 @@ +use strict; +use warnings; + + +use Irssi; +use Irssi::Irc; +use Irssi::TextUI; +use Time::HiRes qw/time/; + +use Data::Dumper; + + +our $VERSION = '0.1'; +our %IRSSI = ( + authors => 'shabble', + contact => 'shabble+irssi@metavore.org', + name => '', + description => '', + license => 'Public Domain', + ); + +my $enabled = 0; +my $depth = 0; +my $handlers = { }; +my @log = (); +my @signals = +( +'send text', +'send command', +#'print text', +#'gui print text', +'beep', +#'complete word', +#'gui key pressed', +'window changed', + "server add fill", + "server connect copy", + "server connect failed", + "server connected", + "server connecting", + "server disconnected", + "server event", + "server incoming", + "server lag disconnect", + "server lag", + "server looking", + "server nick changed", + "server quit", + "server reconnect not found", + "server reconnect remove", + "server reconnect save status", + "server sendmsg", + "server setup fill chatnet", + "server setup fill connect", + "server setup fill reconn", + "server setup read", + "server setup saved", + "default event", +#'gui print text finished', + +); + +init(); + +sub init { + + @log = (); + $handlers = {}; + + Irssi::command_bind('siglog_on', \&cmd_register_all_signals); + Irssi::command_bind('siglog_off', \&cmd_unregister_all_signals); + Irssi::command_bind('siglog_dump', \&cmd_log_dump); + Irssi::command_bind('siglog_stats', \&cmd_log_stats); +} + +sub cmd_register_all_signals { + + + Irssi::active_win->print("Starting to log all signals"); + $enabled = 1; + + foreach my $sig_name (@signals) { + + my $first_func = build_init_func($sig_name); + my $last_func = build_end_func($sig_name); + + $handlers->{$sig_name} = [ $first_func, $last_func ]; + + Irssi::signal_add_first($sig_name, $first_func); + Irssi::signal_add_last($sig_name, $last_func); + } +} + +sub cmd_unregister_all_signals { + + foreach my $sig_name (@signals) { + + my ($first_func, $last_func) = @{ $handlers->{$sig_name} }; + + Irssi::signal_remove($sig_name, $first_func); + Irssi::signal_remove($sig_name, $last_func); + } + $enabled = 0; + Irssi::active_win->print("Signal logging disabled"); + +} + +sub cmd_log_dump { + + my $win = Irssi::active_win(); + if ($enabled) { + cmd_unregister_all_signals(); + $win->print("Disabled logging"); + } + foreach my $lref (@log) { + my ($line, $indent) = @$lref; + my $xx = " " x $indent; + $win->print($xx . $line); + } +} + +sub cmd_log_stats { + + my $win = Irssi::active_win(); + if ($enabled) { + cmd_unregister_all_signals(); + $win->print("Disabled logging"); + } +} + +sub build_init_func { + my ($sig_name) = @_; + + return sub { + my @args = @_; + my $args_str = ''; + my $n = 0; + + foreach my $arg (@args) { + $args_str .= "[$n] "; + + if (not defined $arg) { + $args_str .= "undef, "; + next; + } + + if (ref $arg) { + $args_str .= ref($arg) . ", " + } else { + $arg =~ s/^(.{20})/$1/; + $args_str .= "$arg, "; + } + $n++; + } + my $msg = sprintf("%f: %s - First %s", time(), $sig_name, $args_str); + push @log, [$msg, $depth]; + $depth++; + } +} + +sub build_end_func { + my ($sig_name) = @_; + + return sub { + my $msg = sprintf("%f: %s - End", time(), $sig_name); + push @log, [$msg, $depth]; + $depth--; + } +} + diff --git a/feature-tests/signal_redir.pl b/feature-tests/signal_redir.pl new file mode 100644 index 0000000..89da34c --- /dev/null +++ b/feature-tests/signal_redir.pl @@ -0,0 +1,116 @@ +# mangled from cmpusers.pl (unpublished, afaik) by Bazerka <bazerka@quakenet.org>. +# He is not to blame for any problems, contact me instead. + +use strict; +use warnings; + +use Irssi; + +our $VERSION = "0.1"; +our %IRSSI = + ( + authors => "shabble, Bazerka", + contact => 'shabble+irssi@metavore.org, shabble@#irssi/Freenode,' + . 'bazerka@quakenet.org', + name => "signal_redir", + description => "Demonstration showing how to redirect a remote WHOIS" + . "command so the results can be captured by a script.", + license => "BSD", + url => "https://github.com/shabble/irssi-scripts/", + changed => "Fri Apr 1 00:05:39 2011" + ); + +my $running = 0; # flag to prevent overlapping requests. +my $debug = 1; +sub redir_init { + # set up event to handler mappings + Irssi::signal_add + ({ + 'redir test_redir_whois_user' => 'event_whois_user', + 'redir test_redir_whois_channels' => 'event_whois_channels', + 'redir test_redir_whois_end' => 'event_whois_end', + 'redir test_redir_whois_nosuchnick' => 'event_whois_nosuchnick', + 'redir test_redir_whois_timeout' => 'event_whois_timeout', + }); +} + +sub request_whois { + my ($server, $nick) = @_; + + $server->redirect_event + ( + 'whois', 1, $nick, 0, # command, remote, arg, timeout + 'redir test_redir_whois_timeout', # error handler + { + 'event 311' => 'redir test_redir_whois_user', # event mappings + 'event 318' => 'redir test_redir_whois_end', + 'event 319' => 'redir test_redir_whois_channels', + 'event 401' => 'redir test_redir_whois_nosuchnick', + '' => 'event empty', + } + ); + Irssi::print("Sending Command: WHOIS $nick", MSGLEVEL_CLIENTCRAP) if $debug; + # send the actual command directly to the server, rather than + # with $server->command() + $server->send_raw("WHOIS $nick"); +} + +sub event_whois_user { + my ($server, $data) = @_; + my ($nick, $user, $host) = ( split / +/, $data, 6 )[ 1, 2, 3 ]; + Irssi::print("test_redir whois_user: $nick!$user\@$host", MSGLEVEL_CLIENTCRAP); +} + +sub event_whois_channels { + my ($server, $data) = @_; + my ($nick, $channels) = ( split / +/, $data, 3 )[ 1, 2 ]; + my $prefix = 'cowu.be'; # server name + my $args = "shabble"; # match criteria + my $event = 'event 319'; # triggering event + my $sig = $server->redirect_get_signal($prefix, $event, $args); + Irssi::print("test_redir whois_channels: $nick, $channels", MSGLEVEL_CLIENTCRAP); + Irssi::print("test_redir get_signal: $sig", MSGLEVEL_CLIENTCRAP); + +} + +sub event_whois_end { + my ($server, $data) = @_; + my ($nick) = ( split / +/, $data, 3 )[1]; + Irssi::print("test_redir whois_end: $nick", MSGLEVEL_CLIENTCRAP); + + return if $running == 0; # catch 318 -> 401 (nosuchnick followed by endofwhois) + $running = 0; +} + +sub event_whois_nosuchnick { + my ($server, $data) = @_; + my $nick = ( split / +/, $data, 4)[1]; + Irssi::active_win->print("test_redir error: no such nick $nick - aborting.", + MSGLEVEL_CLIENTCRAP); + $running = 0; +} + +sub event_whois_timeout { + my ($server, $data) = @_; + Irssi::print("test_redir whois_timeout", MSGLEVEL_CLIENTCRAP); + $running = 0; +} + +sub cmd_test_redir { + my ($args, $server, $witem) = @_; + $args = lc $args; + my @nicks = split /\s+/, $args; + + if ($running) { + Irssi::active_win->print + ("test_redir error: a request is currently being processed " + . "- please try again shortly.", MSGLEVEL_CLIENTCRAP); + return; + } + $running = 1; + request_whois($server, $nicks[0]); +} + +redir_init(); +Irssi::command_bind("test_redir", \&cmd_test_redir); + diff --git a/feature-tests/template.pl b/feature-tests/template.pl index f3ae68a..a49d742 100644 --- a/feature-tests/template.pl +++ b/feature-tests/template.pl @@ -1,19 +1,69 @@ +=pod + +=head1 NAME + +template.pl + +=head1 DESCRIPTION + +A minimalist template useful for basing actual scripts on. + +=head1 INSTALLATION + +Copy into your F<~/.irssi/scripts/> directory and load with +C</SCRIPT LOAD F<filename>>. + +=head1 USAGE + +None, since it doesn't actually do anything. + +=head1 AUTHORS + +Copyright E<copy> 2011 Tom Feist C<E<lt>shabble+irssi@metavore.orgE<gt>> + +=head1 LICENCE + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. + +=head1 BUGS + +=head1 TODO + +Use this template to make an actual script. + +=cut + use strict; use warnings; - use Irssi; use Irssi::Irc; use Irssi::TextUI; use Data::Dumper; - our $VERSION = '0.1'; our %IRSSI = ( authors => 'shabble', contact => 'shabble+irssi@metavore.org', name => '', description => '', - license => 'Public Domain', + license => 'MIT', + updated => '$DATE' ); |