mdw@git.distorted.org.uk Git - 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 $PID = undef;
  31 my $STATE = "off"; # `off', `on', `killed'
  32 my $WANT = "off"; # `off', `on', `pause'
  33 my $STOPTIME = undef; # if $WANT eq "pause"
  34 my $NOW = time;
  35
  36 $SIG{CHLD} = sub {
  37   KID: for (;;) {
  38     my $kid = waitpid -1, WNOHANG;
  39     last if $kid <= 0;
  40     if ($kid == $PID) {
  41       mumble "player exited (st = $?)";
  42       $PID = undef; $STATE = "off";
  43     }
  44   }
  45 };
  46
  47 $SIG{TERM} = $SIG{INT} = sub {
  48   kill "TERM", $PID if defined $PID;
  49   exit 0;
  50 };
  51
  52 sub start () { $WANT = "on"; $STOPTIME = undef; }
  53
  54 sub pause () {
  55   if ($WANT eq "on") { $WANT = "pause"; $STOPTIME = $NOW + $PAUSETIME; }
  56 }
  57
  58 sub fix_state () {
  59
  60   ##mumble "state = $STATE ($PID)";
  61   ##mumble "want = $WANT ($STOPTIME <=> $NOW)";
  62
  63   if ($WANT eq "pause" && $NOW >= $STOPTIME) {
  64     $WANT = "off"; $STOPTIME = undef;
  65     mumble "pause time up: stopping" if $STATE eq "on";
  66   }
  67
  68   if ($WANT eq "on" && $STATE eq "off") {
  69     my $kid = fork();
  70     if (!$kid) { exec @ARGV; }
  71     $STATE = "on"; $PID = $kid;
  72     mumble "player wanted but not running: started pid $kid";
  73   } elsif ($WANT eq "off" && $STATE eq "on") {
  74     kill "TERM", $PID;
  75     $STATE = "killed";
  76     mumble "player running but not wanted: killed pid $PID";
  77   }
  78 }
  79
  80 sub watch_status () {
  81   my $sk = connection;
  82
  83   my $pause, my $track = 0;
  84
  85   my $rdin = ""; vec($rdin, fileno($sk), 1) = 1;
  86   my $buffer = "", my @lines = ();
  87
  88   $NOW = time;
  89
  90   my $r = send_command $sk, "playing";
  91   $track = defined $r;
  92
  93   print $sk "log\n";
  94   fcntl $sk, F_SETFL, (fcntl $sk, F_GETFL, 0) | O_NONBLOCK;
  95   WATCH: for (;;) {
  96
  97     if (!$sk) { mumble "eof from server"; last WATCH; }
  98     my $nfd;
  99     SEL: {
 100       eval {
 101         $nfd = select my $rdout = $rdin, undef, undef,
 102           defined($STOPTIME) ? $STOPTIME - $NOW : 60;
 103       };
 104       if ($@ && $@->errno == EINTR) { next SEL; }
 105       elsif ($@) { mumble "error from select: " . $@->errno; last WATCH; }
 106     }
 107     if (!$nfd) {
 108       eval { print $sk "."; flush $sk; };
 109       if ($@) { mumble "error from write: " . $@->errno; last WATCH; }
 110       @lines = ();
 111     } else {
 112       READ: for (;;) {
 113         my ($b, $n);
 114         eval { $n = sysread $sk, $b, 4096; };
 115         if ($@ && $@->errno == EAGAIN) { last READ; }
 116         elsif ($@ && $@->errno == EINTR) { next READ; }
 117         elsif ($@) { mumble "error from read: " . $@->errno; last WATCH; }
 118         elsif (!$n) { close $sk; $sk = undef; last READ; }
 119         else { $buffer .= $b; }
 120       }
 121
 122       @lines = split /\n/, $buffer, -1;
 123       $buffer = pop @lines;
 124     }
 125
 126     for my $line (@lines) {
 127       my @f = split_fields $line;
 128       if ($f[1] eq "state") {
 129         if ($f[2] eq "pause") { mumble "paused"; $pause = 1; }
 130         elsif ($f[2] eq "resume") { mumble "unpaused"; $pause = 0; }
 131       } elsif ($f[1] eq "playing") { mumble "track started"; $track = 1; }
 132       elsif ($f[1] eq "completed") { mumble "track finished"; $track = 0; }
 133     }
 134
 135     $NOW = time;
 136
 137     if ($track && !$pause) { start; } else { pause; }
 138     fix_state;
 139   }
 140 }
 141
 142 sub usage (\*) {
 143   my ($fh) = @_;
 144   print $fh "usage: $PROG [-d] [-u CONFIG] [--] COMMAND ARGS...\n";
 145 }
 146
 147 sub help () {
 148   usage *STDOUT;
 149   print <<EOF;
 150
 151 Command-line options:
 152   -h, --help            Show this help text
 153   -u, --user-config     Set user configuration file
 154 EOF
 155 }
 156
 157 my $bad = 0;
 158 GetOptions
 159   "h|help" => sub { help; exit 0; },
 160   "d|debug" => \$DEBUG,
 161   "u|user-config=s" => \$CONFFILE
 162     or $bad = 1;
 163 @ARGV > 0 or $bad = 1;
 164 if ($bad) { usage *STDERR; exit 2; }
 165
 166 for (;;) {
 167   eval { watch_status; }; mumble "watcher exited: $@";
 168   pause; fix_state;
 169   sleep 5;
 170 }