mpdexec.pl

   1 #!/usr/bin/env perl
   2 #
   3 # Copyright © 2012,2019 Nick Bowler
   4 #
   5 # Simple program to send a command to MPD.  Each command-line argument is
   6 # quoted as necessary so it appears as a single argument at the protocol
   7 # level.  The result is printed to standard output.
   8 #
   9 # License WTFPL2: Do What The Fuck You Want To Public License, version 2.
  10 # This is free software: you are free to do what the fuck you want to.
  11 # There is NO WARRANTY, to the extent permitted by law.
  12
  13 use strict;
  14
  15 use utf8;
  16
  17 use Encode::Locale qw(decode_argv);
  18 decode_argv(Encode::FB_CROAK);
  19
  20 binmode(STDOUT, ":utf8");
  21 binmode(STDIN, ":utf8");
  22 use IO::Socket::INET6;
  23
  24 my $host = $ENV{MPD_HOST} // "localhost";
  25 my $port = $ENV{MPD_PORT} // 6600;
  26
  27 my $sock = new IO::Socket::INET6(
  28         PeerAddr => $host,
  29         PeerPort => $port,
  30         Proto    => 'tcp',
  31 ) or die "failed to connect to MPD: $!";
  32 binmode($sock, ":utf8");
  33
  34 if (!(<$sock> =~ /^OK MPD ([0-9]+)\.([0-9]+)\.([0-9]+)$/)) {
  35         die "MPD failed to announce version: $!";
  36 }
  37
  38 sub mpd_escape {
  39         ($_) = @_;
  40
  41         # No way to encode literal newlines in the protocol, so we convert
  42         # any newlines in the arguments into a space, which can help with
  43         # shell quoting.
  44         s/\n/ /g;
  45
  46         if (/[ \t\\"]/) {
  47                 s/[\\"]/\\$&/g;
  48                 return "\"$_\"";
  49         }
  50         return $_;
  51 }
  52
  53 sub mpd_exec {
  54         print $sock join(' ', @_), "\n";
  55         while (<$sock>) {
  56                 last if (/^OK/);
  57                 print;
  58                 exit 1 if (/^ACK/);
  59         }
  60 }
  61
  62 if (@ARGV) {
  63         mpd_exec(map { mpd_escape($_) } @ARGV)
  64 } else {
  65         while (<>) {
  66                 chomp;
  67                 mpd_exec($_);
  68         }
  69 }
  70
  71 print $sock "close\n";
  72 close $sock;