Commit | Line | Data |
---|---|---|
2e9749f0 H |
1 | package Audio::Play::MPlayer; |
2 | ||
3 | use strict; | |
4 | use warnings; | |
5 | #use base qw(Class::Accessor::Fast); | |
6 | use base qw(Object::Accessor); | |
7 | ||
8 | =head1 NAME | |
9 | ||
10 | Audio::Play::MPlayer - a frontend to play audio files using MPlayer | |
11 | ||
12 | =head1 SYNOPSIS | |
13 | ||
14 | use Audio::Play::MPlayer; | |
15 | ||
16 | # same as Audio::Play::MPG123 | |
17 | $player = Audio::Play::MPlayer->new; | |
18 | ||
19 | # Set speed to _2.5x_ | |
20 | $player->speed(+1.5); | |
21 | ||
22 | $player->load( "ex-mp30.mp3" ); | |
23 | print $player->title, "\n"; | |
24 | $player->poll( 1 ) until $player->state == 0; | |
25 | ||
26 | =head1 DESCRIPTION | |
27 | ||
28 | This module acts as a frontend to an external MPlayer process started | |
29 | with the C<-slave> command-line option. The idea and interface (and | |
30 | in part the code) has been taken from L<Audio::Play::MPG123>. | |
31 | ||
32 | Please see L<Audio::Play::MPG123> for the documentation. Take into account | |
33 | that the methods: | |
34 | ||
35 | copyrighted | |
36 | emphasis | |
37 | error_protected | |
38 | extension | |
39 | layer | |
40 | mode | |
41 | mode_extension | |
42 | stat | |
43 | statfreq | |
44 | type | |
45 | url | |
46 | IN | |
47 | ||
48 | have not been implemented, and that: | |
49 | ||
50 | jump | |
51 | tpf | |
52 | ||
53 | work differently: C<jump> takes offsets in seconds, and C<tpf> always | |
54 | returns C<1> to make it possible to write: | |
55 | ||
56 | $player->jump( 60 / $player->tpf ); | |
57 | ||
58 | =cut | |
59 | ||
60 | use IPC::Open3 qw(open3); | |
61 | use IO::Handle; | |
62 | ||
63 | our $VERSION = '0.03'; | |
64 | ||
65 | # FIXME, missing | |
66 | # url type layer mode mode_extension copyrighted error_protected | |
67 | # emphasis extension | |
68 | #__PACKAGE__->mk_accessors( qw(frame title artist album year comment genre samplerate channels bitrate extension) ); | |
69 | #Object::Accessor->new( qw(frame title artist album year comment genre samplerate channels bitrate extension) ); | |
70 | ||
71 | #my $bool = $obj->mk_accessors( qw(frame title artist album year comment genre samplerate channels bitrate extension) ); | |
72 | ||
73 | sub new { | |
74 | my( $class, %args ) = @_; | |
75 | my $self = bless \%args, $class; | |
76 | ||
77 | $self->start_mplayer( $args{mplayerargs} ); | |
78 | $self->{state} = 0; | |
79 | ||
80 | $self->mk_accessors( qw(frame title artist album year comment genre samplerate channels bitrate extension) ); | |
81 | return $self; | |
82 | } | |
83 | ||
84 | sub DESTROY { | |
85 | my( $self ) = @_; | |
86 | ||
87 | $self->stop_mplayer; | |
88 | } | |
89 | ||
90 | sub start_mplayer { | |
91 | my( $self, $args ) = @_; | |
92 | my( $wr, $rd ); | |
93 | ||
94 | my $pid = open3( $wr, $rd, $rd, | |
95 | 'mplayer', '-slave', '-idle', @{$args || []} ); | |
96 | ||
97 | die "Can't start mplayer" unless $pid; | |
98 | ||
99 | $self->{pid} = $pid; | |
100 | $self->{r} = $rd; | |
101 | $self->{w} = $wr; | |
102 | $self->{r}->blocking( 0 ); | |
103 | $self->{frame} = [ undef, undef, undef, undef ]; | |
104 | $self->{buffer} = ''; | |
105 | } | |
106 | ||
107 | sub stop_mplayer { | |
108 | my( $self ) = @_; | |
109 | ||
110 | return unless $self->{pid}; | |
111 | $self->command( 'quit' ); | |
112 | my $pid = delete $self->{pid}; | |
113 | close delete $self->{r}; | |
114 | close delete $self->{w}; | |
115 | waitpid $pid, 0; | |
116 | } | |
117 | ||
118 | sub line { | |
119 | my( $self, $wait ) = @_; | |
120 | ||
121 | for(;;) { | |
122 | # append to buffer | |
123 | my $len = sysread $self->{r}, $self->{buffer}, 2048, | |
124 | length( $self->{buffer} ); | |
125 | return $1 if $self->{buffer} =~ s/^([^\n\r]*)[\r\n]+//; | |
126 | if( $wait ) { | |
127 | vec( my $rbits = '', fileno( $self->{r} ), 1 ) = 1; | |
128 | select $rbits, undef, undef, 60; | |
129 | } else { | |
130 | return; | |
131 | } | |
132 | } | |
133 | } | |
134 | ||
135 | my %info = | |
136 | ( meta_title => [ 'get_meta_title', 'title', ], | |
137 | meta_artist => [ 'get_meta_artist', 'artist', ], | |
138 | meta_album => [ 'get_meta_album', 'album', ], | |
139 | meta_year => [ 'get_meta_year', 'year', ], | |
140 | meta_comment => [ 'get_meta_comment', 'comment', ], | |
141 | meta_genre => [ 'get_meta_genre', 'genre', ], | |
142 | ); | |
143 | ||
144 | # AUDIO: 44100 Hz, 2 ch, s16le, 128.0 kbit/9.07% (ratio: 16000->176400) | |
145 | # A: 16.5 (16.4) of 252.3 (04:12.3) 3.6% | |
146 | # ===== PAUSE ===== | |
147 | sub parse { | |
148 | my( $self, $re, $wait ) = @_; | |
149 | ||
150 | while( my $line = $self->line( $wait ) ) { | |
151 | if( $line =~ /^A:\s+([\d\.]+)\s+\([\d\:\.]+\)\s+of\s+([\d\.]+)/ ) { | |
152 | $self->{frame}->[2] = $1; | |
153 | $self->{frame}->[3] = $2 - $1; | |
154 | # FIXME heuristic | |
155 | $self->{state} = 0 if $self->{frame}->[3] <= 0; | |
156 | } elsif( $line =~ /=====\s+PAUSE\s+=====/ ) { | |
157 | $self->{state} = 1; | |
158 | } elsif( $line =~ /^ANS_(\w+)='([^']+)'$/ ) { | |
159 | # FIXME quoting | |
160 | my( $k, $v ) = ( lc( $1 ), $2 ); | |
161 | ||
162 | if( $info{$k} ) { | |
163 | $self->{$info{$k}->[1]} = $v; | |
164 | } | |
165 | } elsif( $line =~ /^AUDIO:\s+(\d+)/ ) { | |
166 | $self->{samplerate} = $1; | |
167 | if( $line =~ /(\d+)\s+ch/i ) { | |
168 | $self->{channels} = $1; | |
169 | } | |
170 | if( $line =~ /(\d+)\.\d+\s+kbit/i ) { | |
171 | $self->{bitrate} = $1; | |
172 | } | |
173 | } elsif( $line =~ /^Playing\s/ ) { | |
174 | $self->{$_->[1]} = undef foreach values %info; | |
175 | $self->command( $_->[0] ) foreach values %info; | |
176 | } elsif( $line =~ /^\s+(title|artist|album|year|comment|genre):\s(.*?)\s*$/i ) { | |
177 | # FIXME heuristic | |
178 | $self->{lc($1)} = $2; | |
179 | } else { | |
180 | # print STDERR $line, "\n"; | |
181 | } | |
182 | return $line if $line =~ $re; | |
183 | } | |
184 | ||
185 | return; | |
186 | } | |
187 | ||
188 | sub poll { | |
189 | my( $self, $wait ) = @_; | |
190 | ||
191 | $self->parse( qr/./, $wait ); # wait for anything | |
192 | $self->parse( qr/^\0/, 0 ); # consume pending output | |
193 | } | |
194 | ||
195 | sub command { | |
196 | my( $self, $command ) = @_; | |
197 | ||
198 | print { $self->{w} } $command, "\n"; | |
199 | } | |
200 | ||
201 | sub load { | |
202 | my( $self, $file ) = @_; | |
203 | ||
204 | # FIXME quoting | |
205 | $self->command( qq{loadfile "$file"} ); | |
206 | $self->{state} = 2; # feeling lucky | |
207 | } | |
208 | ||
209 | sub state { | |
210 | my( $self ) = @_; | |
211 | ||
212 | return $self->{state}; | |
213 | } | |
214 | ||
215 | # FIXME works more-or-less | |
216 | sub stop { | |
217 | my( $self ) = @_; | |
218 | ||
219 | return if $self->{state} == 0; | |
220 | $self->pause if $self->{state} == 2; | |
221 | $self->command( 'pausing_keep seek 0.0 2' ); | |
222 | $self->poll; | |
223 | $self->{state} = 0; | |
224 | } | |
225 | ||
226 | sub pause { | |
227 | my( $self ) = @_; | |
228 | ||
229 | return if $self->{state} == 0; | |
230 | $self->command( "pause" ); | |
231 | if( $self->{state} == 2 ) { | |
232 | $self->parse( qr/=====\s+PAUSE\s+=====/, 1 ); | |
233 | # try to parse metatdata command answers | |
234 | $self->poll; | |
235 | } elsif( $self->{state} == 1 ) { | |
236 | $self->{state} = 2; | |
237 | } | |
238 | } | |
239 | ||
240 | sub paused { $_[0]->{state} == 2 ? 0 : 1 } | |
241 | ||
242 | # FIXME not like Audio::Play::MPG123 | |
243 | sub jump { | |
244 | my( $self, $seconds ) = @_; | |
245 | ||
246 | if( $seconds && $seconds =~ /^[+\-]/ ) { | |
247 | $self->command( "seek $seconds 0" ); | |
248 | } else { | |
249 | $self->command( "seek $seconds 2" ); | |
250 | } | |
251 | } | |
252 | ||
253 | # Sets the player speed to current speed + delta | |
254 | sub speed { | |
255 | my( $self, $delta ) = @_; | |
256 | ||
257 | return if $self->{state} == 0; | |
258 | return if not defined $delta or $delta == 0; | |
259 | ||
260 | $self->command( sprintf( "speed %.2f", $delta ) ); | |
261 | return; | |
262 | } | |
263 | ||
264 | # mock Audio::Play::MPG123 | |
265 | sub tpf { 1 } | |
266 | ||
267 | =head1 AUTHOR | |
268 | ||
269 | Mattia Barbon <mbarbon@cpan.org>, using ideas from | |
270 | L<Audio::Play::MPG123> by Marc Lehmann <schmorp@schmorp.de>. | |
271 | ||
272 | =head1 LICENSE | |
273 | ||
274 | This program is free software; you can redistribute it and/or | |
275 | modify it under the same terms as Perl itself. | |
276 | ||
277 | =head1 SOURCES | |
278 | ||
279 | The latest sources can be found on GitHub at | |
280 | L<http://github.com/mbarbon/audio-play-mplayer/tree> | |
281 | ||
282 | =head1 THANKS | |
283 | ||
284 | Marc Lehmann <schmorp@schmorp.de> for L<Audio::Play::MPG123>. | |
285 | ||
286 | The MP3 file used in tests has been taken from | |
287 | L<http://www.shellworld.net/~davidsky/exam-mp3.htm> (test ID3 tag not | |
288 | in original). | |
289 | ||
290 | =cut | |
291 | ||
292 | 1; |