2007-08-13 05:07:31 +02:00
|
|
|
#!/usr/bin/perl
|
|
|
|
# Support for external plugins written in other languages.
|
|
|
|
# Communication via XML RPC a pipe.
|
|
|
|
# See externaldemo for an example of a plugin that uses this.
|
|
|
|
package IkiWiki::Plugin::external;
|
|
|
|
|
|
|
|
use warnings;
|
|
|
|
use strict;
|
|
|
|
use IkiWiki 2.00;
|
|
|
|
use RPC::XML;
|
|
|
|
use RPC::XML::Parser;
|
|
|
|
use IPC::Open2;
|
|
|
|
use IO::Handle;
|
|
|
|
|
|
|
|
my %plugins;
|
|
|
|
|
|
|
|
sub import { #{{{
|
|
|
|
my $self=shift;
|
|
|
|
my $plugin=shift;
|
|
|
|
return unless defined $plugin;
|
|
|
|
|
|
|
|
my ($plugin_read, $plugin_write);
|
2007-10-14 00:18:33 +02:00
|
|
|
my $pid = open2($plugin_read, $plugin_write,
|
|
|
|
IkiWiki::possibly_foolish_untaint($plugin));
|
2007-08-13 05:07:31 +02:00
|
|
|
|
|
|
|
# open2 doesn't respect "use open ':utf8'"
|
|
|
|
binmode($plugin_read, ':utf8');
|
|
|
|
binmode($plugin_write, ':utf8');
|
|
|
|
|
|
|
|
$plugins{$plugin}={in => $plugin_read, out => $plugin_write, pid => $pid,
|
|
|
|
accum => ""};
|
2008-02-11 06:11:49 +01:00
|
|
|
$RPC::XML::ENCODING="utf-8";
|
2007-08-13 05:07:31 +02:00
|
|
|
|
|
|
|
rpc_call($plugins{$plugin}, "import");
|
|
|
|
} #}}}
|
|
|
|
|
|
|
|
sub rpc_write ($$) { #{{{
|
|
|
|
my $fh=shift;
|
|
|
|
my $string=shift;
|
|
|
|
|
|
|
|
$fh->print($string."\n");
|
|
|
|
$fh->flush;
|
|
|
|
} #}}}
|
|
|
|
|
|
|
|
sub rpc_call ($$;@) { #{{{
|
|
|
|
my $plugin=shift;
|
|
|
|
my $command=shift;
|
|
|
|
|
|
|
|
# send the command
|
|
|
|
my $req=RPC::XML::request->new($command, @_);
|
|
|
|
rpc_write($plugin->{out}, $req->as_string);
|
|
|
|
|
|
|
|
# process incoming rpc until a result is available
|
|
|
|
while ($_ = $plugin->{in}->getline) {
|
|
|
|
$plugin->{accum}.=$_;
|
|
|
|
while ($plugin->{accum} =~ /^\s*(<\?xml\s.*?<\/(?:methodCall|methodResponse)>)\n(.*)/s) {
|
|
|
|
$plugin->{accum}=$2;
|
|
|
|
my $r = RPC::XML::Parser->new->parse($1);
|
|
|
|
error("XML RPC parser failure: $r") unless ref $r;
|
|
|
|
if ($r->isa('RPC::XML::response')) {
|
|
|
|
my $value=$r->value;
|
|
|
|
if ($value->isa('RPC::XML::array')) {
|
|
|
|
return @{$value->value};
|
|
|
|
}
|
|
|
|
elsif ($value->isa('RPC::XML::struct')) {
|
|
|
|
return %{$value->value};
|
|
|
|
}
|
|
|
|
elsif ($value->isa('RPC::XML::fault')) {
|
|
|
|
die $value->string;
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
return $value->value;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
my $name=$r->name;
|
|
|
|
my @args=map { $_->value } @{$r->args};
|
|
|
|
|
|
|
|
# When dispatching a function, first look in
|
|
|
|
# IkiWiki::RPC::XML. This allows overriding
|
|
|
|
# IkiWiki functions with RPC friendly versions.
|
|
|
|
my $ret;
|
|
|
|
if (exists $IkiWiki::RPC::XML::{$name}) {
|
|
|
|
$ret=$IkiWiki::RPC::XML::{$name}($plugin, @args);
|
|
|
|
}
|
|
|
|
elsif (exists $IkiWiki::{$name}) {
|
|
|
|
$ret=$IkiWiki::{$name}(@args);
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
error("XML RPC call error, unknown function: $name");
|
|
|
|
}
|
|
|
|
|
|
|
|
my $string=eval { RPC::XML::response->new($ret)->as_string };
|
|
|
|
if ($@ && ref $ret) {
|
|
|
|
# One common reason for serialisation to
|
|
|
|
# fail is a complex return type that cannot
|
|
|
|
# be represented as an XML RPC response.
|
|
|
|
# Handle this case by just returning 1.
|
|
|
|
$string=eval { RPC::XML::response->new(1)->as_string };
|
|
|
|
}
|
|
|
|
if ($@) {
|
|
|
|
error("XML response serialisation failed: $@");
|
|
|
|
}
|
|
|
|
rpc_write($plugin->{out}, $string);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
return undef;
|
|
|
|
} #}}}
|
|
|
|
|
|
|
|
package IkiWiki::RPC::XML;
|
2007-08-13 09:00:53 +02:00
|
|
|
use Memoize;
|
2007-08-13 05:07:31 +02:00
|
|
|
|
|
|
|
sub getvar ($$$) { #{{{
|
|
|
|
my $plugin=shift;
|
|
|
|
my $varname="IkiWiki::".shift;
|
|
|
|
my $key=shift;
|
|
|
|
|
|
|
|
no strict 'refs';
|
|
|
|
my $ret=$varname->{$key};
|
|
|
|
use strict 'refs';
|
|
|
|
return $ret;
|
|
|
|
} #}}}
|
|
|
|
|
|
|
|
sub setvar ($$$;@) { #{{{
|
|
|
|
my $plugin=shift;
|
|
|
|
my $varname="IkiWiki::".shift;
|
|
|
|
my $key=shift;
|
|
|
|
|
|
|
|
no strict 'refs';
|
|
|
|
my $ret=$varname->{$key}=@_;
|
|
|
|
use strict 'refs';
|
|
|
|
return $ret;
|
|
|
|
} #}}}
|
|
|
|
|
2007-12-08 23:40:50 +01:00
|
|
|
sub getstate ($$$$) { #{{{
|
|
|
|
my $plugin=shift;
|
|
|
|
my $page=shift;
|
|
|
|
my $id=shift;
|
|
|
|
my $key=shift;
|
|
|
|
|
|
|
|
return $IkiWiki::pagestate{$page}{$id}{$key};
|
|
|
|
} #}}}
|
|
|
|
|
|
|
|
sub setstate ($$$$;@) { #{{{
|
|
|
|
my $plugin=shift;
|
|
|
|
my $page=shift;
|
|
|
|
my $id=shift;
|
|
|
|
my $key=shift;
|
|
|
|
|
|
|
|
return $IkiWiki::pagestate{$page}{$id}{$key}=@_;
|
|
|
|
} #}}}
|
|
|
|
|
2007-08-13 05:07:31 +02:00
|
|
|
sub inject ($@) { #{{{
|
|
|
|
# Bind a given perl function name to a particular RPC request.
|
|
|
|
my $plugin=shift;
|
|
|
|
my %params=@_;
|
|
|
|
|
|
|
|
if (! exists $params{name} || ! exists $params{call}) {
|
|
|
|
die "inject needs name and call parameters";
|
|
|
|
}
|
|
|
|
my $sub = sub {
|
|
|
|
IkiWiki::Plugin::external::rpc_call($plugin, $params{call}, @_)
|
|
|
|
};
|
|
|
|
eval qq{*$params{name}=\$sub};
|
2007-08-13 09:00:53 +02:00
|
|
|
memoize($params{name}) if $params{memoize};
|
2007-08-13 05:07:31 +02:00
|
|
|
return 1;
|
|
|
|
} #}}}
|
|
|
|
|
|
|
|
sub hook ($@) { #{{{
|
|
|
|
# the call parameter is a function name to call, since XML RPC
|
|
|
|
# cannot pass a function reference
|
|
|
|
my $plugin=shift;
|
|
|
|
my %params=@_;
|
|
|
|
|
|
|
|
my $callback=$params{call};
|
|
|
|
delete $params{call};
|
|
|
|
|
|
|
|
IkiWiki::hook(%params, call => sub {
|
|
|
|
IkiWiki::Plugin::external::rpc_call($plugin, $callback, @_)
|
|
|
|
});
|
|
|
|
} #}}}
|
|
|
|
|
|
|
|
sub pagespec_match ($@) { #{{{
|
|
|
|
# convert pagespec_match's return object into a XML RPC boolean
|
|
|
|
my $plugin=shift;
|
|
|
|
|
|
|
|
return RPC::XML::boolean->new(0 + IkiWiki::pagespec_march(@_));
|
|
|
|
} #}}}
|
|
|
|
|
|
|
|
1
|