summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xdbush83
1 files changed, 62 insertions, 21 deletions
diff --git a/dbush b/dbush
index 8c6ec80..ed09874 100755
--- a/dbush
+++ b/dbush
@@ -2,19 +2,19 @@
use strict;
use warnings;
-use Net::DBus;
+use Net::DBus ':typing';
use Net::DBus::Reactor;
use Term::ReadLine;
use Getopt::Long;
# TODO: Loading a dbushrc with commands to execute on startup
# TODO: Ctrl+C handling
-# TODO: Tab completion
# TODO: Listing interfaces/methods/signals/properties
# TODO: Method invocation
# TODO: Convenient property handling?
# TODO: Capturing/displaying signals
# TODO: Displaying NameOwnerChanged notifications
+# TODO: Fancy colors everywhere
# TODO: DOCUMENTATION!
# XXX: This script makes use of several undocumented and/or internal features
@@ -73,7 +73,7 @@ sub resolvepath {
# If the given path is relative, get a sane root.
my @root;
- if(!(@path && $path[0] eq '') && $obj) {
+ if($path !~ /^\// && $obj) {
@root = split /\//, $obj->get_object_path;
shift @root; # Remove first empty element to get rid of the / prefix
}
@@ -96,6 +96,15 @@ sub resolveobj {
}
+sub flushcache {
+ return if !$curobj;
+ # XXX: Undocumented. The entire caching behaviour in Net::DBus is totally
+ # undocumented, even.
+ $curobj->get_service()->{objects} = {};
+ $curobj->{introspected} = 0;
+}
+
+
sub asyncprint(&) {
# Ugly hack to erase the readline prompt for a bit so that we can output
# async notification lines. Doesn't work well if the prompt consumes multiple
@@ -110,12 +119,26 @@ sub asyncprint(&) {
}
+sub complete_objpath {
+ my($args, $obj) = @_;
+ $obj ||= $curobj;
+ return () if !$obj;
+ my($path, $last) = $args =~ /^(?:(.*\/))?([^\/]*)$/;
+ $path ||= '';
+ $obj = resolveobj $path, $obj;
+ my $ins = eval { $obj->_introspector() }; # XXX: Undocumented
+ return () if !$ins;
+ $term->Attribs->{completion_append_character} = '';
+ map "$path$_/", grep /^\Q$last/, $ins->list_children();
+}
+
+
my %cmd;
-sub cmd($&) {
+sub cmd {
my $n = shift;
- $cmd{$n} = shift;
+ $cmd{$n} = [ shift, shift ];
}
cmd names => sub {
@@ -150,6 +173,12 @@ cmd sw => sub {
$path ||= '/';
($path = $n) =~ s/\./\//g if $path eq '-';
$curobj = resolveobj $path, $bus->get_service($n)->get_object('/');
+}, sub {
+ my $args = shift;
+ my $o = $bus->get_bus_object;
+ return $o->NameHasOwner(dbus_string $1) ? complete_objpath $2, $bus->get_service($1)->get_object('/') : ()
+ if $args =~ /([^ ]+)\s+(.*)$/;
+ grep $_ ne 'org.freedesktop.DBus' && /^\Q$args/, @{$o->ListNames()};
};
@@ -180,6 +209,9 @@ cmd ls => sub {
$path = resolvepath $path;
print "$_\n" for ($t->($level, resolveobj($path), $path));
+}, sub {
+ (my $arg = shift) =~ s/^-[rR]\s+//;
+ return complete_objpath $arg;
};
@@ -189,34 +221,43 @@ cmd cd => sub {
# TODO: What should a 'cd' without arguments go to?
return print "Not associated with a connection, use 'sw <name>' first\n" if !$curobj;
$curobj = resolveobj $path;
-};
+}, \&complete_objpath;
+
+
$term->ReadHistory($histfile);
-$term->callback_handler_install(getprompt, sub {
+
+$term->Attribs->{completion_function} = sub {
+ my($text, $line, $start) = @_;
+ $term->Attribs->{completion_append_character} = ' ';
+ my $msg = substr $line, 0, $start+length $text;
+ $msg =~ s/^\s+//;
+ return grep /^\Q$msg/, keys %cmd if $msg !~ / /;
+ my $cmd = $msg =~ s/^([^\s]+)\s+// && $1;
+ return !$cmd{$cmd} || !$cmd{$cmd}[1] ? () : $cmd{$cmd}[1]->($msg);
+};
+
+$term->CallbackHandlerInstall(getprompt, sub {
my $msg = shift;
exit if !defined $msg;
my($cmd, $args) = $msg =~ /^\s*([a-z]+)(.*)$/;
- return printf "Unknown command '%s'.\n", $cmd||''
- if !$cmd || !$cmd{$cmd};
+ return if !defined $cmd;
+ return printf "Unknown command '%s'.\n", $cmd if !$cmd{$cmd};
$args =~ s/^\s+//;
$args =~ s/\s+$//;
- $cmd{$cmd}->($args);
+ $cmd{$cmd}[0]->($args);
$term->addhistory($msg);
$term->rl_set_prompt(getprompt);
-
- # Flush any object caching in Net::DBus after each command to ensure that we
- # have fresh data on the next command.
- # TODO: Caching is completely disabled this way, even while it certainly
- # isn't such a bad idea in many situations. We probably want to make this
- # caching behaviour configurable.
- if($curobj) {
- # XXX: Undocumented
- $curobj->get_service()->{objects} = {};
- $curobj->{introspected} = 0;
- }
+ flushcache; # TODO: Make configurable
});
+
+# Undo the weird ornament stuff performed in CallbackHandlerInstall().
+$term->rl_set_prompt(getprompt);
+$term->rl_redisplay;
+
+
$reactor->add_read(0, Net::DBus::Callback->new(method => sub { $term->callback_read_char }));