MPDHacks.pm

   1 #!/usr/bin/perl
   2 #
   3 # Copyright © 2008,2010,2012,2019-2020 Nick Bowler
   4 #
   5 # License GPLv3+: GNU General Public License version 3 or any later version.
   6 # This is free software: you are free to change and redistribute it.
   7 # There is NO WARRANTY, to the extent permitted by law.
   8
   9 package MPD;
  10
  11 use strict;
  12
  13 use Exporter;
  14 our ($VERSION, @ISA, @EXPORT);
  15
  16 use IO::Socket::INET6;
  17 use IO::Socket::UNIX;
  18
  19 $VERSION = 0;
  20 @ISA = qw(Exporter);
  21 @EXPORT = qw();
  22
  23 our $host = $ENV{MPD_HOST} // "localhost";
  24 our $port = $ENV{MPD_PORT} // 6600;
  25 our $sock;
  26
  27 our ($major, $minor, $revision);
  28
  29 # MPD::connect([ARGS])
  30 #
  31 # Connect to MPD based on the current settings of $MPD::host and $MPD::port.
  32 #
  33 # The following key-value arguments may optionally be specified:
  34 #
  35 #   binmode => socket binmode, e.g., :utf8 or :raw.  The default is :utf8.
  36 #
  37 #              Text in the MPD protocol is always UTF-8 encoded but some
  38 #              commands return raw binary data which can be easier to
  39 #              handle in :raw mode.
  40 #
  41 # On failure, an error message is printed and undef is returned.
  42 sub connect {
  43         my %args = @_;
  44
  45         if ($host =~ /^[@\/]/) {
  46                 $host =~ s/^@/\0/;
  47                 $sock = new IO::Socket::UNIX(Type => SOCK_STREAM(),
  48                                              Peer => $host)
  49         } else {
  50                 $sock = new IO::Socket::INET6(PeerAddr => $host,
  51                                               PeerPort => $port,
  52                                               Proto    => 'tcp',
  53                                               Timeout  => 2)
  54         }
  55         die "MPD connection failed: $!\n" unless $sock;
  56
  57         binmode($sock, $args{binmode} // ":utf8");
  58         unless (<$sock> =~ /^OK MPD ([0-9]+)\.([0-9]+)\.([0-9]+)$/) {
  59                 $sock->close();
  60                 die "MPD failed to announce version: $!\n";
  61         }
  62
  63         ($major, $minor, $revision) = ($1, $2, $3);
  64         return $sock;
  65 }
  66
  67 # min_version(x, y, z)
  68 #
  69 # Returns true iff the MPD protocol version is at least x.y.z.
  70 sub min_version {
  71         my ($maj, $min, $rev) = @_;
  72
  73         if (defined $maj) {
  74                 return 1 if $maj < $major;
  75                 return 0 if $maj > $major;
  76         }
  77
  78         if (defined $min) {
  79                 return 1 if $min < $minor;
  80                 return 0 if $min > $minor;
  81         }
  82
  83         if (defined $rev) {
  84                 return 1 if $rev < $revision;
  85                 return 0 if $rev > $revision;
  86         }
  87
  88         return 1;
  89 }
  90
  91 # Returns the argument (or $_ if no arguments are supplied) quoted so that it
  92 # can be presented as a single command argument to MPD at the protocol level.
  93 sub escape {
  94         my $s = @_[0] // $_;
  95
  96         # No way to encode literal newlines in the protocol, so we convert
  97         # any newlines in the arguments into a space, which can help with
  98         # shell quoting.
  99         $s =~ s/\n/ /g;
 100
 101         if ($s =~ /[ \t\\"']/) {
 102                 $s =~ s/[\\"]/\\$&/g;
 103                 return "\"$s\"";
 104         }
 105
 106         $s =~ s/^\s*$/"$&"/;
 107         return $s;
 108 }
 109
 110 # Submit a command to the MPD server; each argument to this function
 111 # is quoted and sent as a single argument to MPD.
 112 sub exec {
 113         my $cmd = join(' ', map { MPD::escape } @_);
 114
 115         print $sock "$cmd\n";
 116 }
 117
 118 # Submit a command to the MPD server and wait for it to complete.
 119 # Intended for simple cases where the command output is unneeded.
 120 sub run {
 121         MPD::exec(@_);
 122         while (<$sock>) {
 123                 last if (/^OK/);
 124                 die($_) if (/^ACK/);
 125         }
 126 }
 127
 128 1;