aboutsummaryrefslogtreecommitdiffstats
path: root/feature-tests
diff options
context:
space:
mode:
Diffstat (limited to 'feature-tests')
-rw-r--r--feature-tests/augment_inputline.pl9
-rw-r--r--feature-tests/bindings.pl114
-rw-r--r--feature-tests/colour_test.pl16
-rw-r--r--feature-tests/easy_exec.pl59
-rw-r--r--feature-tests/exec.pl442
-rw-r--r--feature-tests/format-test.pl23
-rw-r--r--feature-tests/getchan.pl165
-rw-r--r--feature-tests/key_sig.pl51
-rw-r--r--feature-tests/local_input_capture.pl50
-rw-r--r--feature-tests/pipes.pl87
-rw-r--r--feature-tests/redir-input.pl9
-rw-r--r--feature-tests/sig_unbind.pl58
-rw-r--r--feature-tests/signal_logger.pl170
-rw-r--r--feature-tests/signal_redir.pl116
-rw-r--r--feature-tests/template.pl56
15 files changed, 1387 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/colour_test.pl b/feature-tests/colour_test.pl
new file mode 100644
index 0000000..875b63c
--- /dev/null
+++ b/feature-tests/colour_test.pl
@@ -0,0 +1,16 @@
+use strict;
+use warnings;
+
+
+use Irssi;
+
+my @colors = (0..255);
+my @names = qw/black red green yellow blue magenta cyan white/;
+#my @bnames = map { "bold_$_" } @names;
+
+#@names = (@names, @bnames);
+
+foreach my $c (@colors) {
+ my $n = $names[$c] // $c;
+ Irssi::print("\%$c This is bg color $n\%n");
+}
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/getchan.pl b/feature-tests/getchan.pl
new file mode 100644
index 0000000..7d4ee55
--- /dev/null
+++ b/feature-tests/getchan.pl
@@ -0,0 +1,165 @@
+=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 => 'MIT',
+ updated => '$DATE'
+ );
+
+
+my $line_format;
+my $head_format;
+my $foot_format;
+
+my $channels = {};
+my @errors;
+my $state;
+
+sub get_format_string {
+ return Irssi::current_theme->get_format(@_);
+}
+
+
+sub get_channels {
+ # see here: https://github.com/shabble/irssi-docs/wiki/complete_themes
+ $line_format = get_format_string('fe-common/core', 'chansetup_line');
+ $head_format = get_format_string('fe-common/core', 'chansetup_header');
+ $foot_format = get_format_string('fe-common/core', 'chansetup_footer');
+
+ my $parse_line_format = "channel:\$0\tnet:\$1\tpass:\$2\tsettings:\$3";
+ Irssi::command("^FORMAT chansetup_line $parse_line_format");
+ Irssi::command("^FORMAT chansetup_header START");
+ Irssi::command("^FORMAT chansetup_footer END");
+
+ $state = 0;
+ Irssi::signal_add_first('print text', 'sig_print_text');
+ Irssi::command("CHANNEL LIST");
+ Irssi::signal_remove('print text', 'sig_print_text');
+
+}
+
+sub restore_formats {
+ Irssi::command("^FORMAT chansetup_line $line_format");
+ Irssi::command("^FORMAT chansetup_header $head_format");
+ if ($foot_format =~ m/^\s*$/) {
+ Irssi::command("^FORMAT -reset chansetup_footer");
+ } else {
+ Irssi::command("^FORMAT chansetup_footer $foot_format");
+ }
+}
+
+sub sig_print_text {
+ my ($dest, $text, $stripped) = @_;
+
+ my $entry = {};
+
+ if ($state == 0 && $text =~ m/START/) {
+ $state = 1;
+ } elsif ($state == 1) {
+ # TODO: might we get multiple lines at once?
+ if ($text =~ m/channel:([^\t]+)\tnet:([^\t]+)\tpass:([^\t]*)\tsettings:(.*)$/) {
+ $entry->{channel} = $1;
+ $entry->{network} = $2;
+ $entry->{password} = $3;
+ $entry->{settings} = $4;
+
+ my $tag = "$2/$1";
+ $channels->{$tag} = $entry;
+
+ } elsif ($text =~ m/END/) {
+ $state = 0;
+ } else {
+ push @errors, "Failed to parse: '$text'";
+ }
+ }
+ Irssi::signal_stop();
+}
+
+sub go {
+ eval {
+ get_channels();
+ };
+ if ($@) {
+ print "Error: $@. Reloading theme to restore format";
+ Irssi::themes_reload();
+ } else {
+ restore_formats();
+ }
+ if (@errors) {
+ @errors = map { s/\t/ /g } @errors;
+ print Dumper(\@errors);
+ }
+ print Dumper($channels);
+}
+
+Irssi::command_bind('getchan', \&go);
+# in fe-common/core
+#
+# chansetup_not_found = "Channel {channel $0} not found";
+# chansetup_added = "Channel {channel $0} saved";
+# chansetup_removed = "Channel {channel $0} removed";
+# chansetup_header = "%#Channel Network Password Settings";
+# chansetup_line = "%#{channel $[15]0} %|$[10]1 $[10]2 $3";
+# chansetup_footer = "";
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'
);
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-19 16:48:01 +0000