author | Oleksandr Gavenko <gavenkoa@gmail.com> |
Fri, 08 Jan 2021 13:59:23 +0200 | |
changeset 968 | dc543d247f29 |
parent 478 | 2913a8a1a474 |
permissions | -rw-r--r-- |
478
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
1 |
#!/usr/bin/perl -w |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
2 |
|
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
3 |
use lib `fvwm-perllib dir`; |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
4 |
use FVWM::Module; |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
5 |
use General::Parse; |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
6 |
use Net::DBus; |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
7 |
|
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
8 |
# dbus-send --dest=ru.gentoo.KbddService /ru/gentoo/KbddService ru.gentoo.kbdd.set_layout uint32:1 |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
9 |
|
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
10 |
# Net::DBus |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
11 |
my $bus = Net::DBus->session(); |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
12 |
# Net::DBus::RemoteService |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
13 |
my $service = $bus->get_service("ru.gentoo.KbddService"); |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
14 |
# Net::DBus::RemoteObject |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
15 |
my $object = $service->get_object("/ru/gentoo/KbddService"); |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
16 |
|
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
17 |
my $module = new FVWM::Module( |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
18 |
Name => "FvwmKbdd", |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
19 |
Mask => M_STRING, |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
20 |
Debug => 1, |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
21 |
); |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
22 |
|
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
23 |
sub kbdd { |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
24 |
my ($module, $event) = @_; |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
25 |
my ($action, @args) = get_tokens($event->_text); |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
26 |
if ($action eq "hello") { |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
27 |
$module->send("Echo Hello from Kbdd..."); |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
28 |
} elsif ($action eq "hel") { |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
29 |
$module->send("Echo xxx..."); |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
30 |
} elsif ($action eq "kbdd") { |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
31 |
my $no = $args[0]; |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
32 |
if ((0 <= $no) && ($no < 4)) { |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
33 |
$object->set_layout(Net::DBus::dbus_uint32($no)); |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
34 |
} else { |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
35 |
$module->send("Echo Error: Kbdd no " . $no . "is not in 1..4 range"); |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
36 |
} |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
37 |
} elsif ($action eq "stop") { |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
38 |
$module->send("Echo Kbdd exit..."); |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
39 |
$module->terminate; |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
40 |
} else { |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
41 |
$module->send("Echo Kbdd unknown action: " . $action); |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
42 |
} |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
43 |
} |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
44 |
|
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
45 |
$module->addHandler(M_STRING, \&kbdd); |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
46 |
|
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
47 |
$module->send("Echo Kbdd loaded..."); |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
48 |
|
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
49 |
# Terminate itself after 5 sec. |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
50 |
# my $scheduler = $module->track('Scheduler'); |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
51 |
# $scheduler->schedule(5, sub { $module->terminate; }); |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
52 |
|
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
53 |
$module->event_loop; |
2913a8a1a474
Add Fvwm Perl module to send signals to kbdd.
Oleksandr Gavenko <gavenkoa@gmail.com>
parents:
diff
changeset
|
54 |