use strict;
use warnings;
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';
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 {
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}};
next unless $sender && $sender eq $bus_name;
next unless $old && !$new;
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();