[profile] / bin / disorder-notify

#! /usr/bin/perl -w

use autodie qw{:all};
use strict;

use DisOrder;
use File::FcntlLock;
use POSIX qw{:errno_h :fcntl_h};

###--------------------------------------------------------------------------
### Configuration.

my %C = (config => "$ENV{HOME}/.disorder/passwd",
	 lockdir => "$ENV{HOME}/.disorder/",
	 mixer => "Master,0");

my $TITLE = "DisOrder";
my $VARIANT = "default";
if (-l $C{config} && (my $t = readlink $C{config}) =~ /^passwd\.(.*)$/)
  { $VARIANT = $1; $TITLE .= " ($1)"; }

###--------------------------------------------------------------------------
### Random utilities.

sub run_discard_output (@) {
  my $kid = fork();
  if (!$kid) {
    open STDOUT, ">/dev/null" or die "open /dev/null: $!";
    exec @_;
  }
  waitpid $kid, 0;
  if ($?) {
    my $st;
    if ($? >= 256) { $st = sprintf "rc = %d", $? >> 8; }
    else { $st = sprintf "signal %d", $?; }
    die "$_[0] failed ($st)";
  }
}

sub notify ($$) {
  my ($head, $body) = @_;

  $body =~ s:\&:&amp;:g;
  $body =~ s:\<:&lt;:g;
  $body =~ s:\>:&gt;:g;

  ##print "****************\n$head\n\n$body\n"; return;

  run_discard_output "notify-send",
    "-c", "DisOrder", "-i", "audio-volume-high", "-t", "5000",
    $head, $body;
}

sub try_unlink ($) {
  my ($f) = @_;
  eval { unlink $f; };
  die $@ if $@ and $@->errno != ENOENT;
}

###--------------------------------------------------------------------------
### Locking protocol.

my $LKFILE = "$C{lockdir}/disorder-notify-$VARIANT.lock";
my $LKFH;

sub locked_by () {

  ## Try to open the lock file.  If it's not there, then obviously it's not
  ## locked.
  my $fh;
  eval { open $fh, "<", $LKFILE; };
  if ($@) {
    return undef if $@->errno == ENOENT;
    die $@;
  }

  ## Take out a non-exclusive lock on the lock file.
  my $lk = new File::FcntlLock;
  $lk->l_type(F_RDLCK); $lk->l_whence(SEEK_SET);
  $lk->l_start(0); $lk->l_len(0);
  if ($lk->lock($fh, F_SETLK)) { close $fh; return undef; }

  ## Read the pid of the current lock-holder.
  chomp (my $pid = (readline $fh) // "<unknown>");
  close $fh;
  return $pid;
}

sub claim_lock () {
  sysopen my $fh, $LKFILE, O_CREAT | O_WRONLY;

  my $lk = new File::FcntlLock;
  $lk->l_type(F_WRLCK); $lk->l_whence(SEEK_SET);
  $lk->l_start(0); $lk->l_len(0);
  if (!$lk->lock($fh, F_SETLK)) {
    return undef if $! == EAGAIN;
    die "failed to lock `$LKFILE': $!";
  }

  truncate $fh, 0;
  print $fh "$$\n";
  flush $fh;
  $LKFH = $fh;
  1;
}

###--------------------------------------------------------------------------
### DisOrder utilities.

sub get_state0 ($) {
  my ($sk) = @_;
  my %st = ();

  LINE: for (;;) {
    my @f = split_fields readline $sk;
    if ($f[1] ne "state") { last LINE; }
    elsif ($f[2] eq "enable_random") { $st{random} = 1; }
    elsif ($f[2] eq "disable_random") { $st{random} = 0; }
    elsif ($f[2] eq "enable_play") { $st{play} = 1; }
    elsif ($f[2] eq "disable_play") { $st{play} = 0; }
    elsif ($f[2] eq "resume") { $st{pause} = 0; }
    elsif ($f[2] eq "pause") { $st{pause} = 1; }
  }
  return \%st;
}

sub get_state () {
  my $sk = connect_to_server $C{config};
  send_command0 $sk, "log";
  my $st = get_state0 $sk;
  close $sk;
  return $st;
}

sub decode_track_name ($\%) {
  my ($sk, $info) = @_;
  return unless exists $info->{track};
  my $track = $info->{track};
  for my $i ("artist", "album", "title") {
    my @f = split_fields send_command $sk, "part", $track, "display", "$i";
    $info->{$i} = $f[0];
  }
}

sub format_now_playing (\%) {
  my ($info) = @_;
  exists $info->{track} or return "Nothing.";
  my $r = "$info->{artist}: ‘$info->{title}’";
  $r .= ", from ‘$info->{album}’" if $info->{album};
  $r .= "\n(chosen by $info->{submitter})" if exists $info->{submitter};
  return $r;
}

sub get_now_playing ($) {
  my ($sk) = @_;
  my $r = send_command $sk, "playing";
  defined $r or return {};
  my %info = split_fields $r;
  decode_track_name $sk, %info;
  return \%info;
}

sub watch_and_notify0 ($) {
  my ($now_playing) = @_;

  my $sk = connect_to_server $C{config}, 1;
  my $sk_log = connect_to_server $C{config}, 1;

  send_command0 $sk_log, "log";
  my $st = get_state0 $sk_log;
  my $msg = "playing " . ($st->{play} ? "enabled" : "disabled");
  $msg .= "; random play " . ($st->{random} ? "enabled" : "disabled");
  $msg .= "; " . ($st->{pause} ? "paused" : "playing");
  notify "$TITLE state", "Connected: $msg";
  if ($st->{play} && $now_playing) {
    my $info = get_now_playing $sk;
    notify "$TITLE: Now playing", format_now_playing %$info;
  }

  while (my $line = readline $sk_log) {
    my @f = split_fields $line;

    if ($f[1] eq "state") {
      my $msg = undef;
      if ($f[2] eq "disable_random") { $msg = "Random play disabled"; }
      elsif ($f[2] eq "enable_random") { $msg = "Random play enabled"; }
      elsif ($f[2] eq "disable_play") { $msg = "Playing disabled"; }
      elsif ($f[2] eq "enable_play") { $msg = "Playing enabled"; }
      elsif ($f[2] eq "pause") { $msg = "Paused"; }
      elsif ($f[2] eq "resume") { $msg = "Playing"; }
      notify "$TITLE state", $msg if defined $msg;
    } elsif ($f[1] eq "playing") {
      my %info;
      $info{track} = $f[2];
      $info{submitter} = $f[3] if @f > 3;
      decode_track_name $sk, %info;
      notify "$TITLE: Now playing", format_now_playing %info;
    } elsif ($f[1] eq "scratched") {
      my %info;
      $info{track} = $f[2];
      decode_track_name $sk, %info;
      notify "$TITLE: Scratched by $f[3]", format_now_playing %info;
    }
  }

  notify "$TITLE state", "Lost connection";

  close $sk;
  close $sk_log;
}

sub watch_and_notify ($) {
  my ($now_playing) = @_;

  fork and exit 0;
  claim_lock or exit 1;

  for (;;) {
    eval { watch_and_notify0 $now_playing; };
    $now_playing = 1;
    sleep 5;
  }
}

###--------------------------------------------------------------------------
### User-facing operations.

my %OP;

$OP{"volume-up"} =
  sub { run_discard_output "amixer", "sset", $C{mixer}, "5\%+"; };
$OP{"volume-down"} =
  sub { run_discard_output "amixer", "sset", $C{mixer}, "5\%-"; };

$OP{"scratch"} = sub {
  my $sk = connect_to_server $C{config};
  send_command $sk, "scratch";
  close $sk;
};

$OP{"enable/disable"} = sub {
  my $st = get_state;
  my $sk = connect_to_server $C{config};
  if ($st->{play}) { send_command $sk, "disable"; }
  else { send_command $sk, "enable"; }
  close $sk;
};

$OP{"play/pause"} = sub {
  my $st = get_state;
  my $sk = connect_to_server $C{config};
  if (!$st->{play}) {
    send_command $sk, "enable";
    if ($st->{pause}) { send_command $sk, "resume"; }
  } else {
    if ($st->{pause}) { send_command $sk, "resume"; }
    else { send_command $sk, "pause"; }
  }
  close $sk;
};

$OP{"watch"} = sub {
  if (defined (my $lkpid = locked_by)) {
    print STDERR "$0: already watched by pid $lkpid\n";
    exit 2;
  }
  watch_and_notify 1;
};

$OP{"now-playing"} = sub {
  my $sk = connect_to_server $C{config};
  my $info = get_now_playing $sk;
  close $sk;
  print format_now_playing %$info;
  print "\n";
};

$OP{"notify-now-playing"} = sub {
  my $sk = connect_to_server $C{config};
  my $info = get_now_playing $sk;
  close $sk;
  notify "$TITLE: Now playing", format_now_playing %$info;
  defined locked_by or watch_and_notify 0;
};

###--------------------------------------------------------------------------
### Main program.

if (@ARGV != 1) { print STDERR "usage: $0 OP\n"; exit 2; }
my $op = $ARGV[0];
if (!exists $OP{$op}) { print STDERR "$0: unknown op `$op'\n"; exit 2; }
$OP{$op}();

###----- That's all, folks --------------------------------------------------
Commit	Line	Data
a1b30762 MW	1	#! /usr/bin/perl -w
	2
	3	use autodie qw{:all};
	4	use strict;
	5
	6	use DisOrder;
	7	use File::FcntlLock;
	8	use POSIX qw{:errno_h :fcntl_h};
	9
	10	###--------------------------------------------------------------------------
	11	### Configuration.
	12
	13	my %C = (config => "$ENV{HOME}/.disorder/passwd",
	14	lockdir => "$ENV{HOME}/.disorder/",
	15	mixer => "Master,0");
	16
	17	my $TITLE = "DisOrder";
	18	my $VARIANT = "default";
	19	if (-l $C{config} && (my $t = readlink $C{config}) =~ /^passwd\.(.*)$/)
	20	{ $VARIANT = $1; $TITLE .= " ($1)"; }
	21
	22	###--------------------------------------------------------------------------
	23	### Random utilities.
	24
	25	sub run_discard_output (@) {
	26	my $kid = fork();
	27	if (!$kid) {
	28	open STDOUT, ">/dev/null" or die "open /dev/null: $!";
	29	exec @_;
	30	}
	31	waitpid $kid, 0;
	32	if ($?) {
	33	my $st;
	34	if ($? >= 256) { $st = sprintf "rc = %d", $? >> 8; }
	35	else { $st = sprintf "signal %d", $?; }
	36	die "$_[0] failed ($st)";
	37	}
	38	}
6bdf3aad MW	39
	40	sub notify ($$) {
	41	my ($head, $body) = @_;
	42
0452eefc MW	43	$body =~ s:\&:&:g;
	44	$body =~ s:\<:<:g;
	45	$body =~ s:\>:>:g;
a1b30762 MW	46
	47	##print "****************\n$head\n\n$body\n"; return;
	48
	49	run_discard_output "notify-send",
	50	"-c", "DisOrder", "-i", "audio-volume-high", "-t", "5000",
	51	$head, $body;
	52	}
	53
	54	sub try_unlink ($) {
	55	my ($f) = @_;
	56	eval { unlink $f; };
	57	die $@ if $@ and $@->errno != ENOENT;
	58	}
	59
	60	###--------------------------------------------------------------------------
	61	### Locking protocol.
	62
	63	my $LKFILE = "$C{lockdir}/disorder-notify-$VARIANT.lock";
	64	my $LKFH;
	65
	66	sub locked_by () {
	67
	68	## Try to open the lock file. If it's not there, then obviously it's not
	69	## locked.
	70	my $fh;
	71	eval { open $fh, "<", $LKFILE; };
	72	if ($@) {
	73	return undef if $@->errno == ENOENT;
	74	die $@;
6bdf3aad	75	}
a1b30762 MW	76
	77	## Take out a non-exclusive lock on the lock file.
	78	my $lk = new File::FcntlLock;
	79	$lk->l_type(F_RDLCK); $lk->l_whence(SEEK_SET);
	80	$lk->l_start(0); $lk->l_len(0);
	81	if ($lk->lock($fh, F_SETLK)) { close $fh; return undef; }
	82
	83	## Read the pid of the current lock-holder.
	84	chomp (my $pid = (readline $fh) // "<unknown>");
	85	close $fh;
	86	return $pid;
6bdf3aad MW	87	}
6bdf3aad MW	88
a1b30762 MW	89	sub claim_lock () {
	90	sysopen my $fh, $LKFILE, O_CREAT \| O_WRONLY;
	91
	92	my $lk = new File::FcntlLock;
	93	$lk->l_type(F_WRLCK); $lk->l_whence(SEEK_SET);
	94	$lk->l_start(0); $lk->l_len(0);
	95	if (!$lk->lock($fh, F_SETLK)) {
	96	return undef if $! == EAGAIN;
	97	die "failed to lock `$LKFILE': $!";
	98	}
	99
	100	truncate $fh, 0;
	101	print $fh "$$\n";
	102	flush $fh;
	103	$LKFH = $fh;
	104	1;
994838b7 MW	105	}
994838b7 MW	106
a1b30762 MW	107	###--------------------------------------------------------------------------
	108	### DisOrder utilities.
	109
	110	sub get_state0 ($) {
	111	my ($sk) = @_;
	112	my %st = ();
	113
	114	LINE: for (;;) {
	115	my @f = split_fields readline $sk;
	116	if ($f[1] ne "state") { last LINE; }
	117	elsif ($f[2] eq "enable_random") { $st{random} = 1; }
	118	elsif ($f[2] eq "disable_random") { $st{random} = 0; }
	119	elsif ($f[2] eq "enable_play") { $st{play} = 1; }
	120	elsif ($f[2] eq "disable_play") { $st{play} = 0; }
	121	elsif ($f[2] eq "resume") { $st{pause} = 0; }
	122	elsif ($f[2] eq "pause") { $st{pause} = 1; }
a367c2fe	123	}
a1b30762	124	return \%st;
f1b1fa59 MW	125	}
f1b1fa59 MW	126
a1b30762 MW	127	sub get_state () {
	128	my $sk = connect_to_server $C{config};
	129	send_command0 $sk, "log";
	130	my $st = get_state0 $sk;
	131	close $sk;
	132	return $st;
	133	}
	134
	135	sub decode_track_name ($\%) {
	136	my ($sk, $info) = @_;
	137	return unless exists $info->{track};
	138	my $track = $info->{track};
	139	for my $i ("artist", "album", "title") {
	140	my @f = split_fields send_command $sk, "part", $track, "display", "$i";
	141	$info->{$i} = $f[0];
	142	}
	143	}
	144
	145	sub format_now_playing (\%) {
	146	my ($info) = @_;
	147	exists $info->{track} or return "Nothing.";
	148	my $r = "$info->{artist}: ‘$info->{title}’";
	149	$r .= ", from ‘$info->{album}’" if $info->{album};
	150	$r .= "\n(chosen by $info->{submitter})" if exists $info->{submitter};
	151	return $r;
	152	}
	153
	154	sub get_now_playing ($) {
	155	my ($sk) = @_;
	156	my $r = send_command $sk, "playing";
	157	defined $r or return {};
	158	my %info = split_fields $r;
	159	decode_track_name $sk, %info;
	160	return \%info;
	161	}
	162
	163	sub watch_and_notify0 ($) {
	164	my ($now_playing) = @_;
	165
	166	my $sk = connect_to_server $C{config}, 1;
	167	my $sk_log = connect_to_server $C{config}, 1;
	168
	169	send_command0 $sk_log, "log";
	170	my $st = get_state0 $sk_log;
	171	my $msg = "playing " . ($st->{play} ? "enabled" : "disabled");
	172	$msg .= "; random play " . ($st->{random} ? "enabled" : "disabled");
	173	$msg .= "; " . ($st->{pause} ? "paused" : "playing");
	174	notify "$TITLE state", "Connected: $msg";
	175	if ($st->{play} && $now_playing) {
	176	my $info = get_now_playing $sk;
	177	notify "$TITLE: Now playing", format_now_playing %$info;
	178	}
	179
	180	while (my $line = readline $sk_log) {
	181	my @f = split_fields $line;
	182
	183	if ($f[1] eq "state") {
	184	my $msg = undef;
	185	if ($f[2] eq "disable_random") { $msg = "Random play disabled"; }
	186	elsif ($f[2] eq "enable_random") { $msg = "Random play enabled"; }
	187	elsif ($f[2] eq "disable_play") { $msg = "Playing disabled"; }
	188	elsif ($f[2] eq "enable_play") { $msg = "Playing enabled"; }
	189	elsif ($f[2] eq "pause") { $msg = "Paused"; }
	190	elsif ($f[2] eq "resume") { $msg = "Playing"; }
191	notify "$TITLE state", $msg if defined $msg;
192	} elsif ($f[1] eq "playing") {
193	my %info;
194	$info{track} = $f[2];
195	$info{submitter} = $f[3] if @f > 3;
196	decode_track_name $sk, %info;
197	notify "$TITLE: Now playing", format_now_playing %info;
198	} elsif ($f[1] eq "scratched") {
199	my %info;
200	$info{track} = $f[2];
201	decode_track_name $sk, %info;
202	notify "$TITLE: Scratched by $f[3]", format_now_playing %info;
6bdf3aad MW	203	}
6bdf3aad MW	204	}
a1b30762 MW	205
	206	notify "$TITLE state", "Lost connection";
	207
	208	close $sk;
	209	close $sk_log;
6bdf3aad	210	}
a1b30762 MW	211
	212	sub watch_and_notify ($) {
	213	my ($now_playing) = @_;
	214
	215	fork and exit 0;
	216	claim_lock or exit 1;
	217
	218	for (;;) {
	219	eval { watch_and_notify0 $now_playing; };
	220	$now_playing = 1;
	221	sleep 5;
	222	}
	223	}
	224
	225	###--------------------------------------------------------------------------
	226	### User-facing operations.
	227
	228	my %OP;
	229
	230	$OP{"volume-up"} =
	231	sub { run_discard_output "amixer", "sset", $C{mixer}, "5\%+"; };
	232	$OP{"volume-down"} =
	233	sub { run_discard_output "amixer", "sset", $C{mixer}, "5\%-"; };
	234
	235	$OP{"scratch"} = sub {
	236	my $sk = connect_to_server $C{config};
	237	send_command $sk, "scratch";
	238	close $sk;
	239	};
	240
	241	$OP{"enable/disable"} = sub {
	242	my $st = get_state;
	243	my $sk = connect_to_server $C{config};
	244	if ($st->{play}) { send_command $sk, "disable"; }
	245	else { send_command $sk, "enable"; }
	246	close $sk;
	247	};
	248
	249	$OP{"play/pause"} = sub {
	250	my $st = get_state;
	251	my $sk = connect_to_server $C{config};
	252	if (!$st->{play}) {
	253	send_command $sk, "enable";
	254	if ($st->{pause}) { send_command $sk, "resume"; }
	255	} else {
	256	if ($st->{pause}) { send_command $sk, "resume"; }
	257	else { send_command $sk, "pause"; }
	258	}
	259	close $sk;
	260	};
	261
	262	$OP{"watch"} = sub {
	263	if (defined (my $lkpid = locked_by)) {
	264	print STDERR "$0: already watched by pid $lkpid\n";
	265	exit 2;
	266	}
	267	watch_and_notify 1;
	268	};
	269
	270	$OP{"now-playing"} = sub {
	271	my $sk = connect_to_server $C{config};
	272	my $info = get_now_playing $sk;
	273	close $sk;
	274	print format_now_playing %$info;
275	print "\n";
276	};
277
278	$OP{"notify-now-playing"} = sub {
279	my $sk = connect_to_server $C{config};
280	my $info = get_now_playing $sk;
281	close $sk;
282	notify "$TITLE: Now playing", format_now_playing %$info;
283	defined locked_by or watch_and_notify 0;
284	};
285
286	###--------------------------------------------------------------------------
287	### Main program.
288
289	if (@ARGV != 1) { print STDERR "usage: $0 OP\n"; exit 2; }
290	my $op = $ARGV[0];
291	if (!exists $OP{$op}) { print STDERR "$0: unknown op `$op'\n"; exit 2; }
292	$OP{$op}();
293
294	###----- That's all, folks --------------------------------------------------