[xiph-cvs] cvs commit: shout-perl Shout.pm Shout.xs

Brendan brendan at xiph.org
Sat Jul 5 11:42:50 PDT 2003



brendan     03/07/05 14:42:50

  Modified:    .        Shout.pm Shout.xs
  Log:
  Bumped to version 2.0
  Now a complete implementation
  Added backwards compatibility with version 1.0

Revision  Changes    Path
1.2       +308 -198  shout-perl/Shout.pm

Index: Shout.pm
===================================================================
RCS file: /usr/local/cvsroot/shout-perl/Shout.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -p -u -r1.1 -r1.2
--- Shout.pm	3 Jul 2003 16:42:06 -0000	1.1
+++ Shout.pm	5 Jul 2003 18:42:50 -0000	1.2
@@ -19,9 +19,9 @@ Shout - Perl glue for libshout MP3 strea
         url		=> 'http://apan.org/'
         genre		=> 'Monkey Music',
         description	=> 'A whole lotta monkey music.',
-	format => SHOUT_FORMAT_MP3,
-        protocol => SHOUT_PROTOCOL_HTTP,
-	public	=> 0;
+	format          => SHOUT_FORMAT_MP3,
+        protocol        => SHOUT_PROTOCOL_HTTP,
+	public	        => 0;
 
   # - or -
 
@@ -40,18 +40,23 @@ Shout - Perl glue for libshout MP3 strea
   $conn->description('Stream with icecast at http://www.icecast.org');
   $conn->public(0);
 
+  ### Set your stream audio parameters for YP if you want
+  $conn->set_audio_info(SHOUT_AI_BITRATE => 128, SHOUT_AI_SAMPLERATE => 44100);
+
   ### Connect to the server
   $conn->open or die "Failed to open: ", $conn->get_error;
 
+  ### Set stream info
+  $conn->set_metadata('song' => 'Scott Joplin - Maple Leaf Rag');
+
   ### Stream some data
   my ( $buffer, $bytes ) = ( '', 0 );
   while( ($bytes = sysread( STDIN, $buffer, 4096 )) > 0 ) {
-	$conn->send( $buffer ) && next;
-	print STDERR "Error while sending: ", $conn->get_error, "\n";
-	last;
+      $conn->send( $buffer ) && next;
+      print STDERR "Error while sending: ", $conn->get_error, "\n";
+      last;
   } continue {
-		$secs=$conn->delay;
-		select($fds,undef,undef,$secs);
+      $conn->sync
   }
 
   ### Now close the connection
@@ -68,6 +73,8 @@ The following error constants are export
 
         SHOUT_FORMAT_MP3 SHOUT_FORMAT_VORBIS
         SHOUT_PROTOCOL_ICY SHOUT_PROTOCOL_XAUDIOCAST SHOUT_PROTOCOL_HTTP
+        SHOUT_AI_BITRATE SHOUT_AI_SAMPLERATE SHOUT_AI_CHANNELS
+        SHOUT_AI_QUALITY
 
 =head2 :functions
 
@@ -126,16 +133,18 @@ All of the above symbols can be imported
 
 =head1 DESCRIPTION
 
-This module is an object-oriented interface to libshout, an MP3 streaming
-library that allows applications to easily communicate and broadcast to an
-Icecast streaming media server. It handles the socket connections, metadata
-communication, and data streaming for the calling application, and lets
-developers focus on feature sets instead of implementation details.
+This module is an object-oriented interface to libshout, an Ogg Vorbis
+and MP3 streaming library that allows applications to easily
+communicate and broadcast to an Icecast streaming media server. It
+handles the socket connections, metadata communication, and data
+streaming for the calling application, and lets developers focus on
+feature sets instead of implementation details.
 
 =head1 AUTHOR
 
 Jack Moffitt <jack at icecast.org>
-Paul Bournival <paulb at cajun.nu> updates to icecast2
+Paul Bournival <paulb at cajun.nu> (update to icecast 2)
+Brendan Cully <brendan at xiph.org> (current maintainer)
 
 =cut
 
@@ -144,71 +153,84 @@ package Shout;
 use strict;
 
 BEGIN {
-	use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);
+    use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);
 
-	$VERSION = '1.1.2';
+    $VERSION = '2.0';
 
-	use Carp;
-	use Socket	qw{inet_aton inet_ntoa};
+    use Carp;
+
+    require Exporter;
+    require DynaLoader;
+    require AutoLoader;
+
+    # Inheritance
+    @ISA = qw(Exporter DynaLoader);
+
+    ### Exporter stuff
+    @EXPORT = qw{SHOUT_FORMAT_VORBIS SHOUT_FORMAT_MP3
+        SHOUT_PROTOCOL_ICY SHOUT_PROTOCOL_XAUDIOCAST SHOUT_PROTOCOL_HTTP
+        SHOUT_AI_BITRATE SHOUT_AI_SAMPLERATE SHOUT_AI_QUALITY
+        SHOUT_AI_CHANNELS
+	SHOUTERR_SUCCESS SHOUTERR_INSANE SHOUTERR_NOCONNECT SHOUTERR_NOLOGIN 
+	SHOUTERR_SOCKET SHOUTERR_MALLOC SHOUTERR_METADATA SHOUTERR_CONNECTED 
+	SHOUTERR_UNCONNECTED SHOUTERR_UNSUPPORTED 
+    };
+    @EXPORT_OK = qw{
+	SHOUT_FORMAT_VORBIS SHOUT_FORMAT_MP3
+	SHOUT_PROTOCOL_ICY SHOUT_PROTOCOL_XAUDIOCAST SHOUT_PROTOCOL_HTTP
+        SHOUT_AI_BITRATE SHOUT_AI_SAMPLERATE SHOUT_AI_QUALITY
+        SHOUT_AI_CHANNELS
+	SHOUTERR_SUCCESS SHOUTERR_INSANE SHOUTERR_NOCONNECT SHOUTERR_NOLOGIN 
+	SHOUTERR_SOCKET SHOUTERR_MALLOC SHOUTERR_METADATA SHOUTERR_CONNECTED 
+	SHOUTERR_UNCONNECTED SHOUTERR_UNSUPPORTED 
+	shout_open shout_close
+	shout_set_metadata shout_metadata_new shout_metadata_free 
+	shout_metadata_add shout_send_data shout_sync shout_delay
+	shout_set_host shout_set_port shout_set_mount shout_set_password
+	shout_set_dumpfile shout_set_name
+	shout_set_url shout_set_genre shout_set_description
+	shout_set_public shout_get_host
+	shout_get_port shout_get_mount shout_get_password
+	shout_get_dumpfile shout_get_name
+	shout_get_url shout_get_genre shout_get_description
+	shout_get_public shout_get_error shout_set_format shout_get_format
+	shout_get_audio_info shout_set_audio_info
+	shout_set_protocol shout_get_protocol shout_get_errno
+    };
+    %EXPORT_TAGS = (
+	all       => \@EXPORT_OK,
+	constants => [qw{SHOUT_FORMAT_VORBIS SHOUT_FORMAT_MP3
+            SHOUT_PROTOCOL_ICY SHOUT_PROTOCOL_XAUDIOCAST SHOUT_PROTOCOL_HTTP
+            SHOUT_AI_BITRATE SHOUT_AI_SAMPLERATE SHOUT_AI_QUALITY
+            SHOUT_AI_CHANNELS
+	    SHOUTERR_SUCCESS SHOUTERR_INSANE SHOUTERR_NOCONNECT SHOUTERR_NOLOGIN 
+	    SHOUTERR_SOCKET SHOUTERR_MALLOC SHOUTERR_METADATA SHOUTERR_CONNECTED 
+	    SHOUTERR_UNCONNECTED SHOUTERR_UNSUPPORTED 
+	}],
+        functions => [qw{shout_open shout_close
+            shout_set_metadata shout_metadata_add shout_metadata_new
+	    shout_metadata_free shout_send_data shout_sync shout_delay
+	    shout_get_audio_info shout_set_audio_info
+	    shout_set_host shout_set_port shout_set_mount shout_set_password
+	    shout_set_dumpfile shout_set_name
+	    shout_set_url shout_set_genre shout_set_description
+	    shout_set_public shout_get_host
+	    shout_get_port shout_get_mount shout_get_password
+	    shout_get_dumpfile shout_get_name
+	    shout_get_url shout_get_genre shout_get_description
+	    shout_get_public shout_get_error shout_get_errno
+	    shout_set_protocol shout_get_protocol
+	    shout_set_format shout_get_format
+        }],
+    );
+}
 
-	require Exporter;
-	require DynaLoader;
-	require AutoLoader;
-
-	# Inheritance
-	@ISA = qw(Exporter DynaLoader);
-
-	### Exporter stuff
-	@EXPORT = qw{SHOUT_FORMAT_VORBIS SHOUT_FORMAT_MP3
-		SHOUT_PROTOCOL_ICY SHOUT_PROTOCOL_XAUDIOCAST SHOUT_PROTOCOL_HTTP
-		SHOUTERR_SUCCESS SHOUTERR_INSANE SHOUTERR_NOCONNECT SHOUTERR_NOLOGIN 
-		SHOUTERR_SOCKET SHOUTERR_MALLOC SHOUTERR_METADATA SHOUTERR_CONNECTED 
-		SHOUTERR_UNCONNECTED SHOUTERR_UNSUPPORTED 
-	};
-	@EXPORT_OK = qw{
-		SHOUT_FORMAT_VORBIS SHOUT_FORMAT_MP3
-		SHOUT_PROTOCOL_ICY SHOUT_PROTOCOL_XAUDIOCAST SHOUT_PROTOCOL_HTTP
-		SHOUTERR_SUCCESS SHOUTERR_INSANE SHOUTERR_NOCONNECT SHOUTERR_NOLOGIN 
-		SHOUTERR_SOCKET SHOUTERR_MALLOC SHOUTERR_METADATA SHOUTERR_CONNECTED 
-		SHOUTERR_UNCONNECTED SHOUTERR_UNSUPPORTED 
-		shout_open shout_close
-		shout_set_metadata shout_metadata_new shout_metadata_free 
-		shout_metadata_add shout_send_data shout_sync shout_delay
-		shout_set_host shout_set_port shout_set_mount shout_set_password
-		shout_set_dumpfile shout_set_name
-		shout_set_url shout_set_genre shout_set_description
-		shout_set_public shout_get_host
-		shout_get_port shout_get_mount shout_get_password
-		shout_get_dumpfile shout_get_name
-		shout_get_url shout_get_genre shout_get_description
-		shout_get_public shout_get_error shout_set_format shout_get_format
-		shout_get_audio_info shout_set_audio_info
-		shout_set_protocol shout_get_protocol shout_get_errno
-	};
-	%EXPORT_TAGS = (
-		all			=> \@EXPORT_OK,
-		constants	=> [qw{SHOUT_FORMAT_VORBIS SHOUT_FORMAT_MP3
-			SHOUT_PROTOCOL_ICY SHOUT_PROTOCOL_XAUDIOCAST SHOUT_PROTOCOL_HTTP
-			SHOUTERR_SUCCESS SHOUTERR_INSANE SHOUTERR_NOCONNECT SHOUTERR_NOLOGIN 
-			SHOUTERR_SOCKET SHOUTERR_MALLOC SHOUTERR_METADATA SHOUTERR_CONNECTED 
-			SHOUTERR_UNCONNECTED SHOUTERR_UNSUPPORTED 
-		}],
-		functions	=> [qw{shout_open shout_close
-						   shout_set_metadata shout_metadata_add shout_metadata_new
-							 shout_metadata_free shout_send_data shout_sync shout_delay
-						   shout_get_audio_info shout_set_audio_info
-						   shout_set_host shout_set_port shout_set_mount shout_set_password
-						   shout_set_dumpfile shout_set_name
-						   shout_set_url shout_set_genre shout_set_description
-						   shout_set_public shout_get_host
-						   shout_get_port shout_get_mount shout_get_password
-						   shout_get_dumpfile shout_get_name
-						   shout_get_url shout_get_genre shout_get_description
-						   shout_get_public shout_get_error shout_get_errno
-						   shout_set_protocol shout_get_protocol
-						   shout_set_format shout_get_format }],
-	);
+INIT {
+    shout_init ();
+}
 
+END {
+    shout_shutdown ();
 }
 
 bootstrap Shout $VERSION;
@@ -216,23 +238,27 @@ bootstrap Shout $VERSION;
 ###############################################################################
 ###	C O N F I G U R A T I O N   G L O B A L S
 ###############################################################################
-use vars qw{@TranslatedMethods};
+use vars qw{@TranslatedMethods %CompatibilityMethods};
 
 @TranslatedMethods = qw{
-	host
-	port
-	mount
-	password
-	dumpfile
-	name
-	url
-	genre
-	description
-	public
-	format
-        protocol
+    host
+    port
+    mount
+    password
+    dumpfile
+    name
+    url
+    genre
+    description
+    public
+    format
+    protocol
 };
 
+%CompatibilityMethods = (
+  ip         => 'host',
+  ispublic   => 'public',
+);
 
 ###############################################################################
 ###	M E T H O D S
@@ -249,48 +275,48 @@ use vars qw{@TranslatedMethods};
 ###			password	=> <password to use when connecting>,
 ###			dumpfile	=> <dumpfile for the stream>,
 ###			name		=> <name of the stream>,
-###			url			=> <url of stream's homepage>,
+###			url		=> <url of stream's homepage>,
 ###			genre		=> <genre of the stream>,
 ###			format		=> <SHOUT_FORMAT_MP3|SHOUT_FORMAT_VORBIS>,
 ###                     protocol        => <SHOUT_PROTOCOL_ICY|SHOUT_PROTOCOL_XAUDIOCAST|SHOUT_PROTOCOL_HTTP>,
 ###			description	=> <stream description>,
-###			public	=> <public flag - list the stream in directory servers>,
+###			public	        => <list the stream in directory servers?>
 ###		)
 ###
 ### None of the keys are mandatory, and may be set after the connection object
 ###		is created. This method returns the initialized icecast server
 ###		connection object. Returns the undefined value on failure.
 sub new {
-	my $proto = shift;
-	my $class = ref $proto || $proto;
+    my $proto = shift;
+    my $class = ref $proto || $proto;
 
-	my (
-		%args,					# The config pseudo-hash
-		$self,					# The shout_conn_t object
-	   );
-
-	### Unwrap the pseudo-hash into a real one
-	%args = @_;
-
-	### Call our parent's constructor
-	$self = $class->raw_new() or return undef;
-
-	### Set each of the config hash elements by using the keys of the
-	###		config pseudo-hash as the method name
-	foreach my $method ( keys %args ) {
-
-		### Allow keys to be of varying case and preceeded by an optional '-'
-		$method =~ s{^-}{};
-		$method = lc $method;
-
-		### Turn off strict references so we can use a variable as a method name
-	  NO_STRICT: {
-			no strict 'refs';
-			$self->$method( $args{$method} );
-		}
+    my (
+	%args,					# The config pseudo-hash
+	$self,					# The shout_conn_t object
+    );
+
+    ### Unwrap the pseudo-hash into a real one
+    %args = @_;
+
+    ### Call our parent's constructor
+    $self = $class->raw_new() or return undef;
+
+    ### Set each of the config hash elements by using the keys of the
+    ###		config pseudo-hash as the method name
+    foreach my $method ( keys %args ) {
+
+	### Allow keys to be of varying case and preceeded by an optional '-'
+	$method =~ s{^-}{};
+	$method = lc $method;
+
+	### Turn off strict references so we can use a variable as a method name
+        NO_STRICT: {
+	    no strict 'refs';
+	    $self->$method( $args{$method} );
         }
+    }
 
-	return $self;
+    return $self;
 }
 
 ### METHOD: open( undef )
@@ -298,8 +324,9 @@ sub new {
 ###		message if the open fails; returns a true value if the open
 ###		succeeds.
 sub open {
-	my $self = shift or croak "open: Method called as function";
-	$self->shout_open ? 0 : 1;
+    my $self = shift or croak "open: Method called as function";
+
+    $self->shout_open ? 0 : 1;
 }
 
 ### METHOD: close( undef )
@@ -307,52 +334,53 @@ sub open {
 ###		message if the close fails; returns a true value if the close
 ###		succeeds.
 sub close {
-	my $self = shift or croak "close: Method called as function";
-	$self->shout_close ? 0 : 1;
+    my $self = shift or croak "close: Method called as function";
+
+    $self->shout_close ? 0 : 1;
 }
 
 ### METHOD: get_errno( undef )
 ###	Returns a machine-readable integer if one has occurred in the
 ###		object. Returns the undefined value if no error has occurred.
 sub get_errno {
-	my $self = shift or croak "get_errno: Method called as function";
+    my $self = shift or croak "get_errno: Method called as function";
 
-	$self->shout_get_errno or undef;
+    $self->shout_get_errno or undef;
 }
 
 ### METHOD: get_error( undef )
 ###	Returns a human-readable get_error message if one has occurred in the
 ###		object. Returns the undefined value if no error has occurred.
 sub get_error {
-	my $self = shift or croak "get_error: Method called as function";
+    my $self = shift or croak "get_error: Method called as function";
 
-	$self->shout_get_error or undef;
+    $self->shout_get_error or undef;
 }
 
-### METHOD: setMetadata(key => value,key => value,...)
+### METHOD: set_metadata(key => value,key => value,...)
 ### Sets the metadata for the connection. Returns a true value if the update
 ###		succeeds, and the undefined value if it fails.
-sub setMetadata ($$) {
-	my $self = shift		or croak "setMetadata: Method called as function";
+sub set_metadata ($$) {
+    my $self = shift or croak "set_metadata: Method called as function";
 
-  my %param=@_;
-	my $md=shout_metadata_new();
-  for my $k (keys %param) {
-		shout_metadata_add($md,$k,$param{$k});
-	}
-	$self->shout_set_metadata($md) ? 0 : 1;
+    my %param=@_;
+    my $md=shout_metadata_new();
+    for my $k (keys %param) {
+	shout_metadata_add($md,$k,$param{$k});
+    }
+    $self->shout_set_metadata($md) ? 0 : 1;
 }
 
-### METHOD: send_data( $data[, $length] )
+### METHOD: send( $data[, $length] )
 ### Send the specified data with the optional length to the Icecast
 ###		server. Returns a true value on success, and returns the undefined value
 ###		after setting the per-object error message on failure.
-sub send_data ($$) {
-	my $self = shift	or croak "send_data: Method called as function";
-	my $data = shift	or croak "send_data: No data specified";
-	my $len = shift || length $data;
+sub send ($$) {
+    my $self = shift	or croak "send_data: Method called as function";
+    my $data = shift	or croak "send_data: No data specified";
+    my $len = shift || length $data;
 
-	$self->shout_send( $data, $len ) ? 0 : 1;
+    $self->shout_send( $data, $len ) ? 0 : 1;
 }
 
 
@@ -361,8 +389,9 @@ sub send_data ($$) {
 ###		used only in conjuction with C<send_data()>, in order to send data 
 ###		at the correct speed to the icecast server.
 sub sync ($) {
-	my $self = shift or croak "sync: Method called as function";
-	$self->shout_sync; 
+    my $self = shift or croak "sync: Method called as function";
+
+    $self->shout_sync; 
 }
 
 ### METHOD: delay( undef )
@@ -372,11 +401,89 @@ sub sync ($) {
 ###		Used only in conjuction with C<send_data()>, in order to send data 
 ###		at the correct speed to the icecast server.
 sub delay ($) {
-	my $self = shift or croak "delay: Method called as function";
-	my $i=$self->shout_delay; 
-	$i/1000;
+    my $self = shift or croak "delay: Method called as function";
+
+    my $i=$self->shout_delay; 
+    $i/1000;
+}
+
+### METHOD: set_audio_info( key => val, key => val )
+### Set audio parameters (bitrate, samplerate, channels etc) for informational
+### purposes. Audio info is a hash using the SHOUT_AI constants as keys.
+sub set_audio_info ($$) {
+    my $self = shift or croak "set_audio_info: Method called as function";
+    my %param=@_;
+ 
+    for my $k (keys %param) {
+	$self->shout_set_audio_info($k, $param{$k}) and return 0;
+    }
+
+    1;
+}
+
+### METHOD: get_audio_info( key )
+### Returns audio parameters
+sub get_audio_info ($$) {
+    my $self = shift or croak "get_audio_info: Method called as function";
+    my $k = shift or croak "get_audio_info: No parameter supplied";
+
+    return $self->shout_get_audio_info($k);
+}
+
+### COMPATIBILITY with Shout 1.0
+*Shout::disconnect = *Shout::close;
+*Shout::sendData   = *Shout::send;
+*Shout::error      = *Shout::get_error;
+*Shout::sleep      = *Shout::sync;
+
+### Compatibility method: connect ( undef )
+### Sets format to MP3, then calls open
+sub connect ($) {
+    my $self = shift or croak "connect: Method called as function";
+
+    $self->format(SHOUT_FORMAT_MP3());
+
+    return $self->open();
 }
 
+### Compatibility method: icy_compat ( $compat )
+### Translates the icy_compat call to set protocol to icy or xaudiocast
+sub icy_compat ($$) {
+    my $self = shift or croak "icy_compat: Method called as function";
+    if (@_) {
+	my $compat = shift or croak "icy_compat: No parameter specified";
+
+	if ($compat) {
+	    $self->protocol(SHOUT_PROTOCOL_ICY()) ? 0 : 1;
+	} else {
+	    $self->protocol(SHOUT_PROTOCOL_XAUDIOCAST()) ? 0 : 1;
+	}
+    } else {
+	return ($self->protocol == SHOUT_PROTOCOL_ICY()) ? 1 : 0;
+    }
+}
+
+### Compatibility method: bitrate ( $bitrate )
+### Translates the bitrate call to the appropriate audio_info call
+sub bitrate ($$) {
+    my $self = shift or croak "bitrate: Method called as function";
+    if (@_) {
+	my $br = shift or croak "bitrate: No parameter specified";
+
+	$self->set_audio_info(SHOUT_AI_BITRATE(), $br) ? 0 : 1;
+    } else {
+	return $self->get_audio_info(SHOUT_AI_BITRATE());
+    }
+}
+
+### Compatibility method: updateMetadata ( $metadata)
+### Translates the metadata call to new form
+sub updateMetadata ($$) {
+    my $self = shift or croak "updateMetadata: Method called as function";
+    my $metadata = shift or croak "updateMetadata: No metadata specified";
+
+    return $self->set_metadata(song => $metadata) ? 0 : 1;
+}
 
 ###############################################################################
 ###	A U T O L O A D E D   M E T H O D S
@@ -420,71 +527,74 @@ sub delay ($) {
 ###	Provides a proxy for functions and methods which aren't explicitly defined.
 sub AUTOLOAD {
 
-	( my $method = $AUTOLOAD ) =~ s{.*::}{};
-	croak "& not defined" if $method eq 'constant';
+    ( my $method = $AUTOLOAD ) =~ s{.*::}{};
+    croak "& not defined" if $method eq 'constant';
 
-	### If called as a method, check to see if we're doing translation for the
-	### method called. If we are, build the name of the real method and call
-	### it. If not, delegate this call to Autoloadeer
-	if (( ref $_[0] && UNIVERSAL::isa($_[0], __PACKAGE__) )) {
-		my $self = shift;
-
-		### If the called method is one we're translating, build the wrapper
-		### method for it and jump to it
-		if ( grep { $_ eq $method } @TranslatedMethods ) {
-
-			### Turn off strict so we can do some reference trickery
-		  NO_STRICT: {
-				no strict 'refs';
-
-				my $setMethod = "shout_set_$method";
-				my $getMethod = "shout_get_$method";
-
-				*$AUTOLOAD = sub ($$) {
-					my $obj = shift;
-					return $obj->$setMethod(@_) if @_;
-					return $obj->$getMethod();
-				};
-			}
-
-			### Stick the self-reference back on the stack and jump to the
-			### new method
-			unshift @_, $self;
-			goto &$AUTOLOAD;
-		}
-
-		### If the method's not one we're translating, delegate the call to Autoloader
-		else {
-			$AutoLoader::AUTOLOAD = $AUTOLOAD;
-			goto &AutoLoader::AUTOLOAD;
+    ### If called as a method, check to see if we're doing translation for the
+    ### method called. If we are, build the name of the real method and call
+    ### it. If not, delegate this call to Autoloadeer
+    if (( ref $_[0] && UNIVERSAL::isa($_[0], __PACKAGE__) )) {
+	my $self = shift;
+
+	# Translate Shout 1.0 calls. This should probably be made optional.
+	if ( defined($CompatibilityMethods{$method}) ) {
+	    $method = $CompatibilityMethods{$method};
+	}
 
-		}
+	### If the called method is one we're translating, build the wrapper
+	### method for it and jump to it
+	if ( grep { $_ eq $method } @TranslatedMethods ) {
+
+	    ### Turn off strict so we can do some reference trickery
+  	    NO_STRICT: {
+		no strict 'refs';
+
+		my $setMethod = "shout_set_$method";
+		my $getMethod = "shout_get_$method";
+
+		*$AUTOLOAD = sub ($$) {
+		    my $obj = shift;
+		    return $obj->$setMethod(@_) if @_;
+		    return $obj->$getMethod();
+		};
+	    }
+
+	    ### Stick the self-reference back on the stack and jump to the
+	    ### new method
+	    unshift @_, $self;
+	    goto &$AUTOLOAD;
+	} else {
+	    ### If the method's not one we're translating, delegate the call to
+	    ### Autoloader
 
-	}
+	    # This is of dubious utility. Kill it? - brendan
 
+	    $AutoLoader::AUTOLOAD = $AUTOLOAD;
+	    goto &AutoLoader::AUTOLOAD;
+	}
+    } else {
         ### If we were called as a function, try to fetch it from the XSUB
-	else {
-		my $val = constant($method, @_ ? $_[0] : 0);
-		croak "No such Shout constant '$method'" if $!;
-
-		### Bootstrap a natural constant if we managed to find a value for the
-		### one specified
-	  NO_STRICT: {
-			no strict 'refs';
-			*$AUTOLOAD = sub { $val };
-		}
 
-		### Substitute a call to the new function for the current call
-		goto &$AUTOLOAD;
+	my $val = strconstant($method, @_ ? $_[0] : 0);
+	$val = constant($method, @_ ? $_[0] : 0) if $!;
+	croak "No such Shout constant '$method'" if $!;
+
+	### Bootstrap a natural constant if we managed to find a value for the
+	### one specified
+        NO_STRICT: {
+	    no strict 'refs';
+	    *$AUTOLOAD = sub { $val };
         }
 
-	confess "UNREACHED";
-}
+	### Substitute a call to the new function for the current call
+	goto &$AUTOLOAD;
+    }
 
+    confess "UNREACHED";
+}
 
 ### Module return value indicates successful loading
 1;
-
 
 __END__
 

<p><p>1.2       +49 -3     shout-perl/Shout.xs

Index: Shout.xs
===================================================================
RCS file: /usr/local/cvsroot/shout-perl/Shout.xs,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -p -u -r1.1 -r1.2
--- Shout.xs	3 Jul 2003 16:42:06 -0000	1.1
+++ Shout.xs	5 Jul 2003 18:42:50 -0000	1.2
@@ -11,8 +11,44 @@ not_here(char *s)
    return -1;
 }
 
+static const char *
+strconstant(const char *name, int arg)
+{
+  if (strEQ(name,"SHOUT_AI_BITRATE"))
+#ifdef SHOUT_AI_BITRATE
+    return SHOUT_AI_BITRATE;
+#else
+  goto notthere;
+#endif
+
+  if (strEQ(name,"SHOUT_AI_SAMPLERATE"))
+#ifdef SHOUT_AI_SAMPLERATE
+    return SHOUT_AI_SAMPLERATE;
+#else
+  goto notthere;
+#endif
+
+  if (strEQ(name,"SHOUT_AI_CHANNELS"))
+#ifdef SHOUT_AI_CHANNELS
+    return SHOUT_AI_CHANNELS;
+#else
+  goto notthere;
+#endif
+
+  if (strEQ(name,"SHOUT_AI_QUALITY"))
+#ifdef SHOUT_AI_QUALITY
+    return SHOUT_AI_QUALITY;
+#else
+  goto notthere;
+#endif
+
+notthere:
+  errno = EINVAL;  
+  return NULL;
+}
+	
 static double
-ant(char *name, int arg)
+constant(char *name, int arg)
 {
    errno = 0;
    switch (*name) {
@@ -172,11 +208,22 @@ MODULE = Shout		PACKAGE = Shout		
 
 PROTOTYPES: ENABLE
 
+const char *
+strconstant(name, arg)
+  const char * name
+  int          arg
+
 double
-ant(name,arg)
+constant(name,arg)
         char *		name
         int		arg
 
+void
+shout_init()
+
+void
+shout_shutdown()
+
 shout_t *
 raw_new(CLASS)
         char *CLASS
@@ -368,5 +415,4 @@ int 
 shout_set_metadata(self,md)
         shout_t *self
         shout_metadata_t *md
-
 

<p><p>--- >8 ----
List archives:  http://www.xiph.org/archives/
Ogg project homepage: http://www.xiph.org/ogg/
To unsubscribe from this list, send a message to 'cvs-request at xiph.org'
containing only the word 'unsubscribe' in the body.  No subject is needed.
Unsubscribe messages sent to the list will be ignored/filtered.



More information about the commits mailing list