| 1 |
#!/usr/bin/perl |
| 2 |
|
| 3 |
# most of this file is dedicated to work around the braindead ReadLine |
| 4 |
# implementation. |
| 5 |
|
| 6 |
#BEGIN { $ENV{PERL_RL} |= "Perl o=0" } |
| 7 |
BEGIN { $ENV{PERL_RL} |= " o=0" } |
| 8 |
BEGIN { eval "use Time::HiRes 'time'" } |
| 9 |
|
| 10 |
$RC = "$ENV{HOME}/.mpg123shrc"; |
| 11 |
|
| 12 |
use Audio::Play::MPG123; |
| 13 |
use Term::ReadLine; |
| 14 |
use Fcntl; # required by MPG123 anyway |
| 15 |
use Cwd; |
| 16 |
use File::Basename; |
| 17 |
|
| 18 |
sub mglob { |
| 19 |
eval { require File::Glob } ? &File::Glob::glob : glob $_[0]; |
| 20 |
} |
| 21 |
|
| 22 |
$|=1; |
| 23 |
|
| 24 |
do $RC; |
| 25 |
|
| 26 |
# contains tuples of the form [url, repeat] |
| 27 |
@playlist=(); |
| 28 |
$p_url; |
| 29 |
$p_repeat; |
| 30 |
|
| 31 |
$player = new Audio::Play::MPG123 mpg123args => ["-b4096"]; |
| 32 |
|
| 33 |
# do uri-style escaping PLUS escape space to · and back (sorry for that :() |
| 34 |
sub uri_esc($) { |
| 35 |
local $_ = shift; |
| 36 |
s/([^\x21-\x24\x26-\x7e\xa0-\xb6\xb8-\xff])/sprintf "%c%02x", 0x25, ord($1)/ge; |
| 37 |
s/%20/·/g; |
| 38 |
$_; |
| 39 |
} |
| 40 |
|
| 41 |
sub uri_unesc($) { |
| 42 |
local $_ = shift; |
| 43 |
s/·/%20/g; |
| 44 |
s/%([0-9a-f][0-9a-f])/chr(hex($1))/gei; |
| 45 |
$_; |
| 46 |
} |
| 47 |
|
| 48 |
sub write_rc { |
| 49 |
require Data::Dumper; |
| 50 |
print "writing $RC... "; |
| 51 |
open RC, ">$RC" or die "$RC: $!"; |
| 52 |
print RC Data::Dumper->Dump([\%conf], ['*conf']); |
| 53 |
close RC; |
| 54 |
print "ok\n"; |
| 55 |
} |
| 56 |
|
| 57 |
sub oconf { |
| 58 |
my ($cmd, $value) = @_; |
| 59 |
if ($cmd eq "log") { |
| 60 |
if ($value =~ /^\s*$/) { |
| 61 |
delete $conf{log}; |
| 62 |
} else { |
| 63 |
$conf{log} = $value; |
| 64 |
} |
| 65 |
write_rc; |
| 66 |
} elsif ($cmd eq "conf") { |
| 67 |
while (my ($k, $v) = each %conf) { |
| 68 |
printf "%-10s => %s\n", $k, $v; |
| 69 |
} |
| 70 |
} else { |
| 71 |
print "unknown o command, use <log> or <conf>.\n"; |
| 72 |
} |
| 73 |
} |
| 74 |
|
| 75 |
sub mp3log { |
| 76 |
my ($cmd, @args) = @_; |
| 77 |
if (defined $conf{log}) { |
| 78 |
if (open LOG, ">>$conf{log}") { |
| 79 |
print LOG "$cmd ", (join " ", map uri_esc($_), @args), "\n"; |
| 80 |
close LOG; |
| 81 |
} else { |
| 82 |
warn "$conf{log}: $!\n"; |
| 83 |
} |
| 84 |
} |
| 85 |
} |
| 86 |
|
| 87 |
my $current_url; |
| 88 |
my $current_time; |
| 89 |
|
| 90 |
sub load_url { |
| 91 |
my $url = shift; |
| 92 |
if (defined $current_url && $current_time) { |
| 93 |
mp3log "T", $current_url, sprintf ("%0.2f", time - $current_time); |
| 94 |
} |
| 95 |
$current_url = $url; |
| 96 |
if (defined $url) { |
| 97 |
$current_time = time; |
| 98 |
$player->load($url); |
| 99 |
} |
| 100 |
} |
| 101 |
|
| 102 |
sub pause_url { |
| 103 |
my $pause = shift; |
| 104 |
if ($pause) { |
| 105 |
mp3log "T", $current_url, sprintf ("%0.2f", time - $current_time) if defined $current_url; |
| 106 |
$current_time = 0; |
| 107 |
} else { |
| 108 |
$current_time = time; |
| 109 |
} |
| 110 |
} |
| 111 |
|
| 112 |
sub next_song { |
| 113 |
if ($p_repeat <= 0 && @playlist) { |
| 114 |
my $p = shift @playlist; |
| 115 |
push @playlist, $p if $p; |
| 116 |
$p_url = $playlist[0][0]; |
| 117 |
$p_repeat = $playlist[0][1]; |
| 118 |
} |
| 119 |
if ($p_url) { |
| 120 |
$p_repeat--; |
| 121 |
load_url($p_url); |
| 122 |
mp3log("+", $p_url); |
| 123 |
$player->stat; |
| 124 |
} |
| 125 |
} |
| 126 |
|
| 127 |
sub add_url($) { |
| 128 |
my $url = shift; |
| 129 |
push @playlist, [$url, 1]; |
| 130 |
next_song unless $player->state; |
| 131 |
mp3log("a", $url); |
| 132 |
} |
| 133 |
|
| 134 |
sub shuffle { |
| 135 |
for (my $i = @playlist; $i--; ) { |
| 136 |
my $j = int rand $i+1; |
| 137 |
@playlist[$j, $i] = @playlist[$i, $j]; |
| 138 |
} |
| 139 |
} |
| 140 |
|
| 141 |
END { |
| 142 |
load_url(); |
| 143 |
} |
| 144 |
|
| 145 |
sub file_completion { |
| 146 |
mglob "$_[0]*", GLOB_MARK|GLOB_TILDE; |
| 147 |
} |
| 148 |
|
| 149 |
sub mfav { |
| 150 |
my ($cmd, $value) = @_; |
| 151 |
if ($cmd eq "f" or $cmd eq "l") { |
| 152 |
if (defined $conf{log}) { |
| 153 |
my %time; |
| 154 |
local *LOG; |
| 155 |
open LOG, "<$conf{log}" and do { |
| 156 |
while (<LOG>) { |
| 157 |
if (/^[al] (\S+)/) { |
| 158 |
$time{$1} += 0.2; |
| 159 |
} elsif (/^[ds] (\S+)/) { |
| 160 |
$time{$1} -= 0.2; |
| 161 |
} elsif (/^T (\S+) (\S+)/) { |
| 162 |
$time{$1} += $2; |
| 163 |
} |
| 164 |
} |
| 165 |
}; |
| 166 |
my @time; |
| 167 |
my %base; |
| 168 |
for (keys %time) { |
| 169 |
next if -f uri_unesc $_; |
| 170 |
my $base = basename $_; |
| 171 |
$base{$base} += delete $time{$_}; |
| 172 |
} |
| 173 |
while (my ($k, $v) = each %time) { |
| 174 |
push @time, [$k, $v + $base{basename $k}]; |
| 175 |
} |
| 176 |
$value ||= 5; |
| 177 |
for (sort { $b->[1] <=> $a->[1] } @time) { |
| 178 |
printf "%10.2f %s\n", $_->[1], $_->[0]; |
| 179 |
add_url uri_unesc $_->[0] if $cmd eq "f"; |
| 180 |
last if --$value <= 0; |
| 181 |
} |
| 182 |
} else { |
| 183 |
print "this command requires a logfile\n"; |
| 184 |
} |
| 185 |
} else { |
| 186 |
print "unknown m command, use <f> or <l>.\n"; |
| 187 |
} |
| 188 |
} |
| 189 |
|
| 190 |
$SIG{INT} = |
| 191 |
$SIG{HUP} = |
| 192 |
$SIG{PIPE} = |
| 193 |
$SIG{TERM} = sub { exit }; |
| 194 |
|
| 195 |
# terribly fool the Term::ReadLine packages.. |
| 196 |
sub Tk::DoOneEvent { } |
| 197 |
sub Term::ReadLine::Tk::Tk_loop { &event_loop } |
| 198 |
sub Term::ReadLine::Tk::register_Tk { } |
| 199 |
|
| 200 |
$rl = new Term::ReadLine "mpg123sh"; |
| 201 |
$rl->tkRunning(1); |
| 202 |
|
| 203 |
$rl->Attribs->{completion_function} = sub { |
| 204 |
my ($word,$line,$pos) = @_; |
| 205 |
$word ||= ""; $line ||= ""; $pos ||= 0; |
| 206 |
$p = ""; |
| 207 |
$c = $word; |
| 208 |
$rl->Attribs->{completer_terminator_character}=""; |
| 209 |
if ($pos==0) { |
| 210 |
if ($word=~/^(l(?:oad)?|a(?:dd)?|cd?)(\S.*)?/) { |
| 211 |
$p = $1." "; |
| 212 |
$c = $2; |
| 213 |
} |
| 214 |
} |
| 215 |
@r = file_completion uri_unesc($c); |
| 216 |
if ($line =~ /^c/) { |
| 217 |
@r = grep -d "$_/.", @r; |
| 218 |
} |
| 219 |
if (@r == 1) { |
| 220 |
if (-f $r[0]) { |
| 221 |
$rl->Attribs->{completer_terminator_character}=" "; |
| 222 |
} elsif (-d $r[0]) { |
| 223 |
$rl->Attribs->{completer_terminator_character}="/"; |
| 224 |
} |
| 225 |
} |
| 226 |
#print "\n<$word|$line|$pos> = ",join(":",@r)," #",scalar@r,"\n"; |
| 227 |
map $p.uri_esc($_),@r; |
| 228 |
}; |
| 229 |
|
| 230 |
my $pwr_state = 1; |
| 231 |
sub pwr_change { |
| 232 |
$SIG{PWR} = \&pwr_change; |
| 233 |
$pwr_state = !$pwr_state; |
| 234 |
|
| 235 |
}; |
| 236 |
$SIG{PWR} = \&pwr_change; |
| 237 |
|
| 238 |
sub event_loop { |
| 239 |
my $r; |
| 240 |
my $rlin = $rl->IN; |
| 241 |
# most ugly workaround for perl-readline bug |
| 242 |
if ($rl->ReadLine eq "Term::ReadLine::Perl") { |
| 243 |
require IO::Handle; |
| 244 |
my $o = (fcntl $rlin,F_GETFL,0) & (O_APPEND | O_NONBLOCK); |
| 245 |
fcntl $rlin,F_SETFL,$o | O_NONBLOCK; |
| 246 |
my $eof = eof($rlin); |
| 247 |
fcntl $rlin,F_SETFL,$o; |
| 248 |
return unless $eof; |
| 249 |
} |
| 250 |
do { |
| 251 |
next_song if $player->state == 0 && $pwr_state; |
| 252 |
$player->stop if $player->state && !$pwr_state; |
| 253 |
vec($r, fileno($rlin), 1) = 1; |
| 254 |
vec($r, fileno($player->IN), 1) = 1; |
| 255 |
(select $r, undef, undef, undef) < 0 and $r = ""; |
| 256 |
if (vec($r,fileno($player->IN),1)) { |
| 257 |
$player->poll(0); |
| 258 |
} |
| 259 |
} until vec($r, fileno($rlin), 1); |
| 260 |
} |
| 261 |
|
| 262 |
$player->statfreq(20); |
| 263 |
|
| 264 |
print "\nmpg123sh, version $Audio::Play::MPG123::VERSION\n"; |
| 265 |
print "enter 'help' for a command list\n\n"; |
| 266 |
|
| 267 |
for(;;) { |
| 268 |
my $prompt=fastcwd." "; |
| 269 |
if ($player->state) { |
| 270 |
$player->stat; |
| 271 |
$prompt.=$player->title." ".$player->{frame}[2]."/".($player->{frame}[2]+$player->{frame}[3]); |
| 272 |
} else { |
| 273 |
$prompt.=$p_url; |
| 274 |
} |
| 275 |
$_=$rl->readline("$prompt> "); |
| 276 |
if (/^l(?:oad)?\s*(.*?)\s*$/i) { |
| 277 |
my $url = $player->canonicalize_url(uri_unesc $1); |
| 278 |
load_url($url) or print "ERROR: ",$player->error,"\n"; |
| 279 |
mp3log("l", $url); |
| 280 |
$player->stat; |
| 281 |
} elsif (/^a(?:dd)?\s*(.*?)\s*$/i) { |
| 282 |
for (mglob uri_unesc $1, GLOB_TILDE|GLOB_NOMAGIC) { |
| 283 |
add_url $player->canonicalize_url($_); |
| 284 |
} |
| 285 |
} elsif (/^r(?:epeat)?\s*(\d+)\s*$/) { |
| 286 |
$playlist[-1][1] = $1; |
| 287 |
} elsif (/^p/i) { |
| 288 |
$player->pause; |
| 289 |
pause_url ($player->paused); |
| 290 |
} elsif (/^DD$/) { |
| 291 |
$p_repeat = 0; |
| 292 |
$player->stop; |
| 293 |
next_song; |
| 294 |
unlink @{pop @playlist}[0]; |
| 295 |
} elsif (/^d(?:el)?\s*(\d*)\s*$/i) { |
| 296 |
for (do { |
| 297 |
if ($1) { |
| 298 |
splice @playlist,$1-1,1; |
| 299 |
} else { |
| 300 |
$p_repeat = 0; |
| 301 |
$player->stop; |
| 302 |
next_song; |
| 303 |
pop @playlist; |
| 304 |
} |
| 305 |
}) { |
| 306 |
mp3log("d", $_->[0]); |
| 307 |
} |
| 308 |
} elsif (/^sh/i) { |
| 309 |
shuffle; |
| 310 |
} elsif (/^s/i) { |
| 311 |
$p_repeat=0; |
| 312 |
$player->stop; |
| 313 |
mp3log("s", $playlist[0][0]); |
| 314 |
next_song; |
| 315 |
} elsif (/^c(?:d)?\s*(.*?)\s*$/i) { |
| 316 |
chdir uri_unesc $1 or print "Unable to change to '$1': $!\n"; |
| 317 |
} elsif (/^j(?:ump)?\s*([0-9.]+)\s*$/i) { |
| 318 |
eval { $player->jump(int($1/$player->tpf)) }; |
| 319 |
} elsif (/^o\s*([a-z]+)\s*(.*)/i) { |
| 320 |
oconf($1,$2); |
| 321 |
} elsif (/^m\s*([a-z]+)\s*(.*)/i) { |
| 322 |
mfav($1,$2); |
| 323 |
} elsif (/^q/i) { |
| 324 |
last; |
| 325 |
} elsif (/^i(nfo)?/i) { |
| 326 |
print "\n"; |
| 327 |
if ($player->state) { |
| 328 |
print "currently playing: ",$player->url,"\n"; |
| 329 |
printf "title: %-32s artist: %-30s\n",$player->title,$player->artist; |
| 330 |
printf "album: %-32s year: %-30s\n",$player->album,$player->year; |
| 331 |
printf "comment: %-32s genre: %-30s\n",$player->comment,$player->genre; |
| 332 |
print "\n"; |
| 333 |
printf "MPEG %s layer %s, %d samples/s, %s, mode_extension is %d, %d bytes/frame\n". |
| 334 |
"%d channels, %s, %s, emphasis is %s, %d kbit/s\n", |
| 335 |
"I" x $player->type, $player->layer, $player->samplerate, $player->mode, $player->mode_extension, |
| 336 |
$player->bpf, $player->channels, $player->copyrighted ? "copyrighted" : "not copyrighted", |
| 337 |
$player->error_protected ? "error protection" : "no error protection", $player->emphasis ? "on" : "off", |
| 338 |
$player->bitrate; |
| 339 |
print "\n"; |
| 340 |
} |
| 341 |
for (my $i=0; $i<=$#playlist; $i++) { |
| 342 |
printf "%2d: %-30s repeat %d\n",$i+1,"'$playlist[$i][0]'",$playlist[$i][1]; |
| 343 |
} |
| 344 |
print "\n"; |
| 345 |
} elsif (/^h(help)?/i) { |
| 346 |
print <<EOF; |
| 347 |
|
| 348 |
load <file or url> loads the specified file and plays it immediately. |
| 349 |
add <file or url> pushes the specified song to the end of the playlist |
| 350 |
quit quits the program |
| 351 |
info print information about the song and the playlist. |
| 352 |
pause pause/unpause |
| 353 |
stop stop current song (and play next) |
| 354 |
shuffle shuffle currently selected songs once |
| 355 |
cd <path> change current directory |
| 356 |
del <num> remove song number <num> from the playlist |
| 357 |
del remove the currently playing song |
| 358 |
DD like del, but physically deleted the file(!!!) |
| 359 |
jump <second> seek to the specified position |
| 360 |
repeat <count> repeat the last recently added song <count times> |
| 361 |
help this listing |
| 362 |
o manipulate configuration |
| 363 |
o conf show current configuration |
| 364 |
o log <path> log all playing actions into file <path> |
| 365 |
m playlist management (not much there, yet) |
| 366 |
m f <num> add <num> favourite songs |
| 367 |
m l <num> list <num> favourite songs |
| 368 |
|
| 369 |
- most commands can be shortened to a one-letter form |
| 370 |
- most whitespace between command and arguments is optional |
| 371 |
|
| 372 |
EOF |
| 373 |
} elsif (/\S/) { |
| 374 |
print "unknown command, try 'help'\n"; |
| 375 |
} |
| 376 |
} |
| 377 |
|
| 378 |
|