diff options
Diffstat (limited to 'dbush')
-rwxr-xr-x | dbush | 58 |
1 files changed, 56 insertions, 2 deletions
@@ -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 }); |