videosite-irssi.pl

   1 # shim to connect libvideosite to irssi
   2 #
   3 # (c) 2007-2008 by Ralf Ertzinger <ralf@camperquake.de>
   4 # licensed under GNU GPL v2
   5 use strict;
   6 use Irssi 20020324 qw (command_bind command_runsub signal_add_first signal_add_last);
   7 use vars qw($VERSION %IRSSI);
   8 use File::Spec;
   9 use Module::Load;
  10 use XML::Simple;
  11 use JSON -support_by_pp;
  12 use Carp;
  13
  14 $SIG{ __DIE__ } = sub { Carp::confess( @_ ) };
  15
  16 #
  17 # List of foreground colors. This list is not complete, it just
  18 # contains the colors needed by videosite.
  19 #
  20 # The % are doubled because these are used in sprintf.
  21 #
  22 my %foreground_colors = (
  23     'magenta'   => '%%m',
  24     '*magenta'  => '%%M',
  25     '*yellow'   => '%%Y',
  26     '*green'    => '%%G',
  27     '*red'      => '%%R',
  28     'default'   => '%%n',
  29 );
  30
  31 #
  32 # This is a canary value used in the config system as the default
  33 # value. As irssi does not have a way to test if a setting exists
  34 # this is used instead. A config value is never expected to be set
  35 # to this value and be valid.
  36 #
  37 my $config_canary = "\1";
  38
  39 #
  40 # Initialize the config subsystem. Called by the core.
  41 #
  42 # Due to historic reasons this has to deal with a number of possible config sources:
  43 # * irssi internal config
  44 # * JSON config, old format
  45 # * XML config, old format
  46 #
  47 # JSON and XML configs are parsed, converted and moved to the irssi internal
  48 # format. This happens only once, as the config search stops with the first
  49 # format found
  50 #
  51 sub config_init {
  52     my $xmlconffile = File::Spec->catfile(Irssi::get_irssi_dir(), 'videosite.xml');
  53     my $conffile = File::Spec->catfile(Irssi::get_irssi_dir(), 'videosite.json');
  54     my $conf;
  55
  56     # Check for irssi internal config. If not found...
  57     if (config_has(['config-version'])) {
  58         # Configuration in irssi config file. We're done.
  59         return;
  60     }
  61
  62     # Try to find old config files and load them.
  63     if (-r $conffile) {
  64         Irssi::print("Converting configuration from videosite.json. This will happen only once.");
  65         eval {
  66             local $/;
  67             open(CONF, '<', $conffile);
  68             $conf = JSON->new->utf8->decode(<CONF>);
  69             close(CONF);
  70         };
  71     } elsif (-r $xmlconffile) {
  72         Irssi::print("Converting configuration from videosite.xml. This will happen only once.");
  73         $conf = XML::Simple::XMLin($xmlconffile, ForceArray => ['config', 'option', 'connectorlist'], KeepRoot => 1, KeyAttr => {'connector' => '+name', 'config' => 'module', 'option' => 'key'});
  74     } else {
  75         # No old config files around. Just exit.
  76         return;
  77     }
  78
  79     #
  80     # Configuration conversion:
  81     # Replace this structure:
  82     #
  83     # key => {
  84     #   content => value
  85     # }
  86     #
  87     # with this structure
  88     #
  89     # key => value
  90     #
  91     Irssi::print("Converting configuration, stage 1");
  92
  93     # Only the getter/grabbers have this, so just check that part of the config
  94     foreach my $g (keys(%{$conf->{videosite}->{config}})) {
  95         foreach (keys(%{$conf->{videosite}->{config}->{$g}->{option}})) {
  96             if (exists($conf->{videosite}->{config}->{$g}->{option}->{$_}->{content})) {
  97                 $conf->{videosite}->{config}->{$g}->{option}->{$_} = $conf->{videosite}->{config}->{$g}->{option}->{$_}->{content};
  98             }
  99         }
 100     }
 101
 102     #
 103     # Walk the configuration hash, creating irssi config entries for
 104     # each leaf node.
 105     #
 106     # Some config values changed, so not the entire config is copied over.
 107     # There is a helper function for this in libvideosite that we're using.
 108     #
 109     Irssi::print("Converting configuration, stage 2");
 110
 111     # Copy the "basic" settings.
 112     foreach (qw(getter mode)) {
 113         config_set([$_], $conf->{videosite}->{$_});
 114     }
 115
 116     # Copy the per-getter/setter settings
 117     foreach my $g (keys(%{$conf->{videosite}->{config}})) {
 118         foreach (keys(%{$conf->{videosite}->{config}->{$g}->{option}})) {
 119             config_set(['plugin', $g, $_], $conf->{videosite}->{config}->{$g}->{option}->{$_});
 120         }
 121     }
 122
 123     # Copy the connectors. The connectors themselves are copied as-is,
 124     # the list of active connectors is copied under a different name,
 125     # and a list of all existing connectors is created
 126     my @connectors;
 127
 128     foreach my $c (keys(%{$conf->{videosite}->{connectors}})) {
 129         push(@connectors, $c);
 130         config_set(['connectors', $c, 'name'], $conf->{videosite}->{connectors}->{$c}->{name});
 131         if (exists($conf->{videosite}->{connectors}->{$c}->{_immutable})) {
 132             config_set(['connectors', $c, '_immutable'], $conf->{videosite}->{connectors}->{$c}->{_immutable});
 133         }
 134         foreach (qw(http https)) {
 135             if (exists($conf->{videosite}->{connectors}->{$c}->{schemas}->{http})) {
 136                 config_set(['connectors', $c, 'schemas', $_], $conf->{videosite}->{connectors}->{$c}->{schemas_}->{$_});
 137             }
 138         }
 139     }
 140     config_set(['active-connectors'], join(",", @{$conf->{videosite}->{connectorlist}}));
 141     config_set(['defined-connectors'], join(",", @connectors));
 142     config_set(['config-version'], '2');
 143 }
 144
 145 #
 146 # Reading a configuration value. Called by the core
 147 #
 148 sub config_get {
 149     my $path = shift;
 150     my $item = join('.', 'videosite', @{$path});
 151     my $val;
 152
 153
 154     Irssi::settings_add_str('videosite', $item, $config_canary);
 155     $val = Irssi::settings_get_str($item);
 156
 157     return ($val ne $config_canary)?$val:undef;
 158 }
 159
 160 #
 161 # Returns a true value if the config item exists
 162 #
 163 sub config_has {
 164     my $path = shift;
 165     my $item = join('.', 'videosite', @{$path});
 166
 167     Irssi::settings_add_str('videosite', $item, $config_canary);
 168     return Irssi::settings_get_str($item) ne $config_canary;
 169 }
 170
 171 #
 172 # Setting a configuration value. Called by the core
 173 #
 174 sub config_set {
 175     my $path = shift;
 176     my $value = shift;
 177     my $item = join('.', 'videosite', @{$path});
 178
 179     Irssi::settings_add_str('videosite', $item, $config_canary);
 180     Irssi::settings_set_str($item, $value);
 181 }
 182
 183 #
 184 # Delete a configuration value. Called by the core.
 185 #
 186 # Now, according to the configuration Irssi::settings_remove() removes a
 187 # config settings. This does not work in any irssi version available to me.
 188 # So just set the key to the canary value.
 189 #
 190 sub config_del {
 191     my $path = shift;
 192
 193     config_set($path, $config_canary);
 194 }
 195
 196 #
 197 # Return a color code. Called by the core
 198 #
 199 # Does not handle background colors yet.
 200 #
 201 sub colorpair {
 202     my ($fg, $bg) = @_;
 203
 204     $fg = exists($foreground_colors{$fg})?$foreground_colors{$fg}:'';
 205     $bg = '';
 206
 207     return $fg . $bg;
 208 }
 209
 210 #
 211 # Handle commands (/videosite ...)
 212 #
 213 sub videosite_hook {
 214     my ($cmdline, $server, $witem) = @_;
 215     my %event = (
 216         message => $cmdline,
 217         io => sub { defined($witem)?$witem->print($_[0], MSGLEVEL_CLIENTCRAP):Irssi::print($_[0]) },
 218         window => defined($witem)?$witem->{server}->{real_address} . "/" . $witem->{name}:"",
 219     );
 220
 221     libvideosite::handle_command(\%event);
 222 }
 223
 224 #
 225 # Handle a received message
 226 # Create an event structure and hand it off to libvideosite
 227 #
 228 sub message_hook {
 229     my ($server, $msg, $nick, $userhost, $channel) = @_;
 230     my $witem = $server->window_item_find($channel);
 231     my %event = (
 232         message => $msg,
 233         io => sub { defined($witem)?$witem->print($_[0], MSGLEVEL_CLIENTCRAP):Irssi::print($_[0]) },
 234         window => defined($witem)?$witem->{server}->{real_address} . "/" . $witem->{name}:"",
 235     );
 236
 237     libvideosite::check_for_link(\%event);
 238 }
 239
 240 sub videosite_reset {
 241     my $libpath;
 242
 243     # Find out the script directory, and add it to @INC.
 244     # This is necessary to find libvideosite.pm
 245     $libpath = File::Spec->catfile(Irssi::get_irssi_dir(), 'scripts');
 246
 247     # If the library is already loaded unload it
 248     foreach (keys(%INC)) {
 249         if ($INC{$_} eq File::Spec->catfile($libpath, 'libvideosite.pm')) {
 250             delete($INC{$_});
 251         }
 252     }
 253
 254     push(@INC, $libpath);
 255     load 'libvideosite';
 256
 257     unless(libvideosite::register_api({
 258         io => sub { Irssi::print($_[0]) },
 259         config_init => \&config_init,
 260         config_get =>  \&config_get,
 261         config_set => \&config_set,
 262         config_has => \&config_has,
 263         config_save => sub { 1 },
 264         config_del => \&config_del,
 265         color => \&colorpair,
 266         module_path => sub { return File::Spec->catfile(Irssi::get_irssi_dir(), 'scripts') },
 267         quote => sub { s/%/%%/g; return $_ },
 268         reload => \&videosite_reset,
 269         # irssi needs this to prevent fork()ed child processes becoming zombies:
 270         wait_for_child => sub { Irssi::pidwait_add($_[0]) },
 271     })) {
 272         Irssi::print(sprintf("videosite API register failed: %s", $libvideosite::error));
 273         return 0;
 274     }
 275
 276     unless(libvideosite::init()) {
 277         Irssi::print(sprintf("videosite init failed: %s", $libvideosite::error));
 278         return 0;
 279     }
 280
 281     return 1;
 282 }
 283
 284 sub videosite_init {
 285
 286     if (videosite_reset()) {
 287         signal_add_last("message public", sub { message_hook(@_) });
 288         signal_add_last("message own_public", sub { message_hook($_[0], $_[1], undef, undef, $_[2]) });
 289         signal_add_last("message private", sub { message_hook($_[0], $_[1], $_[2], $_[3], $_[2]) });
 290         signal_add_last("message own_private", sub { message_hook($_[0], $_[1], undef, undef, $_[2]) });
 291         signal_add_last("message irc action", sub { message_hook(@_) });
 292         signal_add_last("message irc own_action", sub { message_hook($_[0], $_[1], undef, undef, $_[2]) });
 293
 294         Irssi::command_bind('videosite', sub { videosite_hook(@_) });
 295     }
 296 }
 297
 298 videosite_init();