diff options
-rwxr-xr-x | dbush | 83 |
1 files changed, 62 insertions, 21 deletions
@@ -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 })); |