#! @PERL@ -w use autodie qw{:all}; use strict; use DisOrder; use Getopt::Long qw{:config gnu_compat bundling require_order no_getopt_compat}; use POSIX qw{:errno_h :fcntl_h :sys_wait_h}; my $CONFFILE = undef; my $DEBUG = 0; (my $PROG = $0) =~ s:^.*/::; sub mumble ($) { print STDERR ";; $_[0]\n" if $DEBUG; } sub connection () { my $file = $CONFFILE // "$ENV{HOME}/.disorder/passwd", my $conf; if (-f $file || defined $CONFFILE) { $conf = load_config $file; } else { $conf = { connect => ["-unix", "/var/lib/disorder/private/socket"], username => ["root"], password => ["hunoz"] }; } return connect_to_server %$conf; } my $PAUSETIME = 300; my $PID = undef; my $STATE = "off"; # `off', `on', `killed' my $WANT = "off"; # `off', `on', `pause' my $STOPTIME = undef; # if $WANT eq "pause" my $NOW = time; $SIG{CHLD} = sub { KID: for (;;) { my $kid = waitpid -1, WNOHANG; last if $kid <= 0; if ($kid == $PID) { mumble "player exited (st = $?)"; $PID = undef; $STATE = "off"; } } }; $SIG{TERM} = $SIG{INT} = sub { kill "TERM", $PID if defined $PID; exit 0; }; sub start () { $WANT = "on"; $STOPTIME = undef; } sub pause () { if ($WANT eq "on") { $WANT = "pause"; $STOPTIME = $NOW + $PAUSETIME; } } sub fix_state () { ##mumble "state = $STATE ($PID)"; ##mumble "want = $WANT ($STOPTIME <=> $NOW)"; if ($WANT eq "pause" && $NOW >= $STOPTIME) { $WANT = "off"; $STOPTIME = undef; mumble "pause time up: stopping" if $STATE eq "on"; } if ($WANT eq "on" && $STATE eq "off") { my $kid = fork(); if (!$kid) { exec @ARGV; } $STATE = "on"; $PID = $kid; mumble "player wanted but not running: started pid $kid"; } elsif ($WANT eq "off" && $STATE eq "on") { kill "TERM", $PID; $STATE = "killed"; mumble "player running but not wanted: killed pid $PID"; } } sub watch_status () { my $sk = connection; my $pause, my $track = 0; my $rdin = ""; vec($rdin, fileno($sk), 1) = 1; my $buffer = "", my @lines = (); $NOW = time; my $r = send_command $sk, "playing"; $track = defined $r; print $sk "log\n"; fcntl $sk, F_SETFL, (fcntl $sk, F_GETFL, 0) | O_NONBLOCK; WATCH: for (;;) { if (!$sk) { mumble "eof from server"; last WATCH; } my $nfd; SEL: { eval { $nfd = select my $rdout = $rdin, undef, undef, defined($STOPTIME) ? $STOPTIME - $NOW : 60; }; if ($@ && $@->errno == EINTR) { next SEL; } elsif ($@) { mumble "error from select: " . $@->errno; last WATCH; } } if (!$nfd) { eval { print $sk "."; flush $sk; }; if ($@) { mumble "error from write: " . $@->errno; last WATCH; } @lines = (); } else { READ: for (;;) { my ($b, $n); eval { $n = sysread $sk, $b, 4096; }; if ($@ && $@->errno == EAGAIN) { last READ; } elsif ($@ && $@->errno == EINTR) { next READ; } elsif ($@) { mumble "error from read: " . $@->errno; last WATCH; } elsif (!$n) { close $sk; $sk = undef; last READ; } else { $buffer .= $b; } } @lines = split /\n/, $buffer, -1; $buffer = pop @lines; } for my $line (@lines) { my @f = split_fields $line; if ($f[1] eq "state") { if ($f[2] eq "pause") { mumble "paused"; $pause = 1; } elsif ($f[2] eq "resume") { mumble "unpaused"; $pause = 0; } } elsif ($f[1] eq "playing") { mumble "track started"; $track = 1; } elsif ($f[1] eq "completed") { mumble "track finished"; $track = 0; } } $NOW = time; if ($track && !$pause) { start; } else { pause; } fix_state; } } sub usage (\*) { my ($fh) = @_; print $fh "usage: $PROG [-d] [-u CONFIG] [--] COMMAND ARGS...\n"; } sub help () { usage *STDOUT; print < sub { help; exit 0; }, "d|debug" => \$DEBUG, "u|user-config=s" => \$CONFFILE or $bad = 1; @ARGV > 0 or $bad = 1; if ($bad) { usage *STDERR; exit 2; } for (;;) { eval { watch_status; }; mumble "watcher exited: $@"; pause; fix_state; sleep 5; }