irssi-scripts/scripts/on.pl

use Irssi 20011210.0000 ();
$VERSION = "1.12";
%IRSSI = (
    authors     => 'David Leadbeater',
    contact     => 'dgl@dgl.cx',
    name        => 'on.pl',
    description => '/on command - this is very simple and not really designed to be the same as ircII - it tries to fit into Irssi\'s usage style more than emulating ircII.',
    license     => 'GNU GPLv2 or later',
    url         => 'http://irssi.dgl.cx/',
);

use strict;
my %on;

=head1 on.pl

/on command - this is very simple and not really designed to
be the same as ircII - it tries to fit into Irssi's usage style
more than emulating ircII.

=head1 Features

This script allow you to bind Irssi commands or a piece of perl
code to s particular signal with some forms of filtering.

A command can be set to run in a particular channel (nearly)
and on a particular chatnet. The commands that you add are
automatically saved into a file (usually ~/.irssi/on.save).


=head1 Usage

 /on list
 /on add [-perl] [-server] [-channel #channel]  [-stop] 'signal name' command
 /on remove signal name
 /on reload

=head2 ON ADD

 -perl: Interpret command as perl instead of the default Irssi
 -server: Only trigger for events from this chat network
 -channel #channel: only trigger for events in #channel
   (only works where $channel->{name} is present (message signals mostly)
 -stop: Call Irssi::signal_stop() (probably not a good idea to use this)

If you supply a signal name then it must be quoted so it is
interpeted as one, if you wish to bind to a numeric then just
entering it will work.

Currently if you specify a Irssi command $0 and $$0 are escaped,
$0 $1 and so on are the parameters sent to the signal (except the first
REC), $$0 and so on are the results of spliting $0 on a space so if
the signal is an event then $$0 will usually be your nickname, $$1
will be the channel or nickname the numeric is targeting and so on..

=head2 ON REMOVE

This removes *all* events from the signal specified (if you
want to remove a numeric you must add event eg:
 /on remove event 401

=head2 ON RELOAD

Reloads the saved list from ~/.irssi/on.save into memory,
useful if you have to edit it manually (and very useful during debugging :)

=head1 Examples

These are pretty generic examples, there are many more
specific uses for the commands.

To automatically run a /whowas when the no such nick/channel
event is recieved:
 /on add 401 /whowas $$0

To automatically run a command when you become an irc operator
on this chatnet:
 /on add -server 381 /whatever

To automatically move to a window with activtiy in it on a hilight:
 /on add 'window hilight' /window goto active

Obviously perl commands could be used here or many different
signals (see docs/signals.text in the irssi sources for a list
of all the signals)

=cut

Irssi::command_bind('on','cmd_on');
# This makes tab completion work :)
Irssi::command_set_options('on','stop server perl +channel');
load();
add_signals();

# Loads the saved on settings from the saved file
sub load {
   my $file = Irssi::get_irssi_dir . '/on.save';
   return 0 unless -f $file;
   open(ON, $file) or return 0;
   while(<ON>) {
	  chomp;
      my($event,$chatnet,$settings,$channel,$cmd) = split /\0/;
	  push(@{$on{$event}},
	     {
		    'chatnet' => $chatnet || 'all',
			'settings' => $settings,
			'channel' => $channel,
			'cmd' => $cmd,
		 }
	  );
   }
   close(ON);
   return 1;
}

# Saves the settings currently in the %on hash into the save file
sub save {
   my $file = Irssi::get_irssi_dir . '/on.save';
   open(ON, ">$file") or return 0;
   for my $event(keys %on) {
      for(@{$on{$event}}) {
	     print ON join("\0", $event, @$_{'chatnet','settings','channel','cmd'}) . "\n";
	  }
   }
   close(ON) or return 0;
   return 1;
}

# Adds signals from the hash to irssi (only needs to be called once)
sub add_signals {
   for(keys %on) {
      Irssi::signal_add($_, 'signal_handler');
   }
}

# Irssi calls this and it figures out what to do with the event
sub signal_handler {
   my($item, @stuff) = @_;
   my $signal = Irssi::signal_get_emitted();

   if(exists $on{$signal}) {
      for(@{$on{$signal}}) {
		 next if $_->{chatnet} ne 'all' and $_->{chatnet} ne $item->{chatnet};
		 next if $_->{channel} and $item->{name} ne $_->{channel};
	     event_handle(@$_{'settings','cmd'},$item,@stuff);
	  }
   }else{
      Irssi::signal_remove($signal,'signal_handler');
   }
}

# Called with the params needed to handle an event from signal_handler
sub event_handle {
   my($settings,$cmd,$item,@stuff) = @_;
   my %settings = settings_to_hash($settings);

   if($settings{type} == 1) {
	  local @_;
	  @_ = ($item,@stuff);
      eval('no strict;' . $cmd);
   }else{
	  $cmd =~ s!\$\$(\d)!(split / /,$stuff[0])[$1]!ge;
	  $cmd =~ s/\$(\d)/$stuff[$1]/g;
      $item->command($cmd);
   }

   Irssi::signal_stop() if $settings{stop};
}

# Converts the settings string to a nice hash
sub settings_to_hash {
   my $settings = shift;
   my %settings;
   @settings{'type','stop'} = split //, $settings;
   return %settings;
}

# Converts a hash to the settings string
sub hash_to_settings {
   my %settings = @_;
   return join '', @settings{'type','stop'};
}

# Called by the /on command
sub cmd_on {
   my $text = shift;

   if($text =~ s/^add //) {
      my($cmd,%options) = option_parse($text);
	  if(!$options{event} || !$cmd) {
		 Irssi::print('No '.($cmd ? 'command' : 'event'). ' supplied');
	  }else{
	      my($chatnet,%settings,$channel,$event);
		  $chatnet = ($options{server} ? Irssi::active_server()->{chatnet} : 'all');
		  $event = $options{event};
		  $channel = $options{channel};
		  $settings{type} = $options{perl};
		  $settings{stop} = $options{stop};
	      add_on($event,$cmd,$chatnet,$channel,%settings);
		  save();
	  }
   }elsif($text =~ s/^remove //) {
      if(del_on($text)) {
		 Irssi::print("Event $text deleted",MSGLEVEL_CLIENTCRAP);
	  }else{
		 Irssi::print("Event not found",MSGLEVEL_CLIENTCRAP);
	  }
	  save();
   }elsif($text =~ /^reload/) {
	  %on = ();
	  load();
   }elsif($text eq "help") {
	  Irssi::print( <<EOF
Usage:
/on list
/on add [-perl] [-server] [-channel #channel]  [-stop] 'signal name' command
/on remove signal name
/on reload
EOF
   );
   }else{
	 Irssi::print("/on help for usage information");
     on_list();
   }
}

# Output a list of the current contents of %on
sub on_list {
   if(!keys %on) {
	  Irssi::print("On list is empty", MSGLEVEL_CLIENTCRAP);
	  return;
   }
   for my $event(keys %on) {
	   for(@{$on{$event}}) {
		  Irssi::print("$event: " .
		      ($_->{chatnet} ne 'all' ? $_->{chatnet} : '') .
		      ' ' . $_->{cmd},
			  MSGLEVEL_CLIENTCRAP
		  );
       }
    }
}

# Adds into %on and adds a signal if needed.
sub add_on {
   my($event,$cmd,$chatnet,$channel,%settings) = @_;

   Irssi::signal_add($event, 'signal_handler') unless $on{$event};

   push(@{$on{$event}},
	  {
	     'chatnet' => $chatnet || 'all',
	     'settings' => hash_to_settings(%settings),
		 'channel' => $channel,
	     'cmd' => $cmd,
	  }
   );
}

# Deletes all ons under the event
sub del_on {
   my $on = shift;
   Irssi::signal_remove($on, 'signal_handler');
   return delete($on{$on});
}

# This is nasty.
# It would be nice if perl scripts could use Irssi's internal stuff for option
# parsing
sub option_parse {
   my $text = shift;
   my($last,%options,$cmd);
   for(split(' ',$text)) {
      if($cmd) {
	     $cmd .= " $_";
      }elsif(/^-(.+)$/) {
	     $last = 'channel' if $1 eq 'channel';
		 $options{$1}++;
	  }elsif(/^["'0-9]/) {
	     if(/^\d+$/) {
		    $options{event} = "event $_" if /^\d+$/;
		 }else{
		    $last = 'event';
			s/^['"]//;
			$options{event} = $_;
		 }
	  }elsif($last eq 'event'){
		 $last = "" if s/['"]$//;
	     $options{event} .= " $_";
	  }elsif($last) {
	     $options{$last} = $_;
		 $last = "";
	  }else{
	     $cmd = $_;
	  }
   }
   return ($cmd,%options);
}