Audio-Play-MPG123/MPG123.pm

package Audio::Play::MPG123;

use strict 'subs';
use Carp;

require Exporter;
use Fcntl;
use IPC::Open3;
use Cwd;
use File::Spec;
use Errno qw(EAGAIN EINTR);

BEGIN { $^W=0 } # I'm fed up with bogus and unnecessary warnings nobody can turn off.

@ISA = qw(Exporter);

@_consts = qw();
@_funcs = qw();

@EXPORT = @_consts;
@EXPORT_OK = @_funcs;
%EXPORT_TAGS = (all => [@_consts,@_funcs], constants => \@_consts);
$VERSION = '0.62';

$MPG123 = "mpg123";

$OPT_AUTOSTAT = 1;

sub new {
   my $class = shift;
   my $self = bless { @_ }, $class;
   $self->start_mpg123(@{$self->{mpg123args} || []});
   $self;
}

sub start_mpg123 {
   my $self = shift;
   local *DEVNULL;
   open DEVNULL, ">/dev/null" or die "/dev/null: $!";
   $self->{r} = local *MPG123_READER;
   $self->{w} = local *MPG123_WRITER;
   $self->{pid} = open3($self->{w},$self->{r},">&DEVNULL",$MPG123,'-R','--aggressive',@_,'');
   die "Unable to start $MPG123" unless $self->{pid};
   fcntl $self->{r}, F_SETFL, O_NONBLOCK;
   fcntl $self->{r}, F_SETFD, FD_CLOEXEC;
   $self->parse(qr/^\@?R (\S+)/,1) or die "Error during player startup: $self->{err}\n";
   $self->{version}=$1;
}

sub stop_mpg123 {
   my $self = shift;
   if (delete $self->{pid}) {
      print {$self->{w}} "Q\n";
      close $self->{w};
      close $self->{r};
   }
}

sub line {
   my $self = shift;
   my $wait = shift;
   while() {
      return $1 if $self->{buf} =~ s/^([^\n]*)\n+//;
      my $len = sysread $self->{r},$self->{buf},4096,length($self->{buf});
      # telescope the most frequent event, very useful for slow machines
      $self->{buf} =~ s/^(?:\@F[^\n]*\n)+(?=\@F)//s;
      if (defined $len || ($! != EAGAIN && $! != EINTR)) {
         die "connection to mpg123 process lost: $!\n" if $len == 0;
      } else {
         if ($wait) {
            my $v = ""; vec($v,fileno($self->{r}),1)=1;
            select ($v, undef, undef, 60);
         } else {
            return ();
         }
      }
   }
}

sub parse {
   my $self = shift;
   my $re   = shift;
   my $wait = shift;
   while (my $line = $self->line ($wait)) {
      if ($line =~ /^\@F (.*)$/) {
         $self->{frame}=[split /\s+/,$1];
         # sno rno tim1 tim2
      } elsif ($line =~ /^\@S (.*)$/) {
         @{$self}{qw(type layer samplerate mode mode_extension
                     bpf channels copyrighted error_protected
                     emphasis bitrate extension lsf)}=split /\s+/,$1;
         $self->{tpf} = ($self->{layer}>1 ? 1152 : 384) / $self->{samplerate};
         $self->{tpf} *= 0.5 if $self->{lsf};
         $self->{state} = 2;
      } elsif ($line =~ /^\@I ID3:(.{30})(.{30})(.{30})(....)(.{30})(.*)$/) {
         $self->{title}=$1;   $self->{artist}=$2;
         $self->{album}=$3;   $self->{year}=$4;
         $self->{comment}=$5; $self->{genre}=$6;
         $self->{$_} =~ s/\s+$// for qw(title artist album year comment genre);
      } elsif ($line =~ /^\@I (.*)$/) {
         $self->{title}=$1;
         delete @{$self}{qw(artist album year comment genre)}
      } elsif ($line =~ /^\@P (\d+)(?: (\S+))?$/) {
         $self->{state} = $1;
         # 0 = stopped, 1 = paused, 2 = continued
      } elsif ($line =~ /^\@E (.*)$/) {
         $self->{err}=$1;
         return ();
      } elsif ($line !~ $re) {
         $self->{err}="Unknown response: $line";
         return ();
      }
      return $line if $line =~ $re;
   }
   delete $self->{err};
   return ();
}

sub poll {
   my $self = shift;
   my $wait = shift;
   $self->parse(qr//,1) if $wait;
   $self->parse(qr/^X\0/,0);
}

sub canonicalize_url {
   my $self = shift;
   my $url  = shift;
   if ($url !~ m%^http://%) {
      $url =~ s%^file://[^/]*/%%;
      $url = fastcwd."/".$url unless $url =~ /^\//;
   }
   $url;
}

sub load {
   my $self = shift;
   my $url  = $self->canonicalize_url(shift);
   $self->{url} = $url;
   if ($url !~ /^http:/ && !-f $url) {
      $self->{err} = "No such file or directory: $url";
      return ();
   }
   print {$self->{w}} "LOAD $url\n";
   delete @{$self}{qw(frame type layer samplerate mode mode_extension bpf lsf
                      channels copyrighted error_protected title artist album
                      year comment genre emphasis bitrate extension)};
   $self->parse(qr{^\@[SP]\s},1);
   return $self->{state};
}

sub stat {
   my $self = shift;
   return unless $self->{state};
   print {$self->{w}} "STAT\n";
   $self->parse(qr{^\@F},1);
}

sub pause {
   my $self = shift;
   print {$self->{w}} "PAUSE\n";
   $self->parse(qr{^\@P},1);
}

sub paused {
   2 - $_[0]{state};
}

sub jump {
   my $self = shift;
   print {$self->{w}} "JUMP $_[0]\n";
}

sub statfreq {
   my $self = shift;
   print {$self->{w}} "STATFREQ $_[0]\n";
}

sub stop {
   my $self = shift;
   print {$self->{w}} "STOP\n";
   $self->parse(qr{^\@P},1);
}

sub IN {
   $_[0]->{r};
}

sub tpf {
   my $self = shift;
   $self->{tpf};
}

for my $field (qw(title artist album year comment genre state url
                  type layer samplerate mode mode_extension bpf
                  channels copyrighted error_protected title artist album
                  year comment genre emphasis bitrate extension)) {
  *{$field} = sub { $_[0]{$field} };
}

sub error { shift->{err} }

1;
__END__

=head1 NAME

Audio::Play::MPG123 - a frontend to mpg123 version 0.59r and beyond.

=head1 SYNOPSIS

  use Audio::Play::MPG123;
  
  $player = new Audio::Play::MPG123;
  $player->load("kult.mp3");
  print $player->artist,"\n";
  $player->poll(1) until $player->state == 0;

  $player->load("http://x.y.z/kult.mp3");

  # see also mpg123sh from the tarball

=head1 DESCRIPTION

This is a frontend to the mpg123 player. It works by starting an external
mpg123 process with the C<-R> option and feeding commands to it.

While the standard mpg123 player can be used to play back mp3's using
this module you will encounter random deadlocks, due to bugs in its
communication code. Also, many features (like C<statfreq>) only work with
the included copy of mpg123, so better use that one before deciding that
this module is broken.

(In case you wonder, the mpg123 author is not interested in including
these fixes and enhancements into mpg123).

=head2 METHODS

Most methods can be either BLOCKING (they wait until they get an answer,
which usually takes half a mpeg frame of playing time), NONBLOCKING (the
functions return as soon as they send their message, which is usallly
instant) or CACHING (the method returns some cached data which only gets
refreshed by an asynchronous STAT event or an explicit call to C<state>).

=over 4

=item new [parameter => value, ...]

This creates a new player object and also starts the mpg123 process. New
supports the following parameters:

   mpg123args      an arrayreg with additional arguments for the mpg123 process

=item load(<path or url>) [BLOCKING]

Immediately loads the specified file (or url, http:// and file:/// forms
supported) and starts playing it. If you really want to play a file with
a name starting with C<file://> or C<http://> then consider prefixing all
your paths with C<file:///>. Returns a true status when the song could be
started, false otherwise.

=item stat [BLOCKING]

This can be used to poll the player for it's current state (playing mode,
frame position &c). As every other function that requires communication
with mpg123, it might take up to one frame delay until the answer returns.
Using C<statfreq> and infrequent calls to C<poll> is often a better
strategy.

=item pause [BLOCKING]

Pauses or unpauses the song. C<state> (or C<paused>) can be used to find
out about the current mode.

=item paused [CACHING]

Returns the opposite of C<state>, i.e. zero when something is playing
and non-zero when the player is stopped or paused.

=item jump [BLOCKING]

Jumps to the specified frame of the song. If the number is prefixed with
"+" or "-", the jump is relative, otherweise it is absolute.

=item stop [BLOCKING]

Stops the currently playing song and unloads it.

=item statfreq(rate) [NONBLOCKING]

Sets the rate at which automatic frame updates are sent by mpg123. C<0>
turns it off, everything else is the average number of frames between
updates.  This can be a floating pount value, i.e.

 $player->statfreq(0.5/$player->tpf);

will set two updates per second (one every half a second).

=item state [CACHING]

Returns the current state of the player:

 0  stopped, not playing anything
 1  paused, song loaded but not playing
 2  playing, song loaded and playing

=item poll(<wait>) [BLOCKING or NONBLOCKING]

Parses all outstanding events and status information. If C<wait> is zero
it will only parse as many messages as are currently in the queue, if it
is one it will wait until at least one event occured.

This can be used to wait for the end of a song, for example. This function
should be called regularly, since mpg123 will stop playing when it can't
write out events because the perl program is no longer listening...

=item title artist album year comment genre url type layer samplerate mode mode_extension bpf channels copyrighted error_protected title artist album year comment genre emphasis bitrate extension [CACHING]

These accessor functions return information about the loaded
song. Information about the C<artist>, C<album>, C<year>, C<comment> or
C<genre> might not be available and will be returned as C<undef>.

=item tpf [CACHING]

Returns the "time per frame", i.e. the time in seconds for one frame. Useful with the C<jump>-method:

 $player->jump (60/$player->tpf);

Jumps to second 60.

=item IN

Returns the input filehandle from the mpg123 player. This can be used for selects() or poll().

=back

=head1 AUTHOR

Marc Lehmann <pcg@goof.com>.

=head1 SEE ALSO

perl(1).

=cut
Revision:	1.1
Committed:	Fri May 18 12:49:05 2001 UTC (23 years ago) by root
Branch:	MAIN
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	package Audio::Play::MPG123;
2
3			use strict 'subs';
4			use Carp;
5
6			require Exporter;
7			use Fcntl;
8			use IPC::Open3;
9			use Cwd;
10			use File::Spec;
11			use Errno qw(EAGAIN EINTR);
12
13			BEGIN { $^W=0 } # I'm fed up with bogus and unnecessary warnings nobody can turn off.
14
15			@ISA = qw(Exporter);
16
17			@_consts = qw();
18			@_funcs = qw();
19
20			@EXPORT = @_consts;
21			@EXPORT_OK = @_funcs;
22			%EXPORT_TAGS = (all => [@_consts,@_funcs], constants => \@_consts);
23			$VERSION = '0.62';
24
25			$MPG123 = "mpg123";
26
27			$OPT_AUTOSTAT = 1;
28
29			sub new {
30			my $class = shift;
31			my $self = bless { @_ }, $class;
32			$self->start_mpg123(@{$self->{mpg123args} \|\| []});
33			$self;
34			}
35
36			sub start_mpg123 {
37			my $self = shift;
38			local *DEVNULL;
39			open DEVNULL, ">/dev/null" or die "/dev/null: $!";
40			$self->{r} = local *MPG123_READER;
41			$self->{w} = local *MPG123_WRITER;
42			$self->{pid} = open3($self->{w},$self->{r},">&DEVNULL",$MPG123,'-R','--aggressive',@_,'');
43			die "Unable to start $MPG123" unless $self->{pid};
44			fcntl $self->{r}, F_SETFL, O_NONBLOCK;
45			fcntl $self->{r}, F_SETFD, FD_CLOEXEC;
46			$self->parse(qr/^\@?R (\S+)/,1) or die "Error during player startup: $self->{err}\n";
47			$self->{version}=$1;
48			}
49
50			sub stop_mpg123 {
51			my $self = shift;
52			if (delete $self->{pid}) {
53			print {$self->{w}} "Q\n";
54			close $self->{w};
55			close $self->{r};
56			}
57			}
58
59			sub line {
60			my $self = shift;
61			my $wait = shift;
62			while() {
63			return $1 if $self->{buf} =~ s/^([^\n]*)\n+//;
64			my $len = sysread $self->{r},$self->{buf},4096,length($self->{buf});
65			# telescope the most frequent event, very useful for slow machines
66			$self->{buf} =~ s/^(?:\@F[^\n]*\n)+(?=\@F)//s;
67			if (defined $len \|\| ($! != EAGAIN && $! != EINTR)) {
68			die "connection to mpg123 process lost: $!\n" if $len == 0;
69			} else {
70			if ($wait) {
71			my $v = ""; vec($v,fileno($self->{r}),1)=1;
72			select ($v, undef, undef, 60);
73			} else {
74			return ();
75			}
76			}
77			}
78			}
79
80			sub parse {
81			my $self = shift;
82			my $re = shift;
83			my $wait = shift;
84			while (my $line = $self->line ($wait)) {
85			if ($line =~ /^\@F (.*)$/) {
86			$self->{frame}=[split /\s+/,$1];
87			# sno rno tim1 tim2
88			} elsif ($line =~ /^\@S (.*)$/) {
89			@{$self}{qw(type layer samplerate mode mode_extension
90			bpf channels copyrighted error_protected
91			emphasis bitrate extension lsf)}=split /\s+/,$1;
92			$self->{tpf} = ($self->{layer}>1 ? 1152 : 384) / $self->{samplerate};
93			$self->{tpf} *= 0.5 if $self->{lsf};
94			$self->{state} = 2;
95			} elsif ($line =~ /^\@I ID3:(.{30})(.{30})(.{30})(....)(.{30})(.*)$/) {
96			$self->{title}=$1; $self->{artist}=$2;
97			$self->{album}=$3; $self->{year}=$4;
98			$self->{comment}=$5; $self->{genre}=$6;
99			$self->{$_} =~ s/\s+$// for qw(title artist album year comment genre);
100			} elsif ($line =~ /^\@I (.*)$/) {
101			$self->{title}=$1;
102			delete @{$self}{qw(artist album year comment genre)}
103			} elsif ($line =~ /^\@P (\d+)(?: (\S+))?$/) {
104			$self->{state} = $1;
105			# 0 = stopped, 1 = paused, 2 = continued
106			} elsif ($line =~ /^\@E (.*)$/) {
107			$self->{err}=$1;
108			return ();
109			} elsif ($line !~ $re) {
110			$self->{err}="Unknown response: $line";
111			return ();
112			}
113			return $line if $line =~ $re;
114			}
115			delete $self->{err};
116			return ();
117			}
118
119			sub poll {
120			my $self = shift;
121			my $wait = shift;
122			$self->parse(qr//,1) if $wait;
123			$self->parse(qr/^X\0/,0);
124			}
125
126			sub canonicalize_url {
127			my $self = shift;
128			my $url = shift;
129			if ($url !~ m%^http://%) {
130			$url =~ s%^file://[^/]*/%%;
131			$url = fastcwd."/".$url unless $url =~ /^\//;
132			}
133			$url;
134			}
135
136			sub load {
137			my $self = shift;
138			my $url = $self->canonicalize_url(shift);
139			$self->{url} = $url;
140			if ($url !~ /^http:/ && !-f $url) {
141			$self->{err} = "No such file or directory: $url";
142			return ();
143			}
144			print {$self->{w}} "LOAD $url\n";
145			delete @{$self}{qw(frame type layer samplerate mode mode_extension bpf lsf
146			channels copyrighted error_protected title artist album
147			year comment genre emphasis bitrate extension)};
148			$self->parse(qr{^\@[SP]\s},1);
149			return $self->{state};
150			}
151
152			sub stat {
153			my $self = shift;
154			return unless $self->{state};
155			print {$self->{w}} "STAT\n";
156			$self->parse(qr{^\@F},1);
157			}
158
159			sub pause {
160			my $self = shift;
161			print {$self->{w}} "PAUSE\n";
162			$self->parse(qr{^\@P},1);
163			}
164
165			sub paused {
166			2 - $_[0]{state};
167			}
168
169			sub jump {
170			my $self = shift;
171			print {$self->{w}} "JUMP $_[0]\n";
172			}
173
174			sub statfreq {
175			my $self = shift;
176			print {$self->{w}} "STATFREQ $_[0]\n";
177			}
178
179			sub stop {
180			my $self = shift;
181			print {$self->{w}} "STOP\n";
182			$self->parse(qr{^\@P},1);
183			}
184
185			sub IN {
186			$_[0]->{r};
187			}
188
189			sub tpf {
190			my $self = shift;
191			$self->{tpf};
192			}
193
194			for my $field (qw(title artist album year comment genre state url
195			type layer samplerate mode mode_extension bpf
196			channels copyrighted error_protected title artist album
197			year comment genre emphasis bitrate extension)) {
198			*{$field} = sub { $_[0]{$field} };
199			}
200
201			sub error { shift->{err} }
202
203			1;
204			__END__
205
206			=head1 NAME
207
208			Audio::Play::MPG123 - a frontend to mpg123 version 0.59r and beyond.
209
210			=head1 SYNOPSIS
211
212			use Audio::Play::MPG123;
213
214			$player = new Audio::Play::MPG123;
215			$player->load("kult.mp3");
216			print $player->artist,"\n";
217			$player->poll(1) until $player->state == 0;
218
219			$player->load("http://x.y.z/kult.mp3");
220
221			# see also mpg123sh from the tarball
222
223			=head1 DESCRIPTION
224
225			This is a frontend to the mpg123 player. It works by starting an external
226			mpg123 process with the C<-R> option and feeding commands to it.
227
228			While the standard mpg123 player can be used to play back mp3's using
229			this module you will encounter random deadlocks, due to bugs in its
230			communication code. Also, many features (like C<statfreq>) only work with
231			the included copy of mpg123, so better use that one before deciding that
232			this module is broken.
233
234			(In case you wonder, the mpg123 author is not interested in including
235			these fixes and enhancements into mpg123).
236
237			=head2 METHODS
238
239			Most methods can be either BLOCKING (they wait until they get an answer,
240			which usually takes half a mpeg frame of playing time), NONBLOCKING (the
241			functions return as soon as they send their message, which is usallly
242			instant) or CACHING (the method returns some cached data which only gets
243			refreshed by an asynchronous STAT event or an explicit call to C<state>).
244
245			=over 4
246
247			=item new [parameter => value, ...]
248
249			This creates a new player object and also starts the mpg123 process. New
250			supports the following parameters:
251
252			mpg123args an arrayreg with additional arguments for the mpg123 process
253
254			=item load(<path or url>) [BLOCKING]
255
256			Immediately loads the specified file (or url, http:// and file:/// forms
257			supported) and starts playing it. If you really want to play a file with
258			a name starting with C<file://> or C<http://> then consider prefixing all
259			your paths with C<file:///>. Returns a true status when the song could be
260			started, false otherwise.
261
262			=item stat [BLOCKING]
263
264			This can be used to poll the player for it's current state (playing mode,
265			frame position &c). As every other function that requires communication
266			with mpg123, it might take up to one frame delay until the answer returns.
267			Using C<statfreq> and infrequent calls to C<poll> is often a better
268			strategy.
269
270			=item pause [BLOCKING]
271
272			Pauses or unpauses the song. C<state> (or C<paused>) can be used to find
273			out about the current mode.
274
275			=item paused [CACHING]
276
277			Returns the opposite of C<state>, i.e. zero when something is playing
278			and non-zero when the player is stopped or paused.
279
280			=item jump [BLOCKING]
281
282			Jumps to the specified frame of the song. If the number is prefixed with
283			"+" or "-", the jump is relative, otherweise it is absolute.
284
285			=item stop [BLOCKING]
286
287			Stops the currently playing song and unloads it.
288
289			=item statfreq(rate) [NONBLOCKING]
290
291			Sets the rate at which automatic frame updates are sent by mpg123. C<0>
292			turns it off, everything else is the average number of frames between
293			updates. This can be a floating pount value, i.e.
294
295			$player->statfreq(0.5/$player->tpf);
296
297			will set two updates per second (one every half a second).
298
299			=item state [CACHING]
300
301			Returns the current state of the player:
302
303			0 stopped, not playing anything
304			1 paused, song loaded but not playing
305			2 playing, song loaded and playing
306
307			=item poll(<wait>) [BLOCKING or NONBLOCKING]
308
309			Parses all outstanding events and status information. If C<wait> is zero
310			it will only parse as many messages as are currently in the queue, if it
311			is one it will wait until at least one event occured.
312
313			This can be used to wait for the end of a song, for example. This function
314			should be called regularly, since mpg123 will stop playing when it can't
315			write out events because the perl program is no longer listening...
316
317			=item title artist album year comment genre url type layer samplerate mode mode_extension bpf channels copyrighted error_protected title artist album year comment genre emphasis bitrate extension [CACHING]
318
319			These accessor functions return information about the loaded
320			song. Information about the C<artist>, C<album>, C<year>, C<comment> or
321			C<genre> might not be available and will be returned as C<undef>.
322
323			=item tpf [CACHING]
324
325			Returns the "time per frame", i.e. the time in seconds for one frame. Useful with the C<jump>-method:
326
327			$player->jump (60/$player->tpf);
328
329			Jumps to second 60.
330
331			=item IN
332
333			Returns the input filehandle from the mpg123 player. This can be used for selects() or poll().
334
335			=back
336
337			=head1 AUTHOR
338
339			Marc Lehmann <pcg@goof.com>.
340
341			=head1 SEE ALSO
342
343			perl(1).
344
345			=cut