chiark - git - mdw - disorder-toys/blob - disorder-ondemand.in

   1 #! @PERL@ -w
   2
   3 use autodie qw{:all};
   4 use strict;
   5
   6 use DisOrder;
   7 use Getopt::Long qw{:config gnu_compat bundling
   8                     require_order no_getopt_compat};
   9 use POSIX qw{:errno_h :fcntl_h :sys_wait_h};
  10
  11 my $CONFFILE = undef;
  12 my $DEBUG = 0;
  13 (my $PROG = $0) =~ s:^.*/::;
  14
  15 sub mumble ($) { print STDERR ";; $_[0]\n" if $DEBUG; }
  16
  17 sub connection () {
  18   my $file = $CONFFILE // "$ENV{HOME}/.disorder/passwd", my $conf;
  19
  20   if (-f $file || defined $CONFFILE)
  21     { $conf = load_config $file; }
  22   else {
  23     $conf = { connect => ["-unix", "/var/lib/disorder/private/socket"],
  24               username => ["root"], password => ["hunoz"] };
  25   }
  26   return connect_to_server %$conf;
  27 }
  28
  29 my $PAUSETIME = 300;
  30 my $CRASHTIME = 10;
  31 my $RESTARTTIME = 0;
  32 my $PID = undef;
  33 my $STATE = "off"; # `off', `on', `killed'
  34 my $WANT = "off"; # `off', `on', `pause'
  35 my $WAKETIME = undef;
  36 my $NOW = time;
  37
  38 $SIG{CHLD} = sub {
  39   $NOW = time;
  40   KID: for (;;) {
  41     my $kid = waitpid -1, WNOHANG;
  42     last if $kid <= 0;
  43     if ($kid == $PID) {
  44       mumble "player exited (st = $?)";
  45       $PID = undef; $STATE = "off";
  46       if ($WANT eq "on" && $RESTARTTIME > $NOW) { $WAKETIME = $RESTARTTIME; }
  47     }
  48   }
  49 };
  50
  51 $SIG{TERM} = $SIG{INT} = sub {
  52   eval { my $pid = $PID; kill "TERM", $pid if defined $pid; };
  53   exit 0;
  54 };
  55
  56 sub start () {
  57   if ($WANT ne "on") {
  58     $WANT = "on";
  59     $WAKETIME = $NOW < $RESTARTTIME ? $RESTARTTIME : undef;
  60   }
  61 }
  62
  63 sub pause () {
  64   if ($WANT eq "on") { $WANT = "pause"; $WAKETIME = $NOW + $PAUSETIME; }
  65 }
  66
  67 sub fix_state () {
  68
  69   ##mumble "state = $STATE ($PID)";
  70   ##mumble "want = $WANT ($WAKETIME <=> $NOW)";
  71
  72   if ($WANT eq "pause" && $NOW >= $WAKETIME) {
  73     $WANT = "off"; $WAKETIME = undef;
  74     mumble "pause time up: stopping" if $STATE eq "on";
  75   }
  76
  77   if ($WANT eq "on" && $STATE eq "off" &&
  78       (!defined($WAKETIME) || $NOW >= $WAKETIME)) {
  79     my $kid = fork();
  80     if (!$kid) { exec @ARGV; }
  81     $STATE = "on"; $PID = $kid; $RESTARTTIME = $NOW + $CRASHTIME;
  82     mumble "player wanted but not running: started pid $kid";
  83   } elsif ($WANT eq "off" && $STATE eq "on") {
  84     kill "TERM", $PID;
  85     $STATE = "killed";
  86     mumble "player running but not wanted: killed pid $PID";
  87   }
  88 }
  89
  90 sub watch_status () {
  91   my $sk = connection;
  92
  93   my $pause, my $track = 0;
  94
  95   my $rdin = ""; vec($rdin, fileno($sk), 1) = 1;
  96   my $buffer = "", my @lines = ();
  97
  98   $NOW = time;
  99
 100   my $r = send_command $sk, "playing";
 101   $track = defined $r;
 102
 103   print $sk "log\n";
 104   fcntl $sk, F_SETFL, (fcntl $sk, F_GETFL, 0) | O_NONBLOCK;
 105   WATCH: for (;;) {
 106
 107     if (!$sk) { mumble "eof from server"; last WATCH; }
 108     my $nfd;
 109     SEL: {
 110       eval {
 111         $nfd = select my $rdout = $rdin, undef, undef,
 112           defined($WAKETIME) ? $WAKETIME - $NOW : 60;
 113       };
 114       if ($@ && $@->errno == EINTR) { next SEL; }
 115       elsif ($@) { mumble "error from select: " . $@->errno; last WATCH; }
 116     }
 117     if (!$nfd) {
 118       eval { print $sk "."; flush $sk; };
 119       if ($@) { mumble "error from write: " . $@->errno; last WATCH; }
 120       @lines = ();
 121     } else {
 122       READ: for (;;) {
 123         my ($b, $n);
 124         eval { $n = sysread $sk, $b, 4096; };
 125         if ($@ && $@->errno == EAGAIN) { last READ; }
 126         elsif ($@ && $@->errno == EINTR) { next READ; }
 127         elsif ($@) { mumble "error from read: " . $@->errno; last WATCH; }
 128         elsif (!$n) { close $sk; $sk = undef; last READ; }
 129         else { $buffer .= $b; }
 130       }
 131
 132       @lines = split /\n/, $buffer, -1;
 133       $buffer = pop(@lines) // "";
 134     }
 135
 136     for my $line (@lines) {
 137       my @f = split_fields $line;
 138       if ($f[1] eq "state") {
 139         if ($f[2] eq "pause") { mumble "paused"; $pause = 1; }
 140         elsif ($f[2] eq "resume") { mumble "unpaused"; $pause = 0; }
 141       } elsif ($f[1] eq "playing") { mumble "track started"; $track = 1; }
 142       elsif ($f[1] eq "completed") { mumble "track finished"; $track = 0; }
 143     }
 144
 145     $NOW = time;
 146
 147     if ($track && !$pause) { start; } else { pause; }
 148     fix_state;
 149   }
 150 }
 151
 152 sub usage (\*) {
 153   my ($fh) = @_;
 154   print $fh "usage: $PROG [-d] [-u CONFIG] [--] COMMAND ARGS...\n";
 155 }
 156
 157 sub help () {
 158   usage *STDOUT;
 159   print <<EOF;
 160
 161 Command-line options:
 162   -h, --help            Show this help text
 163   -u, --user-config     Set user configuration file
 164 EOF
 165 }
 166
 167 my $bad = 0;
 168 GetOptions
 169   "h|help" => sub { help; exit 0; },
 170   "d|debug" => \$DEBUG,
 171   "u|user-config=s" => \$CONFFILE
 172     or $bad = 1;
 173 @ARGV > 0 or $bad = 1;
 174 if ($bad) { usage *STDERR; exit 2; }
 175
 176 for (;;) {
 177   eval { watch_status; }; mumble "watcher exited: $@";
 178   pause; fix_state;
 179   sleep 5;
 180 }