mpdmenu.pl

   1 #!/usr/bin/perl
   2 #
   3 # Copyright © 2008,2010,2012,2019 Nick Bowler
   4 #
   5 # Silly little script to generate an FVWM menu with various bits of MPD
   6 # status information and controls.
   7 #
   8 # License GPLv3+: GNU General Public License version 3 or any later version.
   9 # This is free software: you are free to change and redistribute it.
  10 # There is NO WARRANTY, to the extent permitted by law.
  11
  12 use strict;
  13
  14 use Getopt::Long;
  15 use IO::Socket::INET6;
  16 use FindBin;
  17
  18 use constant {
  19         MPD_MJR_MIN => 0,
  20         MPD_MNR_MIN => 13,
  21         MPD_REV_MIN => 0,
  22 };
  23
  24 use utf8;
  25 use open qw(:std :utf8);
  26 binmode(STDOUT, ":utf8");
  27 use Encode;
  28
  29 my $SELF = "$FindBin::Bin/$FindBin::Script";
  30
  31 sub cmd
  32 {
  33         print "$_[0]\n";
  34 }
  35
  36 # Global hash for tracking what is to be "accepted".
  37 my %accept = ();
  38
  39 my $FVWM = (defined $ENV{FVWM_USERDIR}) ? $ENV{FVWM_USERDIR}
  40                                         : $ENV{HOME}."/.fvwm";
  41 my $icons = "$FVWM/icons";
  42
  43 # Default values for stuff.
  44 my ($album, $artist, $title, $menu) = (undef, undef, undef, undef);
  45 my $host = (defined $ENV{MPD_HOST}) ? $ENV{MPD_HOST} : "localhost";
  46 my $port = (defined $ENV{MPD_PORT}) ? $ENV{MPD_PORT} : "6600";
  47
  48 GetOptions(
  49         'host|h=s'   => \&host,   # Host that MPD is running on.
  50         'port|p=s'   => \&port,   # Port that MPD is listening on.
  51         'menu|m=s'   => \$menu,   # Name of the menu to create.
  52         'album=s'    => \$album,  # Album to get tracks from
  53         'artist=s'   => \$artist, # Artist to limit results to
  54         'title=s'    => \$title,  # Title to create menu for
  55 );
  56
  57 $album  = decode_utf8($album)  if defined($album);
  58 $artist = decode_utf8($artist) if defined($artist);
  59 $title  = decode_utf8($title)  if defined($title);;
  60
  61 # Connect to MPD.
  62 my $sock = new IO::Socket::INET6(
  63         PeerAddr => $host,
  64         PeerPort => $port,
  65         Proto => 'tcp',
  66         Timeout => 2
  67 ) or die("could not open socket: $!.\n");
  68 binmode($sock, ":utf8");
  69
  70 die("could not connect to MPD: $!.\n")
  71         if (!(<$sock> =~ /^OK MPD ([0-9]+)\.([0-9]+)\.([0-9]+)$/));
  72
  73 die("MPD version $1.$2.$3 insufficient.\n")
  74         if (  ($1 <  MPD_MJR_MIN)
  75            || ($1 == MPD_MJR_MIN && $2 <  MPD_MNR_MIN)
  76            || ($1 == MPD_MJR_MIN && $2 == MPD_MNR_MIN && $3 < MPD_REV_MIN));
  77
  78 if (defined $album) {
  79         # Create an album menu.
  80         my @playlist = ();
  81         my $entry;
  82
  83         $menu = "MenuMPDAlbum" unless defined $menu;
  84
  85         $album =~ s/"/\\"/g;
  86         print $sock "playlistfind album \"$album\"\n";
  87         while (<$sock>) {
  88                 last if (/^OK/);
  89                 die($_) if (/^ACK/);
  90
  91                 if (/^(\w+): (.*)$/) {
  92                         if ($1 eq "file") {
  93                                 if (keys(%$entry) > 0) {
  94                                         addalbumentry(\@playlist, $entry)
  95                                 }
  96
  97                                 $entry = {};
  98                         }
  99
 100                         $entry->{$1} = $2;
 101                 }
 102         }
 103         addalbumentry(\@playlist, $entry) if (keys(%$entry) > 0);
 104
 105         die("No tracks found.\n") if (!@playlist);
 106         foreach (sort albumsort @playlist) {
 107                 my ($t_file, $t_trackno, $t_artist, $t_title, $t_id) = (
 108                         $_->{file},
 109                         $_->{Track},
 110                         $_->{Artist},
 111                         $_->{Title},
 112                         $_->{Id},
 113                 );
 114
 115                 next if (defined $artist && !$accept{albumdir($t_file)});
 116
 117                 $t_artist = sanitise($t_artist, 0);
 118                 $t_title  = sanitise($t_title, 0);
 119
 120                 my $cmd = sprintf "AddToMenu $menu \"%d\t%s - %s\""
 121                                   ." Exec exec $FindBin::Bin/mpdexec.pl"
 122                                   ." playid %d",
 123                                   $t_trackno, $t_artist, $t_title, $t_id;
 124
 125                 cmd($cmd);
 126         }
 127 } elsif (defined $artist) {
 128         # Create an artist menu.
 129         my %albums = ();
 130         my $file;
 131         my $quoteartist = $artist;
 132
 133         $menu = "MenuMPDArtist" unless defined $menu;
 134
 135         $quoteartist =~ s/"/\\"/g;
 136         print $sock "playlistfind artist \"$quoteartist\"\n";
 137         while (<$sock>) {
 138                 last if (/^OK/);
 139                 die($_) if (/^ACK/);
 140
 141                 if (/^(\w+): (.*)$/) {
 142                         $file       = $2    if ($1 eq "file");
 143                         $albums{$2} = $file if ($1 eq "Album");
 144                 }
 145         }
 146
 147         die("No albums found.\n") if (!keys(%albums));
 148
 149 { # work around 'use locale' breaking s///i
 150         my $i = 0;
 151         use locale;
 152         foreach (sort keys(%albums)) {
 153                 my $key      = $_;
 154                 my $a_album  = sanitise($key, 1);
 155
 156                 open THUMB, "-|", "$FindBin::Bin/thumbnail.zsh",
 157                                          "--small", "--music", $albums{$key};
 158                 my $thumb = <THUMB>;
 159                 close THUMB;
 160                 die("Incompetent use of thumbnail.zsh") if ($?);
 161
 162                 $thumb =~ s/\n//sg;
 163                 $thumb = "%$thumb%" if (-f $thumb);
 164
 165                 cmd("AddToMenu $menu \"$thumb$a_album\" Popup MenuMPDArt_$i");
 166
 167                 cmd("AddToMenu MenuMPDArt_$i DynamicPopUpAction MakeMenuMPDArt_$i");
 168
 169                 cmd("DestroyFunc MakeMenuMPDArt_$i");
 170                 cmd("AddToFunc   MakeMenuMPDArt_$i
 171                      + I DestroyMenu MenuMPDArt_$i
 172                      + I -PipeRead \"exec $SELF "
 173                            ."--menu MenuMPDArt_$i "
 174                            ."--album  ".shellify($key, 1)." "
 175                            ."--artist ".shellify($artist, 1)."\"");
 176
 177                 cmd("AddToFunc KillMenuMPD I DestroyMenu MenuMPDArt_$i");
 178                 cmd("AddToFunc KillMenuMPD I DestroyFunc MakeMenuMPDArt_$i");
 179
 180                 $i++;
 181         }
 182 } # end use locale workaround
 183 } elsif (defined $title) {
 184         # Create a title menu.
 185         my @titles;
 186         my $entry;
 187
 188         $menu = "MenuMPDTitle" unless defined $menu;
 189
 190         # Open and close brackets.
 191         my ($ob, $cb) = ("[\[~〜<〈(ー−-]", "[\]~〜>〉)ー−-]");
 192
 193         $_ = $title;
 194
 195         # Deal with specific cases.
 196         s/ちいさな(?=ヘミソフィア)//;                 # ヘミソフィア
 197         s/ "mix on air flavor" dear EIKO SHIMAMIYA//; # Spiral wind
 198         s/ "So,you need me" Style//;                  # I need you
 199         s/ ::Symphony Second movement:://;            # Disintegration
 200         s/-\[instrumental\]//;                        # 青い果実
 201         s/ -Practice Track-//;                        # Fair Heaven
 202         s/〜世界で一番アナタが好き〜//;               # Pure Heart
 203         s/〜彼方への哀歌//;                           # 十二幻夢
 204         s/　sora no uta ver.//;                       # 美しい星
 205
 206         s/\s*-remix-$//; # Otherwise "D-THREAD -remix-" doesn't work right.
 207
 208         # Deal with titles like "blah (ABC version)".
 209         s/\s*$ob.*(style|mix|edit|edition|ver\.?|version|melody|カラオケ)$cb?$//i;
 210
 211         # Deal with titles like "blah (without XYZ)".
 212         s/\s*$ob\s*((e\.)?piano|english|japanese|inst|tv|without|w\/o|off|back|short|karaoke|game).*//i;
 213
 214         # Deal with titles like "blah instrumental".
 215         s/\s+(instrumental|off vocal|short|tv)([\s-]+(mix|size|version))?$//i;
 216         s/\s+without\s+\w+$//i;
 217
 218         # Deal with separate movements in classical pieces.
 219         s/: [IVX]+\..*//;
 220
 221         my $basetitle  = $_;
 222         my $_basetitle = $basetitle;
 223
 224         $_basetitle =~ s/"/\\"/g;
 225         print $sock "playlistsearch title \"$_basetitle\"\n";
 226         while (<$sock>) {
 227                 last if (/^OK/);
 228                 die($_) if (/^ACK/);
 229
 230                 if (/^(\w+): (.*)$/) {
 231                         if ($1 eq "file") {
 232                                 push @titles, $entry if (keys(%$entry) > 0);
 233                                 $entry = {};
 234                         }
 235
 236                         $entry->{$1} = $2;
 237                 }
 238         }
 239         push @titles, $entry if (keys(%$entry) > 0);
 240
 241 { # work around 'use locale' breaking s///i
 242         use locale;
 243         foreach (sort titlesort @titles) {
 244                 my ($t_file, $t_artist, $t_title, $t_id) = (
 245                         $_->{file},
 246                         $_->{Artist},
 247                         $_->{Title},
 248                         $_->{Id},
 249                 );
 250
 251                 # MPD searches are case-insensitive.
 252                 next if (!($t_title =~ m/(\P{Latin}|^)\Q$basetitle\E(\P{Latin}|$)/ || $t_title =~ m/\Q$basetitle\E/i));
 253
 254                 $t_artist = sanitise($t_artist, 1);
 255                 $t_title  = sanitise($t_title, 1);
 256
 257                 open THUMB, "-|", "$FindBin::Bin/thumbnail.zsh",
 258                                          "--small", "--music", $t_file;
 259                 my $thumb = <THUMB>;
 260                 close(THUMB);
 261                 die("Incompetent use of thumbnail.zsh") if ($?);
 262
 263                 $thumb =~ s/\n//sg;
 264                 $thumb = "%$thumb%" if (-f $thumb);
 265
 266                 cmd("AddToMenu $menu \"$thumb$t_artist - $t_title\""
 267                     ." Exec exec $FindBin::Bin/mpdexec.pl"
 268                     ." playid $t_id");
 269         }
 270 } # end use locale workaround
 271 } else {
 272         # Make MPD base menu
 273         my ($state, $songid) = (undef, undef);
 274         my %entry = ();
 275
 276         $menu = "MenuMPD" unless defined $menu;
 277
 278         print $sock "status\n";
 279         while (<$sock>) {
 280                 last if (/^OK/);
 281                 die($_) if (/^ACK/);
 282
 283                 if (/^(\w+): (.*)$/) {
 284                         $state  = $2 if ($1 eq "state");
 285                         $songid = $2 if ($1 eq "songid");
 286                 }
 287         }
 288         die("Failed status query\n") unless (defined $state);
 289
 290         cmd("AddToMenu $menu Playing Title") if ($state eq "play");
 291         cmd("AddToMenu $menu Paused Title")  if ($state eq "pause");
 292         cmd("AddToMenu $menu Stopped Title") if ($state eq "stop");
 293
 294         if (defined $songid) {
 295                 print $sock "playlistid $songid\n";
 296                 while (<$sock>) {
 297                         last if (/^OK/);
 298                         die($_) if (/^ACK/);
 299
 300                         if (/^(\w+): (.*)$/) {
 301                                 $entry{$1} = $2;
 302                         }
 303                 }
 304                 die("Failed data query\n") unless (keys(%entry) > 0);
 305
 306                 open THUMB, "-|", "$FindBin::Bin/thumbnail.zsh",
 307                                          "--image", "--music",  $entry{file};
 308                 my $thumb = <THUMB>;
 309                 my $scan  = <THUMB>;
 310                 close(THUMB);
 311                 die("Incompetent use of thumbnail.zsh") if ($?);
 312
 313                 $thumb =~ s/\n//sg;
 314                 $scan  =~ s/\n//sg;
 315
 316                 if (-f $thumb) {
 317                         cmd("AddToMenu $menu \"*$thumb*\" "
 318                                 ."Exec exec geeqie ".shellify($scan, 0));
 319                 }
 320                 cmd("AddToMenu $menu \"Title:   ".sanitise($entry{Title}, 0)
 321                         ."\" Popup MenuMPDTitle");
 322                 cmd("AddToMenu $menu \"Artist:  ".sanitise($entry{Artist}, 0)
 323                         ."\" Popup MenuMPDArtist");
 324                 cmd("AddToMenu $menu \"Album:   ".sanitise($entry{Album}, 0)
 325                         ."\" Popup MenuMPDAlbum");
 326                 cmd("AddToMenu $menu \"\" Nop");
 327         } else {
 328                 cmd("AddToMenu $menu \"<Song info unavailable>\"");
 329                 cmd("AddToMenu $menu \"\" Nop");
 330         }
 331
 332         if ($state eq "play" || $state eq "pause") {
 333                 cmd("AddToMenu $menu \"\t\tNext%$icons/next.svg:16x16%\" "
 334                         ."Exec exec $FindBin::Bin/mpdexec.pl next");
 335                 cmd("AddToMenu $menu \"\t\tPause%$icons/pause.svg:16x16%\" "
 336                         ."Exec exec $FindBin::Bin/mpdexec.pl pause");
 337                 cmd("AddToMenu $menu \"\t\tPlay%$icons/play.svg:16x16%\" "
 338                         ."Exec exec $FindBin::Bin/mpdexec.pl play");
 339                 cmd("AddToMenu $menu \"\t\tStop%$icons/stop.svg:16x16%\" "
 340                         ."Exec exec $FindBin::Bin/mpdexec.pl stop");
 341                 cmd("AddToMenu $menu \"\t\tPrev%$icons/prev.svg:16x16%\" "
 342                         ."Exec exec $FindBin::Bin/mpdexec.pl previous");
 343         } elsif ($state eq "stop") {
 344                 cmd("AddToMenu $menu \"\t\tPlay%$icons/play.svg:16x16%\" "
 345                         ."Exec exec $FindBin::Bin/mpdexec.pl play");
 346         } else {
 347                 die("Unknown MPD state!\n");
 348         }
 349
 350         cmd("AddToMenu $menu \"\" Nop");
 351         cmd("AddToMenu $menu \"\t\tShuffle%$icons/shuffle.svg:16x16%\" "
 352                 ."Exec exec $FindBin::Bin/mpdexec.pl shuffle");
 353
 354         cmd("DestroyMenu MenuMPDTitle");
 355         cmd("AddToMenu   MenuMPDTitle  DynamicPopUpAction MakeMenuMPDTitle");
 356         cmd("DestroyMenu MenuMPDArtist");
 357         cmd("AddToMenu   MenuMPDArtist DynamicPopUpAction MakeMenuMPDArtist");
 358         cmd("DestroyMenu MenuMPDAlbum");
 359         cmd("AddToMenu   MenuMPDAlbum  DynamicPopUpAction MakeMenuMPDAlbum");
 360
 361         cmd("DestroyFunc MakeMenuMPDTitle");
 362         cmd("AddToFunc   MakeMenuMPDTitle
 363              + I DestroyMenu MenuMPDTitle
 364              + I -PipeRead \"exec $SELF "
 365                            ."--menu MenuMPDTitle "
 366                            ."--title ".shellify($entry{Title}, 1)."\"");
 367
 368         cmd("DestroyFunc MakeMenuMPDAlbum");
 369         cmd("AddToFunc   MakeMenuMPDAlbum
 370              + I DestroyMenu MenuMPDAlbum
 371              + I -PipeRead \"exec $SELF "
 372                            ."--menu MenuMPDAlbum "
 373                            ."--album  ".shellify($entry{Album}, 1)." "
 374                            ."--artist ".shellify($entry{Artist}, 1)."\"");
 375
 376         cmd("DestroyFunc MakeMenuMPDArtist");
 377         cmd("AddToFunc   MakeMenuMPDArtist
 378              + I DestroyMenu MenuMPDArtist
 379              + I -PipeRead \"exec $SELF "
 380                            ."--menu MenuMPDArtist "
 381                            ."--artist ".shellify($entry{Artist}, 1)."\"");
 382
 383         cmd("DestroyFunc KillMenuMPD");
 384         cmd("AddToFunc   KillMenuMPD I Nop");
 385 }
 386
 387 # Finished.
 388 print $sock "close\n";
 389
 390 sub sanitise
 391 {
 392         $_ = $_[0];
 393         s/&/&&/g if ($_[1]);
 394         s/([\$@%^*])/\1\1/g;
 395         s/"/\\"/g;
 396         return $_;
 397 }
 398
 399 sub addalbumentry
 400 {
 401         my ($playlist, $entry) = @_;
 402
 403         push(@$playlist, $entry);
 404
 405         if (defined $artist && $artist eq $entry->{Artist}) {
 406                 my $albumdir = albumdir($entry->{file});
 407                 $accept{$albumdir} = 1;
 408         }
 409 }
 410
 411 sub albumdir
 412 {
 413         my $file = $_[0];
 414
 415         $file =~ s:(/Disk [0-9]+[^/]*)?/[^/]*$::;
 416         return $file
 417 }
 418
 419 sub albumsort
 420 {
 421         return ($a->{Disc} <=> $b->{Disc}) if ($a->{Disc} != $b->{Disc});
 422         return ($a->{Track} <=> $b->{Track});
 423 }
 424
 425 sub titlesort
 426 {
 427         return ($a->{Album}  cmp $b->{Album})  if($a->{Album}  ne $b->{Album});
 428         return ($a->{Artist} cmp $b->{Artist}) if($a->{Artist} ne $b->{Artist});
 429         return ($a->{Title}  cmp $b->{Title});
 430 }
 431
 432 sub shellify
 433 {
 434         my ($str, $quoted) = @_;
 435         $str =~ s/'/'\\''/g;
 436         if ($quoted) {
 437                 $str =~ s/\\/\\\\/g;
 438                 $str =~ s/"/\\"/g;
 439         }
 440         return "'$str'";
 441 }