Commits

Marcin Kasperski committed b77cee5

Introspection helper

Comments (0)

Files changed (1)

experiments/kwallet_by_dbus_introspect.pl

+#!/usr/bin/perl -w
+
+# See http://stderr.org/doc/kde/HTML/en/kdelibs-apidocs/kwallet/html/classKWallet_1_1Wallet.html
+
+use strict;
+use Net::DBus;
+use Data::Dumper;
+use feature 'say';
+
+my $APP_NAME = "DBUStest";
+
+my $dbus = Net::DBus->session()
+  or die("KWallet not available (can't access DBus)");
+#print "dbus: ", Dumper($dbus);
+say "DBus connected"; 
+
+my $kwallet_svc = $dbus->get_service('org.kde.kwalletd')
+  or die("KWallet not available (can't access KWallet, likely kwalletd not running)");
+#print "kwalletd: ", Dumper($kwallet_svc);
+say "org.kde.kwalletd connected";
+
+my $kwallet = $kwallet_svc->get_object('/modules/kwalletd', 'org.kde.KWallet')
+  or die("Kwallet not available (can't find wallet)");
+#print "kwallet: ", Dumper($kwallet);
+say "/modules/kwalletd connected";
+# $kwallet = $kwallet->as_interface(...);
+
+# This is text name
+my $net_wallet = $kwallet->networkWallet()
+  or die "No net wallet";
+say "net_wallet id: $net_wallet";
+
+my $handle = $kwallet->open($net_wallet, 0, $APP_NAME)
+  or die "No handle";
+say "Opened, handle = $handle";
+
+say "*****************************************************************";
+say "* API information";
+say "*****************************************************************";
+
+use List::MoreUtils qw(pairwise zip);
+
+sub type_spec {
+    my ($val) = @_;
+    if(ref($val) eq 'ARRAY') {
+        return "(" . join(", ", map {type_spec($_)} @$val) . ")";
+    } else {
+        return $val;
+    }
+}    
+
+sub param_spec {
+    my ($name, $type) = @_;
+    return ($name || '') . ': ' . type_spec($type);
+}
+
+say "* Supported interfaces:\n    ", join("\n    ", keys(%{$kwallet->{introspector}->{interfaces}}));
+say "";
+say "* org.kde.KWallet methods:";
+my $methods = $kwallet->{introspector}->{interfaces}->{'org.kde.KWallet'}->{methods};
+foreach my $methodName (sort keys %$methods) {
+    my $spec = $methods->{$methodName};
+    say "";
+    say "$methodName ", $spec->{deprecated} ? "DEPRECATED" : "";
+    say "    Params:";
+    foreach my $paramSpec (pairwise { param_spec($a,$b) } @{$spec->{paramnames}}, @{$spec->{params}}) {
+        say "        $paramSpec";
+    }
+    unless($spec->{no_reply}) {
+        say "    Returns:";
+        foreach my $retSpec (pairwise { param_spec($a,$b) } @{$spec->{returnnames}}, @{$spec->{returns}}) {
+            say "        $retSpec";
+        }
+    } else {
+        say "    No reply";
+    }
+    #print Dumper($spec);
+}
+
+say "*****************************************************************";