perl/mpmix/MPlayer.pm

   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;