--- /dev/null
+use strict;
+use warnings;
+
+{ package Irssi::Nick }
+
+use Irssi qw(command_bind command_bind_first command_runsub
+settings_add_str settings_get_str settings_add_int settings_get_int
+command_set_options command_parse_options server_find_tag signal_stop
+timeout_add timeout_remove);
+use Irssi::TextUI;
+
+use Scalar::Util qw(looks_like_number);
+use List::Util qw(min max);
+use POSIX qw(strftime);
+
+our $VERSION = '1.0';
+our %IRSSI = (
+ authors => 'Pablo Martín Báez Echevarría',
+ contact => 'pab_24n@outlook.com',
+ name => 'buffer',
+ description => 'pastes a buffer into a channel or query window line by line with a specific delay between lines',
+ url => 'http://reirssi.wordpress.com',
+ license => 'Public Domain',
+ changed => 'vie jun 17 15:04:25 UYT 2016',
+);
+
+my $buffer = [];
+my $pastings = {};
+my $regex = '^';
+
+sub cmd_buffer_help {
+ print CLIENTCRAP <<HELP
+
+%9Syntax%9:
+
+BUFFER SEARCH [-filename <file>] [-regexp] [-case] [-word] [<pattern>]
+BUFFER LOAD [-filename <file>] [-start <first line>] [-end <last line>]
+BUFFER CLEAR
+BUFFER PRINT
+BUFFER PLAY [-delay <seconds>] [-continue [<id>]]
+BUFFER STOP [<id>]
+BUFFER REMOVE [<id>]
+BUFFER RESUME
+
+
+%9Description%9:
+
+ Pastes a buffer into a channel or query window line by line with a
+ specific delay between lines. It is inspired by the mIRC /play
+ command.
+
+%9Parameters%9:
+
+ SEARCH: Searches the active window (or a file) for a pattern and
+ displays the matching lines with its corresponding line
+ number, in order to make easy to load the desired text.
+
+ -filename Name of the file where to look at. If omitted,
+ searchs the scrollback buffer of the current
+ window.
+ -regexp The given pattern is a regexp.
+ -case Performs case sensitive matching.
+ -word The text must match full words.
+ -pattern If omitted, it will be the pattern of the
+ previous search (and if there is no previous
+ search, the command displays everything).
+
+ LOAD: Loads the buffer and gets it ready to be pasted into a
+ location.
+
+ -filename Name of the file whose lines will be loaded. If
+ omitted, loads lines from the current window.
+ -start Number of the first line to be loaded. If
+ omitted, it will be 1.
+ -end Number of the last line to be loaded. If
+ omitted, it will be the total number of lines
+ in the current window/file.
+
+ CLEAR: Clears the buffer.
+ PRINT: Displays the content of the buffer in the status window.
+ PLAY: Pastes the buffer into the current channel or query window
+ or wakes up an already existing paste.
+
+ -delay Delay (in seconds) between each message.
+ -continue Continues the paste identified by <id> (run
+ /BUFFER RESUME to find out the correct
+ identifier). If this parameter is omitted, it
+ will paste the entire buffer previously loaded
+ into the current channel or query window. If
+ -continue is used not followed by an id, it
+ wakes up all the paused pastes.
+
+ STOP: Stops an active paste.
+
+ -id Identifier of the paste that you would like
+ to stop. If ommitted, it will stop all the
+ active pastes.
+
+ REMOVE: Removes an existing paste.
+
+ -id Identifier of the paste that you would like to
+ remove. If omitted, it will remove all the
+ existing pastes.
+
+ RESUME: Lists the existings pastes and shows information about each
+ one.
+
+
+%9Settings%9:
+
+ -buffer_delay: Default delay between messages.
+
+ -buffer_context_lines If this is set to n, then /BUFFER RESUME will
+ print n lines before and after the next line
+ to be pasted.
+HELP
+;
+ signal_stop(); # To avoid 'No help for buffer' at the end
+}
+
+sub open_file {
+ my $filename = shift;
+ $filename =~ s/^~/$ENV{HOME}/;
+ open my $fh, '<', $filename or die "Could not open file '$filename': $!\n";
+ die "File '$filename' does not look like a text file\n" unless -T $filename;
+ return $fh;
+}
+
+sub send_line {
+ my ( $timeout_tag, $buff, $index, $server, $target ) = @_;
+
+ # Get line
+ my $line = $buff->[$$index];
+ $line .= ' ' if $line eq '';
+
+ # Send line to target
+ $server->command("MSG $target $line");
+
+ # Increment pointer which stores the next line to be sent
+ $$index++;
+
+ # Remove the paste if it's the last line in the buffer
+ if ( $$index == @$buff ) {
+ timeout_remove( $timeout_tag );
+ delete $pastings->{$timeout_tag};
+ }
+}
+
+sub timeout_function {
+ my ( $ref ) = @_;
+ my $timeout_tag = $$ref;
+
+ my ( $buff, $servtag, $targ, $pointer ) =
+ @{$pastings->{$timeout_tag}}{qw/buffer network target counter/};
+
+ # Check server and target
+ my $server = server_find_tag( $servtag );
+ unless ( $server && $server->{connected} ) {
+ printf CLIENTERROR "Not connected to server '%s'. Paste <%d> will be paused", $servtag, $timeout_tag;
+ timeout_remove( $timeout_tag );
+ $pastings->{$timeout_tag}{'status'} = 'paused';
+ return;
+ };
+ my $witem = $server->window_find_item($targ);
+ unless ( $witem ) {
+ printf CLIENTERROR "No window named '%s'. Paste <%d> will be paused", $targ, $timeout_tag;
+ timeout_remove( $timeout_tag );
+ $pastings->{$timeout_tag}{'status'} = 'paused';
+ return;
+ }
+
+ # Send line
+ send_line($timeout_tag, $buff, $pointer, $server, $targ);
+}
+
+sub buffer_context_range {
+ my ( $index, $context_lines, $total ) = @_;
+ my $first = max( 0, $index - $context_lines );
+ my $last = min( $total-1, $index + $context_lines );
+ $first..$last;
+}
+
+sub cmd_buffer_search {
+ my ( $args, $server, $witem ) = @_;
+ my ($options, $pattern) = command_parse_options('buffer search', $args);
+
+ if ($pattern) {
+ my $flags = defined($options->{case}) ? '' : '(?i)';
+ my $b = defined($options->{word}) ? '\b' : '';
+ if (defined $options->{regexp} ) {
+ local $@;
+ eval {
+ $regex = qr/$flags$b$pattern$b/;
+ };
+ if ($@) {
+ my ($err) = $@ =~ /^(.*) at .* line \d+\.$/;
+ print CLIENTERROR "Pattern \/$pattern\/ did not compile: $err";
+ return;
+ }
+ } else {
+ $regex = qr/$flags$b\Q$pattern\E$b/;
+ }
+ }
+ my @results;
+ if ( defined $options->{filename} ) {
+ my $filename = $options->{filename};
+ my $fh;
+ eval { $fh = open_file($filename) };
+ if ($@) {
+ chomp(my $err = $@);
+ print CLIENTERROR $err;
+ return;
+ }
+ my $num = 1;
+ while( defined (my $line = <$fh>) ) {
+ chomp($line);
+ $line =~ s/\t/' 'x4/ge;
+ push @results, [$num, $`, $&, $'] if $line =~ $regex;
+ $num++;
+ }
+ close $fh;
+ } else {
+ my $current_win = ref $witem ? $witem->window : Irssi::active_win;
+ my $view = $current_win->view;
+ my $line = $view->{buffer}->{first_line};
+ my $num = 1;
+ while ( defined $line ) {
+ push @results, [$num, $`, $&, $'] if $line->get_text(0) =~ $regex;
+ $line = $line->next;
+ $num++;
+ }
+ }
+ if (@results) {
+ my $greatest_line_number = $results[-1][0];
+ my $digits = length $greatest_line_number;
+ printf CLIENTCRAP join("\n", ("%%9%${digits}d.%%n%s%%9%%R%s%%n%s")x@results),
+ map { @$_[0..3] } @results;
+ }
+}
+
+sub cmd_buffer_load {
+ my ( $args, $server, $witem ) = @_;
+ my ($options) = command_parse_options('buffer load', $args);
+ my $start = $options->{start} // 1;
+ my $end;
+ my @new_buffer;
+ if ( defined $options->{filename} ) {
+ my $filename = $options->{filename};
+ my $fh;
+ eval { $fh = open_file($filename) };
+ if ($@) {
+ chomp(my $err = $@);
+ print CLIENTERROR $err;
+ return;
+ }
+ my @dump = <$fh>;
+ close $fh;
+ my $lines_count = @dump;
+ $end = $options->{end} // $lines_count;
+
+ if ($start<1 || $end>$lines_count || $start>$end) {
+ print CLIENTERROR 'Wrong -start or -end parameters (out of range)';
+ return;
+ };
+ @new_buffer = map{ chomp; s/\t/' 'x4/ge; $_ } @dump[$start-1..$end-1]
+ } else {
+ my $current_win = ref $witem ? $witem->window : Irssi::active_win;
+ my $view = $current_win->view;
+ my $line = $view->{buffer}->{first_line};
+ my $lines_count = $view->{buffer}->{lines_count};
+ $end = $options->{end} // $lines_count;
+
+ if ($start<1 || $end>$lines_count || $start>$end) {
+ print CLIENTERROR 'Wrong -start or -end parameters (out of range)';
+ return;
+ };
+ my $num = 1;
+ while ( defined $line ) {
+ if ( $start<=$num && $num<=$end ) {
+ chomp(my $line_text = $line->get_text(0));
+ push @new_buffer, $line_text;
+ last if $num == $end;
+ }
+ $line = $line->next;
+ $num++;
+ }
+ }
+ $buffer = \@new_buffer;
+ print CLIENTCRAP 'Buffer successfully loaded';
+}
+
+sub cmd_buffer_clear {
+ $buffer = [];
+ print CLIENTCRAP 'Buffer is now empty';
+}
+
+sub cmd_buffer_print {
+ print CLIENTCRAP $_ for @$buffer;
+ printf CLIENTCRAP "%d lines", scalar @$buffer;
+}
+
+sub cmd_buffer_play {
+ my ( $args, $server, $witem ) = @_;
+
+ my ($options) = command_parse_options('buffer play', $args);
+ my $delay = $options->{delay} // settings_get_str('buffer_delay');
+ unless (looks_like_number($delay)) {
+ print CLIENTERROR 'Delay must be a number';
+ return;
+ }
+ unless ( $delay >= 10e-3 ) {
+ print CLIENTERROR 'Delay cannot be less than 0.010 seconds (10 milliseconds)';
+ return;
+ }
+ if ( defined $options->{continue} ) {
+ my $id = $options->{continue};
+ if ( $id =~ /^\s*$/ ) { # Empty id. Wake up every paused paste
+ foreach my $inner_id (keys %$pastings) {
+ if ( $pastings->{$inner_id}{'status'} eq 'paused' ) {
+ wake_sleeping_paste( $inner_id, ($options->{delay} ? $delay : undef) );
+ }
+ }
+ } else { # Not empty id
+ unless ( defined $pastings->{$id} ) {
+ print CLIENTERROR 'Not recognized id. See /BUFFER RESUME';
+ return;
+ }
+ wake_sleeping_paste( $id, ($options->{delay} ? $delay : undef) );
+ }
+ } else {
+ unless ( $server && $server->{connected} ) {
+ print CLIENTERROR 'Not connected to server';
+ return;
+ }
+ unless ( $witem && ($witem->{type} eq "CHANNEL" || $witem->{type} eq "QUERY") ) {
+ print CLIENTERROR 'No active channel/query in window';
+ return;
+ }
+ unless ( @$buffer ) {
+ print CLIENTERROR 'Buffer is empty. Nothing to paste';
+ return;
+ }
+ my $servtag = $server->{tag};
+ my $target = $witem->{name};
+ my $counter = 0;
+
+ my $timeout_tag;
+ $timeout_tag = timeout_add( $delay*1000 , 'timeout_function', \$timeout_tag );
+ $pastings->{$timeout_tag} = {
+ buffer => $buffer,
+ status => 'active',
+ network => $servtag,
+ target => $target,
+ counter => \$counter,
+ delay => $delay,
+ timestamp => time,
+ };
+ send_line($timeout_tag, $buffer, \$counter, $server, $target);
+ }
+}
+
+sub wake_sleeping_paste {
+ my ( $id, $delay ) = @_;
+ unless ( $pastings->{$id}{'status'} eq 'paused' ) {
+ printf CLIENTERROR 'Paste <%d> is already active', $id;
+ return;
+ }
+
+ my ( $buff, $servtag, $targ, $pointer ) =
+ @{$pastings->{$id}}{qw/buffer network target counter/};
+
+ # Check server and target
+ my $server = server_find_tag( $servtag );
+ unless ( $server && $server->{connected} ) {
+ printf CLIENTERROR "Not connected to server '%s'. Paste <%d> will continue to be paused", $servtag, $id;
+ return;
+ };
+ my $witem = $server->window_find_item($targ);
+ unless ( $witem ) {
+ printf CLIENTERROR "No window named '%s'. Paste <%d> will continue to be paused", $targ, $id;
+ return;
+ }
+ my $temp = $pastings->{$id};
+ delete $pastings->{$id};
+ $temp->{'status'} = 'active';
+ $temp->{'delay'} = $delay if defined $delay;
+ $temp->{'timestamp'} = time;
+
+ my $timeout_tag;
+ $timeout_tag = timeout_add( $temp->{'delay'} * 1000 , 'timeout_function', \$timeout_tag );
+ $pastings->{$timeout_tag} = $temp;
+ send_line($timeout_tag, $buff, $pointer, $server, $targ);
+}
+
+sub cmd_buffer_stop {
+ my ( $args, $server, $witem ) = @_;
+ my $id = $args;
+ if ( $id =~ /^\s*$/ ) { # Empty id. Stop every active paste
+ foreach my $inner_id (keys %$pastings) {
+ if ( $pastings->{$inner_id}{'status'} eq 'active' ) {
+ timeout_remove( $inner_id );
+ $pastings->{$inner_id}{'status'} = 'paused';
+ }
+ }
+ } else { # Not empty id
+ unless ( defined $pastings->{$id} ) {
+ print CLIENTERROR 'Not recognized id. See /BUFFER RESUME';
+ return;
+ }
+ if ( $pastings->{$id}{'status'} eq 'active' ) {
+ timeout_remove( $id );
+ $pastings->{$id}{'status'} = 'paused';
+ }
+ }
+}
+
+sub cmd_buffer_remove {
+ my ( $args, $server, $witem ) = @_;
+ my $id = $args;
+ if ( $id =~ /^\s*$/ ) { # Empty id. Remove every existing paste
+ foreach my $inner_id (keys %$pastings) {
+ timeout_remove( $inner_id );
+ delete $pastings->{$inner_id};
+ }
+ } else { # Not empty id
+ unless ( defined $pastings->{$id} ) {
+ print CLIENTERROR 'Not recognized id. See /BUFFER RESUME';
+ return;
+ }
+ timeout_remove( $id );
+ delete $pastings->{$id};
+ }
+}
+
+sub cmd_buffer_resume {
+ if ( keys %$pastings ) {
+
+ my $context_lines = settings_get_int('buffer_context_lines');
+ if ($context_lines < 0) {
+ print CLIENTERROR 'The number of context lines (surrounding the next line to be sent) must be a positive integer';
+ return;
+ }
+
+ my $id_string = 'ID';
+ my $id_colwidth = max(
+ length($id_string),
+ max( map{length($_)} keys %$pastings )
+ );
+
+ my $time_string = 'TIMESTAMP';
+ my $time_colwidth = max(
+ length($time_string),
+ max( map{length( strftime('%c', localtime($pastings->{$_}->{'timestamp'})) )} keys %$pastings )
+ );
+
+ my $status_string = 'STATUS';
+ my $status_colwidth = max(
+ length($status_string),
+ max( map{length($pastings->{$_}->{'status'})} keys %$pastings )
+ );
+
+ my $network_string = 'NETWORK';
+ my $network_colwidth = max(
+ length($network_string),
+ max( map{length($pastings->{$_}->{'network'})} keys %$pastings )
+ );
+
+ my $channel_string = 'TARGET';
+ my $channel_colwidth = max(
+ length($channel_string),
+ max( map{length($pastings->{$_}->{'target'})} keys %$pastings )
+ );
+
+ my $delay_string = 'DELAY';
+ my $delay_colwidth = max(
+ length($delay_string),
+ max( map{length($pastings->{$_}->{'delay'})} keys %$pastings )
+ );
+
+ my $pasted_string = 'PASTED LINES';
+ my $pasted_colwidth = max(
+ length($pasted_string),
+ max( map{length( ${$pastings->{$_}->{'counter'}} )} keys %$pastings )
+ );
+
+ my $pending_string = 'PENDING LINES';
+ my $pending_colwidth = max(
+ length($pending_string),
+ max( map{length( @{$pastings->{$_}->{'buffer'}} - ${$pastings->{$_}->{'counter'}} )} keys %$pastings )
+ );
+
+ my $str_format = join (
+ " "x4,
+ map { "\%${_}s" }
+ ($id_colwidth,
+ $time_colwidth,
+ $status_colwidth,
+ $network_colwidth,
+ $channel_colwidth,
+ $delay_colwidth,
+ $pasted_colwidth,
+ $pending_colwidth
+ )
+ );
+ foreach my $id ( sort{$pastings->{$a}->{'timestamp'}<=>$pastings->{$b}->{'timestamp'}} keys %$pastings ) {
+ printf CLIENTCRAP "%%9" . $str_format,
+ ($id_string,
+ $time_string,
+ $status_string,
+ $network_string,
+ $channel_string,
+ $delay_string,
+ $pasted_string,
+ $pending_string
+ );
+ printf CLIENTCRAP $str_format . "\n",
+ ($id,
+ strftime('%c', localtime($pastings->{$id}->{'timestamp'})),
+ $pastings->{$id}->{'status'},
+ $pastings->{$id}->{'network'},
+ $pastings->{$id}->{'target'},
+ $pastings->{$id}->{'delay'},
+ ${$pastings->{$id}->{'counter'}},
+ @{$pastings->{$id}->{'buffer'}} - ${$pastings->{$id}->{'counter'}}
+ );
+ print CLIENTCRAP '%9NEXT LINE TO BE PASTED:';
+ my $buffref = $pastings->{$id}->{'buffer'};
+ my $index = ${ $pastings->{$id}->{'counter'} };
+ my $total = @$buffref;
+ my @range = buffer_context_range($index, $context_lines, $total);
+ my $digits = length( max( map{$_ + 1} @range ) );
+ foreach my $i ( @range ) {
+ printf CLIENTCRAP "%%9%${digits}d.%%n%10s%s",
+ $i+1, (($i == $index) ? '===>' : ''), @$buffref[$i];
+ };
+ printf CLIENTCRAP "---- End paste <%s>", $id;
+ }
+ } else {
+ print CLIENTCRAP "There aren't any pastes";
+ return;
+ }
+}
+
+command_bind 'buffer' => sub {
+ my ( $data, $server, $item ) = @_;
+ $data =~ s/\s+$//g;
+ command_runsub('buffer', $data, $server, $item);
+};
+command_bind_first help => sub { &cmd_buffer_help if $_[0] =~ /^buffer\s*$/i };
+command_bind 'buffer search' => 'cmd_buffer_search';
+command_set_options 'buffer search' => '-filename regexp case word';
+command_bind 'buffer load' => 'cmd_buffer_load';
+command_set_options 'buffer load' => '-filename @start @end';
+command_bind 'buffer clear' => 'cmd_buffer_clear';
+command_bind 'buffer print' => 'cmd_buffer_print';
+command_bind 'buffer play' => 'cmd_buffer_play';
+command_set_options 'buffer play' => '-delay -continue';
+command_bind 'buffer stop' => 'cmd_buffer_stop';
+command_bind 'buffer remove' => 'cmd_buffer_remove';
+command_bind 'buffer resume' => 'cmd_buffer_resume';
+settings_add_str 'buffer', 'buffer_delay', '1';
+settings_add_int 'buffer', 'buffer_context_lines', '2';
git.99rst.org / irssi-scripts.irssi.org.git / commitdiff