From 1d4104f4f63e9ff31b04f3af4d1f0a7b92ec1434 Mon Sep 17 00:00:00 2001
From: Yorhel <git@yorhel.nl>
Date: Fri, 14 Jun 2013 11:00:58 +0200
Subject: Add ugly 'call' function to invoke methods

---
 dbush | 46 ++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 42 insertions(+), 4 deletions(-)

(limited to 'dbush')

diff --git a/dbush b/dbush
index 37d9534..e14c52a 100755
--- a/dbush
+++ b/dbush
@@ -6,11 +6,11 @@ use Net::DBus ':typing';
 use Net::DBus::Reactor;
 use Term::ReadLine;
 use Getopt::Long;
+use Data::Dumper 'Dumper';
 
 # TODO: Loading a dbushrc with commands to execute on startup
 # TODO: Ctrl+C handling
-# TODO: Method invocation
-# TODO: Convenient property handling?
+# TODO: Convenient property handling
 # TODO: Capturing/displaying signals
 # TODO: Displaying NameOwnerChanged notifications
 # TODO: Fancy colors everywhere
@@ -39,6 +39,8 @@ my $reactor = Net::DBus::Reactor->main();
 my $curobj; # Current Net::DBus::RemoteObject that we're cd'ed to
 my $objalive; # Whether the service providing $curobj is alive
 
+$Data::Dumper::Terse = 1;
+
 
 # Comparison function for connection names, in order to nicely sort stuff like ":1.10".
 sub name_cmp {
@@ -56,8 +58,8 @@ sub name_cmp {
 
 
 sub getprompt {
-  return '[dbush] ' if !$curobj;
-  sprintf '[%s %s%s] ',
+  return 'dbush=> ' if !$curobj;
+  sprintf '%s %s%s> ',
     $curobj->get_service->get_service_name,
     $curobj->get_object_path,
     $objalive ? '' : ' (dead)';
@@ -280,6 +282,42 @@ cmd introspect => sub {
 };
 
 
+# TODO: Print the return value in a more D-Bus specific form than what Data::Dumper gives
+# TODO: Support specifying an explicit interface
+# TODO: Have argument specified in a custom (space-separated) format instead of using eval()
+# TODO: Allow specifying argument types (currently possible through calling dbus_*(), but that's ugly)
+# TODO: Allow calling methods in an other object (SubObject/Ping)
+# TODO: Allow method invocation without prefixing the command with 'call '
+cmd call => sub {
+  my($cmd, $args) = shift =~ /^([^ ]+)(.*)$/;
+  return print "Not associated with a connection, use 'sw <name>' first\n" if !$curobj;
+  return print "No method name given\n" if !$cmd;
+  my $ins = eval { $curobj->_introspector() }; # XXX: Undocumented
+  return print $@ if !$ins;
+  my @itf = $ins->has_method($cmd);
+
+  # TODO: No need for this check if we can perform the call without relying on
+  # introspection data (e.g. no need to infer argument types)
+  return print "Method '$cmd' does not exist\n" if !@itf;
+  return print "Method '$cmd' is ambiguous; It is specified in multiple interfaces\n" if @itf > 1;
+
+  my($check, @arg) = eval "(1, $args )";
+  return print "Can't parse arguments: $@", if !$check;
+
+  # XXX: Undocumented
+  my($check2, @ret) = eval { (1, $curobj->_call_method(Net::DBus::Annotation::dbus_call_sync, $cmd, $itf[0], 1, @arg)); };
+  return print $@ if !$check2;
+  print Dumper @ret if @ret;
+}, sub {
+  my($cmd, $args) = shift =~ /^([^ ]+)(.*)$/;
+  return () if !$curobj || $args;
+  my $ins = eval { $curobj->_introspector() }; # XXX: Undocumented
+  $cmd ||= '';
+  return () if !$ins;
+  grep /^\Q$cmd/, map $ins->list_methods($_), $ins->list_interfaces;
+};
+
+
 
 
 $term->ReadHistory($histfile);
-- 
cgit v1.2.3