#!/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; } sub Inhibit($self,$name,$reason) { return $self->{__inhibit_cb}->($name,$reason); } sub UnInhibit($self,$cookie) { return $self->{__uninhibit_cb}->($cookie); } }; package Saver { use Moo; use experimental 'signatures'; use curry; use Log::Any '$log'; has reactor => ( is => 'ro', required => 1 ); has bus => ( is => 'lazy', builder => sub { Net::DBus->session() } ); 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, ), ); return; } sub inhibit($self,$name,$reason) { my $cookie; do { $cookie = int(rand(2**31)) } until !exists $self->_inhibits->{$cookie}; $self->_inhibits->{$cookie} = [ $name, $reason ]; $log->debugf( '<%s> stops screensaver for <%s> (cookie %d) - %d active', $name, $reason, $cookie, scalar(keys $self->_inhibits->%*), ); $self->reactor->toggle_timeout($self->_prod_id, 1); return $cookie; } sub uninhibit($self,$cookie) { my $inhibit = delete $self->_inhibits->{$cookie} or return; $log->debugf( '<%s> resumed screensaver for <%s> (cookie %d) - %d left', @$inhibit, $cookie, scalar(keys $self->_inhibits->%*), ); $self->reactor->toggle_timeout($self->_prod_id, 0) unless $self->_inhibits->%*; return; } 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();