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.63';

$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 frame
                  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 frame 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>.

The accessor function C<frame> returns a reference to an array containing
the frames played, frames left, seconds played, and seconds left in this
order. Seconds are returned as floating point numbers.

=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 <schmorp@schmorp.de>.

=head1 SEE ALSO

perl(1).

=cut
Revision:	1.3
Committed:	Thu Mar 3 17:01:39 2005 UTC (19 years, 2 months ago) by root
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.2:	+2 -2 lines
Log Message:	* empty log message *
#	Content
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.63';
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 frame
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 frame 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	The accessor function C<frame> returns a reference to an array containing
324	the frames played, frames left, seconds played, and seconds left in this
325	order. Seconds are returned as floating point numbers.
326
327	=item tpf [CACHING]
328
329	Returns the "time per frame", i.e. the time in seconds for one frame. Useful with the C<jump>-method:
330
331	$player->jump (60/$player->tpf);
332
333	Jumps to second 60.
334
335	=item IN
336
337	Returns the input filehandle from the mpg123 player. This can be used for selects() or poll().
338
339	=back
340
341	=head1 AUTHOR
342
343	Marc Lehmann <schmorp@schmorp.de>.
344
345	=head1 SEE ALSO
346
347	perl(1).
348
349	=cut