+#!/usr/bin/perl
+
+use strict;
+
+use Getopt::Long;
+use IO::Socket;
+
+use constant {
+ MPD_MJR_MIN => 0,
+ MPD_MNR_MIN => 13,
+ MPD_REV_MIN => 0,
+};
+
+use utf8;
+use encoding 'utf8';
+use Encode;
+
+sub cmd
+{
+ print "$_[0]\n";
+}
+
+# Global hash for tracking what is to be "accepted".
+my %accept = ();
+
+my $FVWM = (defined $ENV{FVWM_USERDIR}) ? $ENV{FVWM_USERDIR}
+ : $ENV{HOME}."/.fvwm";
+my $icons = "$FVWM/icons";
+
+# Default values for stuff.
+my ($album, $artist, $title, $menu) = (undef, undef, undef, undef);
+my $host = (defined $ENV{MPD_HOST}) ? $ENV{MPD_HOST} : "localhost";
+my $port = (defined $ENV{MPD_PORT}) ? $ENV{MPD_PORT} : "6600";
+
+GetOptions(
+ 'host|h=s' => \&host, # Host that MPD is running on.
+ 'port|p=s' => \&port, # Port that MPD is listening on.
+ 'menu|m=s' => \$menu, # Name of the menu to create.
+ 'album=s' => \$album, # Album to get tracks from
+ 'artist=s' => \$artist, # Artist to limit results to
+ 'title=s' => \$title, # Title to create menu for
+);
+
+$album = decode_utf8($album) if defined($album);
+$artist = decode_utf8($artist) if defined($artist);
+$title = decode_utf8($title) if defined($title);;
+
+# Connect to MPD.
+my $sock = new IO::Socket::INET(
+ PeerAddr => $host,
+ PeerPort => $port,
+ Proto => 'tcp'
+) or die("could not open socket: $!.\n");
+binmode($sock, ":utf8");
+
+die("could not connect to MPD: $!.\n")
+ if (!(<$sock> =~ /^OK MPD ([0-9]+)\.([0-9]+)\.([0-9]+)$/));
+
+die("MPD version $1.$2.$3 insufficient.\n")
+ if ( ($1 < MPD_MJR_MIN)
+ || ($1 == MPD_MJR_MIN && $2 < MPD_MNR_MIN)
+ || ($1 == MPD_MJR_MIN && $2 == MPD_MNR_MIN && $3 < MPD_REV_MIN));
+
+if (defined $album) {
+ # Create an album menu.
+ my @playlist = ();
+ my $entry;
+
+ $menu = "MenuMPDAlbum" unless defined $menu;
+
+ $album =~ s/"/\\"/g;
+ print $sock "playlistfind album \"$album\"\n";
+ while (<$sock>) {
+ last if (/^OK/);
+ die($_) if (/^ACK/);
+
+ if (/^(\w+): (.*)$/) {
+ if ($1 eq "file") {
+ if (keys(%$entry) > 0) {
+ addalbumentry(\@playlist, $entry)
+ }
+
+ $entry = {};
+ }
+
+ $entry->{$1} = $2;
+ }
+ }
+ addalbumentry(\@playlist, $entry) if (keys(%$entry) > 0);
+
+ die("No tracks found.\n") if (!@playlist);
+ foreach (sort albumsort @playlist) {
+ my ($t_file, $t_trackno, $t_artist, $t_title, $t_id) = (
+ $_->{file},
+ $_->{Track},
+ $_->{Artist},
+ $_->{Title},
+ $_->{Id},
+ );
+
+ next if (defined $artist && !$accept{albumdir($t_file)});
+
+ $t_artist = sanitise($t_artist);
+ $t_title = sanitise($t_title);
+
+ my $cmd = sprintf "AddToMenu $menu \"%d\t%s - %s\""
+ ." Exec mpc playid %d",
+ $t_trackno, $t_artist, $t_title, $t_id;
+
+ cmd($cmd);
+ }
+} elsif (defined $artist) {
+ # Create an artist menu.
+ my %albums = ();
+ my $file;
+ my $quoteartist = $artist;
+
+ $menu = "MenuMPDArtist" unless defined $menu;
+
+ $quoteartist =~ s/"/\\"/g;
+ print $sock "playlistfind artist \"$quoteartist\"\n";
+ while (<$sock>) {
+ last if (/^OK/);
+ die($_) if (/^ACK/);
+
+ if (/^(\w+): (.*)$/) {
+ $file = $2 if ($1 eq "file");
+ $albums{$2} = $file if ($1 eq "Album");
+ }
+ }
+
+ die("No albums found.\n") if (!keys(%albums));
+
+{ # work around 'use locale' breaking s///i
+ my $i = 0;
+ use locale;
+ foreach (sort keys(%albums)) {
+ my $key = $_;
+ my $a_album = sanitise($key);
+
+ open THUMB, "-|", "$FVWM/thumbnail.sh",
+ "--small", "--music", $albums{$key};
+ my $thumb = <THUMB>;
+ close THUMB;
+ die("Incompetent use of thumbnail.sh") if ($?);
+
+ $thumb =~ s/\n//sg;
+ $thumb = "%$thumb%" if (-f $thumb);
+
+ cmd("AddToMenu $menu \"$thumb$a_album\" Popup MenuMPDArt_$i");
+
+ cmd("AddToMenu MenuMPDArt_$i DynamicPopUpAction MakeMenuMPDArt_$i");
+
+ cmd("DestroyFunc MakeMenuMPDArt_$i");
+ cmd("AddToFunc MakeMenuMPDArt_$i
+ + I DestroyMenu MenuMPDArt_$i
+ + I -PipeRead \"exec $FVWM/mpdmenu.pl "
+ ."--menu MenuMPDArt_$i "
+ ."--album ".shellify($key, 1)." "
+ ."--artist ".shellify($artist, 1)."\"");
+
+ cmd("AddToFunc KillMenuMPD I DestroyMenu MenuMPDArt_$i");
+ cmd("AddToFunc KillMenuMPD I DestroyFunc MakeMenuMPDArt_$i");
+
+ $i++;
+ }
+} # end use locale workaround
+} elsif (defined $title) {
+ # Create a title menu.
+ my @titles;
+ my $entry;
+
+ $menu = "MenuMPDTitle" unless defined $menu;
+
+ # Open and close brackets.
+ my ($ob, $cb) = ("[\[~〜<(ー−-]", "[\]~〜>)ー−-]");
+
+ $_ = $title;
+
+ # Deal with specific cases.
+ s/ちいさな(?=ヘミソフィア)//; # ヘミソフィア
+ s/ "mix on air flavor" dear EIKO SHIMAMIYA//; # Spiral wind
+ s/ "So,you need me" Style//; # I need you
+ s/ ::Symphony Second movement:://; # Disintegration
+ s/-\[instrumental\]//; # 青い果実
+ s/ -Practice Track-//; # Fair Heaven
+ s/〜世界で一番アナタが好き〜//; # Pure Heart
+ s/〜彼方への哀歌//; # 十二幻夢
+
+ s/\s*-remix-$//; # Otherwise "D-THREAD -remix-" doesn't work right.
+
+ # Deal with titles like "blah (ABC version)".
+ s/\s*$ob.*(style|mix|edit|edition|ver\.?|version|カラオケ)$cb?$//i;
+
+ # Deal with titles like "blah (without XYZ)".
+ s/\s*$ob((e\.)?piano|english|japanese|inst|tv|without|w\/o|off|back|short|karaoke|game).*//i;
+
+ # Deal with titles like "blah instrumental".
+ s/\s+(instrumental|off vocal|short)(\s+(size|version|s))?$//i;
+ s/\s+without\s+\w+$//i;
+
+ my $basetitle = $_;
+ my $_basetitle = $basetitle;
+
+ $_basetitle =~ s/"/\\"/g;
+ print $sock "playlistsearch title \"$_basetitle\"\n";
+ while (<$sock>) {
+ last if (/^OK/);
+ die($_) if (/^ACK/);
+
+ if (/^(\w+): (.*)$/) {
+ if ($1 eq "file") {
+ push @titles, $entry if (keys(%$entry) > 0);
+ $entry = {};
+ }
+
+ $entry->{$1} = $2;
+ }
+ }
+ push @titles, $entry if (keys(%$entry) > 0);
+
+{ # work around 'use locale' breaking s///i
+ use locale;
+ foreach (sort titlesort @titles) {
+ my ($t_file, $t_artist, $t_title, $t_id) = (
+ $_->{file},
+ $_->{Artist},
+ $_->{Title},
+ $_->{Id},
+ );
+
+ # MPD searches are case-insensitive.
+ next if (!($t_title =~ m/(\P{Latin}|^)\Q$basetitle\E(\P{Latin}|$)/));
+ $t_artist = sanitise($t_artist);
+ $t_title = sanitise($t_title);
+
+ open THUMB, "-|", "$FVWM/thumbnail.sh",
+ "--small", "--music", $t_file;
+ my $thumb = <THUMB>;
+ close(THUMB);
+ die("Incompetent use of thumbnail.sh") if ($?);
+
+ $thumb =~ s/\n//sg;
+ $thumb = "%$thumb%" if (-f $thumb);
+
+ cmd("AddToMenu $menu \"$thumb$t_artist - $t_title\" Exec mpc playid $t_id");
+ }
+} # end use locale workaround
+} else {
+ # Make MPD base menu
+ my ($state, $songid) = (undef, undef);
+ my %entry = ();
+
+ $menu = "MenuMPD" unless defined $menu;
+
+ print $sock "status\n";
+ while (<$sock>) {
+ last if (/^OK/);
+ die($_) if (/^ACK/);
+
+ if (/^(\w+): (.*)$/) {
+ $state = $2 if ($1 eq "state");
+ $songid = $2 if ($1 eq "songid");
+ }
+ }
+ die("Failed status query\n") unless (defined $state && defined $songid);
+
+ print $sock "playlistid $songid\n";
+ while (<$sock>) {
+ last if (/^OK/);
+ die($_) if (/^ACK/);
+
+ if (/^(\w+): (.*)$/) {
+ $entry{$1} = $2;
+ }
+ }
+ die("Failed data query\n") unless (keys(%entry) > 0);
+
+ open THUMB, "-|", "$FVWM/thumbnail.sh",
+ "--image", "--music", $entry{file};
+ my $thumb = <THUMB>;
+ my $scan = <THUMB>;
+ close(THUMB);
+ die("Incompetent use of thumbnail.sh") if ($?);
+
+ $thumb =~ s/\n//sg;
+ $scan =~ s/\n//sg;
+
+ cmd("AddToMenu $menu Playing Title") if ($state eq "play");
+ cmd("AddToMenu $menu Paused Title") if ($state eq "pause");
+ cmd("AddToMenu $menu Stopped Title") if ($state eq "stop");
+ if (-f $thumb) {
+ cmd("AddToMenu $menu \"*$thumb*\" "
+ ."Exec exec gqview ".shellify($scan, 0));
+ }
+ cmd("AddToMenu $menu \"Title: ".sanitise($entry{Title})."\" "
+ ."Popup MenuMPDTitle");
+ cmd("AddToMenu $menu \"Artist: ".sanitise($entry{Artist})."\" "
+ ."Popup MenuMPDArtist");
+ cmd("AddToMenu $menu \"Album: ".sanitise($entry{Album})."\" "
+ ."Popup MenuMPDAlbum");
+ cmd("AddToMenu $menu \"\" Nop");
+
+ if ($state eq "play" || $state eq "pause") {
+ cmd("AddToMenu $menu \"\t\tNext%$icons/next.svg:16x16%\" "
+ ."Exec exec mpc next");
+ cmd("AddToMenu $menu \"\t\tPause%$icons/pause.svg:16x16%\" "
+ ."Exec exec mpc pause") if ($state eq "play");
+ cmd("AddToMenu $menu \"\t\tPlay%$icons/play.svg:16x16%\" "
+ ."Exec exec mpc play") if ($state eq "pause");
+ cmd("AddToMenu $menu \"\t\tStop%$icons/stop.svg:16x16%\" "
+ ."Exec exec mpc stop");
+ cmd("AddToMenu $menu \"\t\tPrev%$icons/prev.svg:16x16%\" "
+ ."Exec exec mpc prev");
+ } elsif ($state eq "stop") {
+ cmd("AddToMenu $menu \"\t\tPlay%$icons/play.svg:16x16%\" "
+ ."Exec exec mpc play");
+ } else {
+ die("Unknown MPD state!\n");
+ }
+
+ cmd("AddToMenu $menu \"\" Nop");
+ cmd("AddToMenu $menu \"\t\tShuffle%$icons/shuffle.svg:16x16%\" "
+ ."Exec exec mpc shuffle");
+
+ cmd("DestroyMenu MenuMPDTitle");
+ cmd("AddToMenu MenuMPDTitle DynamicPopUpAction MakeMenuMPDTitle");
+ cmd("DestroyMenu MenuMPDArtist");
+ cmd("AddToMenu MenuMPDArtist DynamicPopUpAction MakeMenuMPDArtist");
+ cmd("DestroyMenu MenuMPDAlbum");
+ cmd("AddToMenu MenuMPDAlbum DynamicPopUpAction MakeMenuMPDAlbum");
+
+ cmd("DestroyFunc MakeMenuMPDTitle");
+ cmd("AddToFunc MakeMenuMPDTitle
+ + I DestroyMenu MenuMPDTitle
+ + I -PipeRead \"exec $FVWM/mpdmenu.pl "
+ ."--menu MenuMPDTitle "
+ ."--title ".shellify($entry{Title}, 1)."\"");
+
+ cmd("DestroyFunc MakeMenuMPDAlbum");
+ cmd("AddToFunc MakeMenuMPDAlbum
+ + I DestroyMenu MenuMPDAlbum
+ + I -PipeRead \"exec $FVWM/mpdmenu.pl "
+ ."--menu MenuMPDAlbum "
+ ."--album ".shellify($entry{Album}, 1)." "
+ ."--artist ".shellify($entry{Artist}, 1)."\"");
+
+ cmd("DestroyFunc MakeMenuMPDArtist");
+ cmd("AddToFunc MakeMenuMPDArtist
+ + I DestroyMenu MenuMPDArtist
+ + I -PipeRead \"exec $FVWM/mpdmenu.pl "
+ ."--menu MenuMPDArtist "
+ ."--artist ".shellify($entry{Artist}, 1)."\"");
+
+ cmd("DestroyFunc KillMenuMPD");
+ cmd("AddToFunc KillMenuMPD I Nop");
+}
+
+# Finished.
+print $sock "close\n";
+
+sub sanitise
+{
+ $_ = $_[0];
+ s/([\$&@%^*])/\1\1/g;
+ s/"/\\"/g;
+ return $_;
+}
+
+sub addalbumentry
+{
+ my ($playlist, $entry) = @_;
+
+ push(@$playlist, $entry);
+
+ if (defined $artist && $artist eq $entry->{Artist}) {
+ my $albumdir = albumdir($entry->{file});
+ $accept{$albumdir} = 1;
+ }
+}
+
+sub albumdir
+{
+ my $file = $_[0];
+
+ $file =~ s:(/Disk [0-9]+[^/]*)?/[^/]*$::;
+ return $file
+}
+
+sub albumsort
+{
+ return ($a->{Disc} <=> $b->{Disc}) if ($a->{Disc} != $b->{Disc});
+ return ($a->{Track} <=> $b->{Track});
+}
+
+sub titlesort
+{
+ return ($a->{Album} cmp $b->{Album}) if($a->{Album} ne $b->{Album});
+ return ($a->{Artist} cmp $b->{Artist}) if($a->{Artist} ne $b->{Artist});
+ return ($a->{Title} cmp $b->{Title});
+}
+
+sub shellify
+{
+ my ($str, $quoted) = @_;
+ $str =~ s/'/'\\''/g;
+ if ($quoted) {
+ $str =~ s/\\/\\\\/g;
+ $str =~ s/"/\\"/g;
+ }
+ return "'$str'";
+}