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