From 97841787fed3f656674692b0638fa70fe0857012 Mon Sep 17 00:00:00 2001 From: dakkar Date: Sat, 1 May 2021 10:00:39 +0100 Subject: break it out for distribution --- lib/App/XScreenSaver/DBus.pm | 33 ++++ lib/App/XScreenSaver/DBus/InhibitSleep.pm | 59 +++++++ lib/App/XScreenSaver/DBus/Saver.pm | 134 ++++++++++++++++ lib/App/XScreenSaver/DBus/SaverProxy.pm | 34 +++++ scripts/xscreensaver-dbus | 8 + xscreensaver-dbus | 246 ------------------------------ 6 files changed, 268 insertions(+), 246 deletions(-) create mode 100644 lib/App/XScreenSaver/DBus.pm create mode 100644 lib/App/XScreenSaver/DBus/InhibitSleep.pm create mode 100644 lib/App/XScreenSaver/DBus/Saver.pm create mode 100644 lib/App/XScreenSaver/DBus/SaverProxy.pm create mode 100755 scripts/xscreensaver-dbus delete mode 100755 xscreensaver-dbus diff --git a/lib/App/XScreenSaver/DBus.pm b/lib/App/XScreenSaver/DBus.pm new file mode 100644 index 0000000..10c87fd --- /dev/null +++ b/lib/App/XScreenSaver/DBus.pm @@ -0,0 +1,33 @@ +package App::XScreenSaver::DBus; +use Moo; +use experimental 'signatures'; +use Net::DBus::Reactor; +use App::XScreenSaver::DBus::InhibitSleep; +use App::XScreenSaver::DBus::Saver; + +has reactor => ( + is => 'lazy', + builder => sub { Net::DBus::Reactor->main() }, +); + +has inhibit_sleep => ( + is => 'lazy', + builder => sub { App::XScreenSaver::DBus::InhibitSleep->new() }, +); + +has saver => ( + is => 'lazy', + builder => sub($self) { + App::XScreenSaver::DBus::Saver->new(reactor => $self->reactor); + }, +); + +has log => ( is => 'lazy', builder => sub { Log::Any->get_logger } ); + +sub run($self) { + $self->inhibit_sleep->start(); + $self->saver->start(); + $self->reactor->run; +} + +1; diff --git a/lib/App/XScreenSaver/DBus/InhibitSleep.pm b/lib/App/XScreenSaver/DBus/InhibitSleep.pm new file mode 100644 index 0000000..44f84bc --- /dev/null +++ b/lib/App/XScreenSaver/DBus/InhibitSleep.pm @@ -0,0 +1,59 @@ +package App::XScreenSaver::DBus::InhibitSleep; +use Moo; +use experimental 'signatures'; +use curry; +use Net::DBus; +use Log::Any; + +has bus => ( is => 'lazy', builder => sub { Net::DBus->system() } ); +has logind_srv => ( + is => 'lazy', + builder => sub { shift->bus->get_service('org.freedesktop.login1') }, +); +has logind_obj => ( + is => 'lazy', + builder => sub { shift->logind_srv->get_object('/org/freedesktop/login1') }, +); + +has inhibit_fd => ( is => 'rwp' ); + +has log => ( is => 'lazy', builder => sub { Log::Any->get_logger } ); + +sub start($self) { + $self->logind_obj->connect_to_signal( + 'PrepareForSleep', + $self->curry::weak::going_to_sleep, + ); + $self->inhibit(); + return; +} + +sub inhibit($self) { + return if $self->inhibit_fd; + $self->_set_inhibit_fd( + $self->logind_obj->Inhibit( + 'sleep', + 'xscreensaver','locking before sleep', + 'delay', + ) + ); + $self->log->debugf('got logind inhibit fd %d',$self->inhibit_fd); + return; +} + +sub going_to_sleep($self,$before) { + if ($before) { + $self->log->debug('locking'); + system(qw(xscreensaver-command -suspend)); + $self->log->debug('locked'); + $self->_set_inhibit_fd(undef); + } + else { + $self->log->debug('woken up'); + system(qw(xscreensaver-command -deactivate)); + $self->inhibit(); + } + return; +} + +1; diff --git a/lib/App/XScreenSaver/DBus/Saver.pm b/lib/App/XScreenSaver/DBus/Saver.pm new file mode 100644 index 0000000..6ae6e69 --- /dev/null +++ b/lib/App/XScreenSaver/DBus/Saver.pm @@ -0,0 +1,134 @@ +package App::XScreenSaver::DBus::Saver; +use Moo; +use experimental 'signatures'; +use curry; +use Log::Any; +use Try::Tiny; +use App::XScreenSaver::DBus::SaverProxy; + +has reactor => ( is => 'ro', required => 1 ); +has bus => ( is => 'lazy', builder => sub { Net::DBus->session() } ); +has dbus_srv => ( + is => 'lazy', + builder => sub { shift->bus->get_service('org.freedesktop.DBus') }, +); +has dbus_obj => ( + is => 'lazy', + builder => sub { shift->dbus_srv->get_object('/org/freedesktop/DBus') }, +); + +has service => ( + is => 'lazy', + builder => sub { + # this is the service name + shift->bus->export_service('org.freedesktop.ScreenSaver'); + }, +); +has paths => ( + is => 'ro', + default => sub { [qw(/ScreenSaver /org/freedesktop/ScreenSaver)] }, +); + +has log => ( is => 'lazy', builder => sub { Log::Any->get_logger } ); + +has _impls => ( is => 'rw' ); +has _prod_id => ( is => 'rw' ); +has _inhibits => ( is => 'rw', default => sub { +{} } ); + +sub start($self) { + my $inhibit_cb = $self->curry::weak::inhibit; + my $uninhibit_cb = $self->curry::weak::uninhibit; + + $self->_impls([ map { + App::XScreenSaver::DBus::SaverProxy->new( + $self->service, + $_, + $inhibit_cb, + $uninhibit_cb, + ) + } $self->paths->@* ]); + + $self->_prod_id( + $self->reactor->add_timeout( + 60_000, + Net::DBus::Callback->new( + method => $self->curry::weak::prod_screensaver + ), + 0, + ), + ); + + $self->dbus_obj->connect_to_signal( + 'NameOwnerChanged', + $self->curry::weak::name_owner_changed, + ); + + return; +} + +sub inhibit($self,$name,$reason,$message) { + my $cookie; + do { + $cookie = int(rand(2**31)) + } until !exists $self->_inhibits->{$cookie}; + + my $sender = $message->get_sender; + $self->_inhibits->{$cookie} = [ $name, $reason, $sender ]; + + $self->log->debugf( + '<%s> (%s) stops screensaver for <%s> (cookie %d) - %d active', + $name, $sender, $reason, $cookie, scalar(keys $self->_inhibits->%*), + ); + $self->reactor->toggle_timeout($self->_prod_id, 1); + + return $cookie; +} + +sub uninhibit($self,$cookie,$message) { + my $inhibit = delete $self->_inhibits->{$cookie} + or return; + my ($name, $reason, $sender) = @$inhibit; + my $this_sender = $message->get_sender; + + $self->log->debugf( + '<%s> (was %s, is %s) resumed screensaver for <%s> (cookie %d) - %d left', + $name, $sender, $this_sender, $reason, $cookie, scalar(keys $self->_inhibits->%*), + ); + + $self->reactor->toggle_timeout($self->_prod_id, 0) + unless $self->_inhibits->%*; + + return; +} + +sub name_owner_changed($self,$bus_name,$old,$new) { + $self->log->tracef('<%s> changed from <%s> to <%s>', + $bus_name, $old, $new); + + for my $cookie (sort keys $self->_inhibits->%*) { + my ($name, $reason, $sender) = @{$self->_inhibits->{$cookie}}; + # is this inhibit from that bus name? + next unless $sender && $sender eq $bus_name; + # did the bus owner just disconnect? + next unless $old && !$new; + + # if so, remove the inhibit + my $inhibit = delete $self->_inhibits->{$cookie}; + + $self->log->debugf( + '<%s> (%s) disconnected from the bus (it stopped screensaver for <%s>, cookie %d) - %d left', + $name, $bus_name, $reason, $cookie, scalar(keys $self->_inhibits->%*), + ); + } + + unless ($self->_inhibits->%*) { + $self->reactor->toggle_timeout($self->_prod_id, 0); + } +} + +sub prod_screensaver($self) { + $self->log->debug('prodding xscreensaver'); + system(qw(xscreensaver-command -deactivate)); +} + +1; diff --git a/lib/App/XScreenSaver/DBus/SaverProxy.pm b/lib/App/XScreenSaver/DBus/SaverProxy.pm new file mode 100644 index 0000000..d098045 --- /dev/null +++ b/lib/App/XScreenSaver/DBus/SaverProxy.pm @@ -0,0 +1,34 @@ +package App::XScreenSaver::DBus::SaverProxy; +use strict; +use warnings; +use experimental 'signatures'; +# this is the interface name +use Net::DBus::Exporter qw(org.freedesktop.ScreenSaver); +use parent 'Net::DBus::Object'; + +dbus_method('Inhibit',['string','string'],['uint32']); +dbus_method('UnInhibit',['uint32'],[]); + +sub new($class,$service,$path,$inhibit_cb,$uninhibit_cb) { + my $self = $class->SUPER::new($service, $path); + bless $self, $class; + $self->{__inhibit_cb} = $inhibit_cb; + $self->{__uninhibit_cb} = $uninhibit_cb; + return $self; +} + +our $_message; +sub _dispatch_object($self,$connection,$message,@etc) { + local $_message = $message; + return $self->SUPER::_dispatch_object($connection,$message,@etc); +} + +sub Inhibit($self,$name,$reason) { + return $self->{__inhibit_cb}->($name,$reason,$_message); +} + +sub UnInhibit($self,$cookie) { + return $self->{__uninhibit_cb}->($cookie,$_message); +} + +1; diff --git a/scripts/xscreensaver-dbus b/scripts/xscreensaver-dbus new file mode 100755 index 0000000..5e188f2 --- /dev/null +++ b/scripts/xscreensaver-dbus @@ -0,0 +1,8 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Log::Any::Adapter Stdout => ( log_level => 'debug' ); +use App::XScreenSaver::DBus; + +$|++; +App::XScreenSaver::DBus->new->run; diff --git a/xscreensaver-dbus b/xscreensaver-dbus deleted file mode 100755 index d3b51c5..0000000 --- a/xscreensaver-dbus +++ /dev/null @@ -1,246 +0,0 @@ -#!/home/dakkar/perl5/perlbrew/perls/perl-5.32.0/bin/perl -use strict; -use warnings; - -=pod - -see https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=781961 - -https://www.freedesktop.org/wiki/Software/systemd/inhibit/ - -https://stackoverflow.com/questions/460140/is-there-a-decent-way-to-inhibit-screensavers-in-linux - -https://github.com/mato/xscreensaver-systemd/blob/master/xscreensaver-systemd.c - -=cut - -package SleepInhibit { - use Moo; - use experimental 'signatures'; - use curry; - use Net::DBus; - use Log::Any '$log'; - - has bus => ( is => 'lazy', builder => sub { Net::DBus->system() } ); - has logind_srv => ( - is => 'lazy', - builder => sub { shift->bus->get_service('org.freedesktop.login1') }, - ); - has logind_obj => ( - is => 'lazy', - builder => sub { shift->logind_srv->get_object('/org/freedesktop/login1') }, - ); - - has inhibit_fd => ( is => 'rwp' ); - - sub start($self) { - $self->logind_obj->connect_to_signal( - 'PrepareForSleep', - $self->curry::weak::going_to_sleep, - ); - $self->inhibit(); - return; - } - - sub inhibit($self) { - return if $self->inhibit_fd; - $self->_set_inhibit_fd( - $self->logind_obj->Inhibit( - 'sleep', - 'xscreensaver','locking before sleep', - 'delay', - ) - ); - $log->debugf('got logind inhibit fd %d',$self->inhibit_fd); - return; - } - - sub going_to_sleep($self,$before) { - if ($before) { - $log->debug('locking'); - system(qw(xscreensaver-command -suspend)); - $log->debug('locked'); - $self->_set_inhibit_fd(undef); - } - else { - $log->debug('woken up'); - system(qw(xscreensaver-command -deactivate)); - $self->inhibit(); - } - return; - } -}; - -package SaverImpl { - use strict; - use warnings; - use experimental 'signatures'; - # this is the interface name - use Net::DBus::Exporter qw(org.freedesktop.ScreenSaver); - use parent 'Net::DBus::Object'; - - dbus_method('Inhibit',['string','string'],['uint32']); - dbus_method('UnInhibit',['uint32'],[]); - - sub new($class,$service,$path,$inhibit_cb,$uninhibit_cb) { - my $self = $class->SUPER::new($service, $path); - bless $self, $class; - $self->{__inhibit_cb} = $inhibit_cb; - $self->{__uninhibit_cb} = $uninhibit_cb; - return $self; - } - - our $_message; - sub _dispatch_object($self,$connection,$message,@etc) { - local $_message = $message; - return $self->SUPER::_dispatch_object($connection,$message,@etc); - } - - sub Inhibit($self,$name,$reason) { - return $self->{__inhibit_cb}->($name,$reason,$_message); - } - - sub UnInhibit($self,$cookie) { - return $self->{__uninhibit_cb}->($cookie,$_message); - } -}; - -package Saver { - use Moo; - use experimental 'signatures'; - use curry; - use Log::Any '$log'; - use Try::Tiny; - - has reactor => ( is => 'ro', required => 1 ); - has bus => ( is => 'lazy', builder => sub { Net::DBus->session() } ); - has dbus_srv => ( is => 'lazy', builder => sub { shift->bus->get_service('org.freedesktop.DBus') }); - has dbus_obj => ( is => 'lazy', builder => sub { shift->dbus_srv->get_object('/org/freedesktop/DBus') }); - - has service => ( - is => 'lazy', - builder => sub { - # this is the service name - shift->bus->export_service('org.freedesktop.ScreenSaver'); - }, - ); - has paths => ( - is => 'ro', - default => sub { [qw(/ScreenSaver /org/freedesktop/ScreenSaver)] }, - ); - - has _impls => ( is => 'rw' ); - has _prod_id => ( is => 'rw' ); - has _inhibits => ( is => 'rw', default => sub { +{} } ); - - sub start($self) { - my $inhibit_cb = $self->curry::weak::inhibit; - my $uninhibit_cb = $self->curry::weak::uninhibit; - - $self->_impls([ map { - SaverImpl->new( - $self->service, - $_, - $inhibit_cb, - $uninhibit_cb, - ) - } $self->paths->@* ]); - - $self->_prod_id( - $self->reactor->add_timeout( - 60_000, - Net::DBus::Callback->new( - method => $self->curry::weak::prod_screensaver - ), - 0, - ), - ); - - $self->dbus_obj->connect_to_signal( - 'NameOwnerChanged', - $self->curry::weak::name_owner_changed, - ); - - return; - } - - sub inhibit($self,$name,$reason,$message) { - my $cookie; - do { - $cookie = int(rand(2**31)) - } until !exists $self->_inhibits->{$cookie}; - - my $sender = $message->get_sender; - $self->_inhibits->{$cookie} = [ $name, $reason, $sender ]; - - $log->debugf( - '<%s> (%s) stops screensaver for <%s> (cookie %d) - %d active', - $name, $sender, $reason, $cookie, scalar(keys $self->_inhibits->%*), - ); - $self->reactor->toggle_timeout($self->_prod_id, 1); - - return $cookie; - } - - sub uninhibit($self,$cookie,$message) { - my $inhibit = delete $self->_inhibits->{$cookie} - or return; - my ($name, $reason, $sender) = @$inhibit; - my $this_sender = $message->get_sender; - - $log->debugf( - '<%s> (was %s, is %s) resumed screensaver for <%s> (cookie %d) - %d left', - $name, $sender, $this_sender, $reason, $cookie, scalar(keys $self->_inhibits->%*), - ); - - $self->reactor->toggle_timeout($self->_prod_id, 0) - unless $self->_inhibits->%*; - - return; - } - - sub name_owner_changed($self,$bus_name,$old,$new) { - $log->tracef('<%s> changed from <%s> to <%s>', - $bus_name, $old, $new); - - for my $cookie (sort keys $self->_inhibits->%*) { - my ($name, $reason, $sender) = @{$self->_inhibits->{$cookie}}; - # is this inhibit from that bus name? - next unless $sender && $sender eq $bus_name; - # did the bus owner just disconnect? - next unless $old && !$new; - - # if so, remove the inhibit - my $inhibit = delete $self->_inhibits->{$cookie}; - - $log->debugf( - '<%s> (%s) disconnected from the bus (it stopped screensaver for <%s>, cookie %d) - %d left', - $name, $bus_name, $reason, $cookie, scalar(keys $self->_inhibits->%*), - ); - } - - unless ($self->_inhibits->%*) { - $self->reactor->toggle_timeout($self->_prod_id, 0); - } - } - - sub prod_screensaver($self) { - $log->debug('prodding xscreensaver'); - system(qw(xscreensaver-command -deactivate)); - } -}; - -use Net::DBus::Reactor; -use Log::Any::Adapter Stdout => ( log_level => 'debug' ); - -$|++; - -my $reactor = Net::DBus::Reactor->main(); - -my $sleep = SleepInhibit->new(); -$sleep->start(); - -my $saver = Saver->new(reactor => $reactor); -$saver->start(); - -$reactor->run(); -- cgit v1.2.3