File Coverage

blib/lib/Audio/Play/MPlayer.pm
Criterion Covered Total %
statement 15 99 15.1
branch 0 48 0.0
condition 0 3 0.0
subroutine 5 20 25.0
pod 1 14 7.1
total 21 184 11.4


line stmt bran cond sub pod time code
1             package Audio::Play::MPlayer;
2              
3 4     4   18909 use strict;
  4         11  
  4         127  
4 4     4   19 use warnings;
  4         21  
  4         132  
5 4     4   28 use base qw(Class::Accessor::Fast);
  4         4  
  4         3319  
6              
7 4     4   17477 use IPC::Open3 qw(open3);
  4         18144  
  4         238  
8 4     4   3886 use IO::Handle;
  4         23109  
  4         6238  
9              
10             our $VERSION = '0.07';
11              
12             # FIXME, missing
13             # url type layer mode mode_extension copyrighted error_protected
14             # emphasis extension
15             __PACKAGE__->mk_ro_accessors( qw(frame title artist album year comment
16             genre samplerate channels bitrate
17             extension) );
18              
19             sub new {
20 0     0 1   my( $class, %args ) = @_;
21 0           my $self = bless \%args, $class;
22              
23 0           $self->start_mplayer( $args{mplayerargs} );
24 0           $self->{state} = 0;
25              
26 0           return $self;
27             }
28              
29             sub DESTROY {
30 0     0     my( $self ) = @_;
31              
32 0           $self->stop_mplayer;
33             }
34              
35             sub start_mplayer {
36 0     0 0   my( $self, $args ) = @_;
37 0           my( $wr, $rd );
38              
39 0 0         my $pid = open3( $wr, $rd, $rd,
40 0           'mplayer', '-slave', '-idle', '-v', @{$args || []} );
41              
42 0 0         die "Can't start mplayer" unless $pid;
43              
44 0           $self->{pid} = $pid;
45 0           $self->{r} = $rd;
46 0           $self->{w} = $wr;
47 0           $self->{r}->blocking( 0 );
48 0           $self->{frame} = [ undef, undef, undef, undef ];
49 0           $self->{buffer} = '';
50             }
51              
52             sub stop_mplayer {
53 0     0 0   my( $self ) = @_;
54              
55 0 0         return unless $self->{pid};
56 0           $self->command( 'quit' );
57 0           my $pid = delete $self->{pid};
58 0           close delete $self->{r};
59 0           close delete $self->{w};
60 0           waitpid $pid, 0;
61             }
62              
63             sub line {
64 0     0 0   my( $self, $wait ) = @_;
65              
66 0           for(;;) {
67             # append to buffer
68 0           my $len = sysread $self->{r}, $self->{buffer}, 2048,
69             length( $self->{buffer} );
70 0 0         return $1 if $self->{buffer} =~ s/^([^\n\r]*)[\r\n]+//;
71 0 0         if( $wait ) {
72 0           vec( my $rbits = '', fileno( $self->{r} ), 1 ) = 1;
73 0           select $rbits, undef, undef, 60;
74             } else {
75 0           return;
76             }
77             }
78             }
79              
80             my %info =
81             ( meta_title => [ 'get_meta_title', 'title', ],
82             meta_artist => [ 'get_meta_artist', 'artist', ],
83             meta_album => [ 'get_meta_album', 'album', ],
84             meta_year => [ 'get_meta_year', 'year', ],
85             meta_comment => [ 'get_meta_comment', 'comment', ],
86             meta_genre => [ 'get_meta_genre', 'genre', ],
87             );
88              
89             # AUDIO: 44100 Hz, 2 ch, s16le, 128.0 kbit/9.07% (ratio: 16000->176400)
90             # A: 16.5 (16.4) of 252.3 (04:12.3) 3.6%
91             # ===== PAUSE =====
92             sub parse {
93 0     0 0   my( $self, $re, $wait ) = @_;
94              
95 0           while( my $line = $self->line( $wait ) ) {
96 0 0         if( $line =~ /^EOF code:/ ) {
    0          
    0          
    0          
    0          
    0          
    0          
97 0           $self->{state} = 0;
98             }
99             elsif($line =~ /^A:\s+([\d\.]+)\s+\([\d\:\.]+\)\s+of\s+([\d\.]+)/ ) {
100 0           $self->{frame}->[2] = $1;
101 0           $self->{frame}->[3] = $2 - $1;
102             # FIXME heuristic
103 0 0         $self->{state} = 0 if $self->{frame}->[3] <= 0;
104             }
105             elsif( $line =~ /=====\s+PAUSE\s+=====/ ) {
106 0           $self->{state} = 1;
107             }
108             elsif( $line =~ /^ANS_(\w+)='([^']+)'$/ ) {
109             # FIXME quoting
110 0           my( $k, $v ) = ( lc( $1 ), $2 );
111              
112 0 0         if( $info{$k} ) {
113 0           $self->{$info{$k}->[1]} = $v;
114             }
115             }
116             elsif( $line =~ /^AUDIO:\s+(\d+)/ ) {
117 0           $self->{samplerate} = $1;
118              
119 0 0         if( $line =~ /(\d+)\s+ch/i ) {
120 0           $self->{channels} = $1;
121             }
122              
123 0 0         if( $line =~ /(\d+)\.\d+\s+kbit/i ) {
124 0           $self->{bitrate} = $1;
125             }
126              
127             }
128             elsif( $line =~ /^Playing\s/ ) {
129 0           $self->{$_->[1]} = undef foreach values %info;
130 0           $self->command( $_->[0] ) foreach values %info;
131             }
132             elsif( $line =~ /^\s+(title|artist|album|year|comment|genre):\s(.*?)\s*$/i ) {
133             # FIXME heuristic
134 0           $self->{lc($1)} = $2;
135             }
136             else {
137             # print STDERR $line, "\n";
138             }
139              
140 0 0         return $line if $line =~ $re;
141             }
142              
143 0           return;
144             }
145              
146             sub poll {
147 0     0 0   my( $self, $wait ) = @_;
148              
149 0           $self->parse( qr/./, $wait ); # wait for anything
150 0           $self->parse( qr/^\0/, 0 ); # consume pending output
151             }
152              
153             sub command {
154 0     0 0   my( $self, $command ) = @_;
155              
156 0           print { $self->{w} } $command, "\n";
  0            
157             }
158              
159             sub load {
160 0     0 0   my( $self, $file ) = @_;
161              
162             # FIXME quoting
163 0           $self->command( qq{loadfile "$file"} );
164 0           $self->{state} = 2; # feeling lucky
165             }
166              
167             sub state {
168 0     0 0   my( $self ) = @_;
169              
170 0           return $self->{state};
171             }
172              
173             # FIXME works more-or-less
174             sub stop {
175 0     0 0   my( $self ) = @_;
176              
177 0 0         return if $self->{state} == 0;
178 0 0         $self->pause if $self->{state} == 2;
179 0           $self->command( 'stop' );
180             #$self->command( 'pausing_keep seek 0.0 2' );
181 0           $self->poll;
182 0           $self->{state} = 0;
183             }
184              
185             sub pause {
186 0     0 0   my( $self ) = @_;
187              
188 0 0         return if $self->{state} == 0;
189 0           $self->command( "pause" );
190 0 0         if( $self->{state} == 2 ) {
    0          
191 0           $self->parse( qr/=====\s+PAUSE\s+=====/, 1 );
192             # try to parse metatdata command answers
193 0           $self->poll;
194             } elsif( $self->{state} == 1 ) {
195 0           $self->{state} = 2;
196             }
197             }
198              
199 0 0   0 0   sub paused { $_[0]->{state} == 2 ? 0 : 1 }
200              
201             # FIXME not like Audio::Play::MPG123
202             sub jump {
203 0     0 0   my( $self, $seconds ) = @_;
204              
205 0 0 0       if( $seconds && $seconds =~ /^[+\-]/ ) {
206 0           $self->command( "seek $seconds 0" );
207             } else {
208 0           $self->command( "seek $seconds 2" );
209             }
210             }
211              
212             # mock Audio::Play::MPG123
213 0     0 0   sub tpf { 1 }
214              
215             1;
216              
217             __END__