summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2013-06-13 19:57:25 +0200
committerYorhel <git@yorhel.nl>2013-06-13 19:59:55 +0200
commitd3be00542d4d770a51f5ae989f64de6849389681 (patch)
treece7456386a6268a903b5b0759dedb37d03f399bc
parent67169f9c1d327b8ea6519acb3ed732584d03613c (diff)
Add basic 'introspect' command + fix history repetition bug
-rwxr-xr-xdbush58
1 files changed, 56 insertions, 2 deletions
diff --git a/dbush b/dbush
index ed09874..37d9534 100755
--- a/dbush
+++ b/dbush
@@ -9,7 +9,6 @@ use Getopt::Long;
# TODO: Loading a dbushrc with commands to execute on startup
# TODO: Ctrl+C handling
-# TODO: Listing interfaces/methods/signals/properties
# TODO: Method invocation
# TODO: Convenient property handling?
# TODO: Capturing/displaying signals
@@ -119,6 +118,16 @@ sub asyncprint(&) {
}
+sub fmt_args {
+ my($type, $ins, $itf, $name) = @_;
+ my($t, $n) =
+ $type eq 'param' ? ([$ins->get_method_params ($itf, $name)], [$ins->get_method_param_names ($itf, $name)]) :
+ $type eq 'return' ? ([$ins->get_method_returns($itf, $name)], [$ins->get_method_return_names($itf, $name)]) :
+ ([$ins->get_signal_params ($itf, $name)], [$ins->get_signal_param_names ($itf, $name)]);
+ join ', ', map $ins->to_xml_type($t->[$_]).' '.$n->[$_], 0..$#$t;
+}
+
+
sub complete_objpath {
my($args, $obj) = @_;
$obj ||= $curobj;
@@ -224,6 +233,52 @@ cmd cd => sub {
}, \&complete_objpath;
+# TODO: Rename/alias to something shorter
+# TODO: List flags such as Deprecated, NoReply and EmitsChangedSignal
+# TODO: Add -a or -v option to list "common" interfaces that are otherwise hidden
+# TODO: Add option to list only methods, signals and/or properties
+# TODO: Add interface name filter
+cmd introspect => sub {
+ return print "Not associated with a connection, use 'sw <name>' first\n" if !$curobj;
+ my $ins = eval { $curobj->_introspector() }; # XXX: Undocumented
+ return print $@ if !$ins;
+
+ for my $itf (sort $ins->list_interfaces) {
+ print "$itf\n";
+
+ # Don't list details from these three common and obvious interfaces
+ next if {map +("org.freedesktop.DBus.$_",1), qw|Introspectable Peer ObjectManager Properties|}->{$itf};
+
+ my @meth = sort $ins->list_methods($itf);
+ print "\n" if @meth;
+ for my $meth (@meth) {
+ my $ret = fmt_args return => $ins, $itf, $meth;
+ printf " method %s(%s)%s\n",
+ $meth, fmt_args(param => $ins, $itf, $meth),
+ $ret ? " -> ($ret)" : '';
+ }
+
+ my @sig = sort $ins->list_signals($itf);
+ print "\n" if @sig;
+ for my $sig (@sig) {
+ printf " signal %s(%s)\n", $sig,
+ fmt_args signal => $ins, $itf, $sig;
+ }
+
+ my @prop = sort $ins->list_properties($itf);
+ print "\n" if @prop;
+ for my $prop (@prop) {
+ printf " property %s %s %s\n",
+ $ins->to_xml_type($ins->get_property_type($itf, $prop)),
+ $prop, join '',
+ ($ins->is_property_readable($itf, $prop)?'r':''),
+ ($ins->is_property_writable($itf, $prop)?'w':'');
+ }
+
+ print "\n";
+ }
+};
+
@@ -248,7 +303,6 @@ $term->CallbackHandlerInstall(getprompt, sub {
$args =~ s/^\s+//;
$args =~ s/\s+$//;
$cmd{$cmd}[0]->($args);
- $term->addhistory($msg);
$term->rl_set_prompt(getprompt);
flushcache; # TODO: Make configurable
});