diff --git a/lib/Audio/Chromaprint.pm b/lib/Audio/Chromaprint.pm index a63e324..25fd52b 100644 --- a/lib/Audio/Chromaprint.pm +++ b/lib/Audio/Chromaprint.pm @@ -3,8 +3,6 @@ package Audio::Chromaprint; use Moose; use Carp qw< croak >; -use FFI::Platypus 0.88; -use FFI::CheckLib; use Moose::Util::TypeConstraints; # This is in three statement so we could support 5.6.0, @@ -13,53 +11,7 @@ use constant 'MIN_SILENCE_THRESHOLD' => 0; use constant 'MAX_SILENCE_THRESHOLD' => 32_767; use constant 'BYTES_PER_SAMPLE' => 2; -our $HAS_SUBS; -our %SUBS = ( - '_new' => [ ['int'] => 'opaque' ], - '_get_version' => [ [] => 'string' ], - '_free' => [ ['opaque'] => 'void' ], - '_set_option' => [ [ 'opaque', 'string', 'int' ] => 'int' ], - '_start' => [ [ 'opaque', 'int', 'int' ] => 'int' ], - '_finish' => [ ['opaque'] => 'int' ], - '_feed' => [ ['opaque', 'string', 'int' ] => 'int' ], - - '_get_fingerprint_hash' => [ [ 'opaque', 'uint32*' ], 'int' ], - '_get_fingerprint' => [ [ 'opaque', 'opaque*' ], 'int' ], - '_get_raw_fingerprint' => [ [ 'opaque', 'opaque*', 'int*' ], 'int' ], - '_get_num_channels' => [ [ 'opaque' ], 'int' ], - '_get_sample_rate' => [ [ 'opaque' ], 'int' ], - '_get_item_duration' => [ [ 'opaque' ], 'int' ], - '_get_item_duration_ms' => [ [ 'opaque' ], 'int' ], - '_get_delay' => [ [ 'opaque' ], 'int' ], - '_get_delay_ms' => [ [ 'opaque' ], 'int' ], - '_get_raw_fingerprint_size' => [ [ 'opaque', 'int*' ], 'int' ], - '_clear_fingerprint' => [ [ 'opaque' ], 'int' ], - - '_dealloc' => [ [ 'opaque' ] => 'void' ], -); - -sub BUILD { - $HAS_SUBS++ - and return; - - my $ffi = FFI::Platypus->new; - - # Setting this mangler lets is omit the chromaprint_ prefix - # from the attach call below, and the function names used - # by perl - $ffi->mangler( sub { - my $name = shift; - $name =~ s/^_/chromaprint_/xms; - return $name; - } ); - - $ffi->lib( find_lib_or_exit( 'lib' => 'chromaprint', alien => 'Alien::chromaprint' ) ); - - $ffi->attach( $_, @{ $SUBS{$_} } ) - for keys %SUBS; - - $ffi->attach_cast( '_opaque_to_string' => opaque => 'string' ); -} +with qw< MooseX::Role::FFI >; subtype 'ChromaprintAlgorithm', as 'Int', @@ -87,10 +39,10 @@ has 'cp' => ( # subtract one from the algorithm so that # 1 maps to 2 maps to CHROMAPRINT_ALGORITHM_TEST2 # (the latter has the value 1) - my $cp = _new( $self->algorithm - 1 ); + my $cp = $self->ffi_sub('_new')->( $self->algorithm - 1 ); if ( $self->has_silence_threshold ) { - _set_option( + $self->ffi_sub('_set_option')->( $cp, 'silence_threshold' => $self->silence_threshold, ) or croak('Error setting option silence_threshold'); } @@ -105,12 +57,55 @@ has 'silence_threshold' => ( 'predicate' => 'has_silence_threshold', ); -sub get_version { - # generate chromaprint object - __PACKAGE__->can('_get_version') - or __PACKAGE__->new(); +sub ffi_subs_data { + return { + '_new' => [ ['int'] => 'opaque' ], + '_get_version' => [ [] => 'string' ], + '_free' => [ ['opaque'] => 'void' ], + '_set_option' => [ [ 'opaque', 'string', 'int' ] => 'int' ], + '_start' => [ [ 'opaque', 'int', 'int' ] => 'int' ], + '_finish' => [ ['opaque'] => 'int' ], + '_feed' => [ ['opaque', 'string', 'int' ] => 'int' ], + + '_get_fingerprint_hash' => [ [ 'opaque', 'uint32*' ], 'int' ], + '_get_fingerprint' => [ [ 'opaque', 'opaque*' ], 'int' ], + '_get_raw_fingerprint' => [ [ 'opaque', 'opaque*', 'int*' ], 'int' ], + '_get_num_channels' => [ [ 'opaque' ], 'int' ], + '_get_sample_rate' => [ [ 'opaque' ], 'int' ], + '_get_item_duration' => [ [ 'opaque' ], 'int' ], + '_get_item_duration_ms' => [ [ 'opaque' ], 'int' ], + '_get_delay' => [ [ 'opaque' ], 'int' ], + '_get_delay_ms' => [ [ 'opaque' ], 'int' ], + '_get_raw_fingerprint_size' => [ [ 'opaque', 'int*' ], 'int' ], + '_clear_fingerprint' => [ [ 'opaque' ], 'int' ], + + '_dealloc' => [ [ 'opaque' ] => 'void' ], + }; +} + +sub ffi_lib {'chromaprint'} +sub ffi_alien {'Alien::chromaprint'} - return _get_version(); +around '_build_ffi' => sub { + my $orig = shift; + my $self = shift; + my $ffi = $self->$orig(@_); + + # Setting this mangler lets is omit the chromaprint_ prefix + # from the attach call below, and the function names used + # by perl + $ffi->mangler( sub { + my $name = shift; + $name =~ s/^_/chromaprint_/xms; + return $name; + } ); + + return $ffi; +}; + +sub get_version { + my $self = shift; + return $self->ffi_sub('_get_version')->(); } sub start { @@ -122,7 +117,7 @@ sub start { $num_channels =~ /^[12]$/xms or croak 'num_channels must be 1 or 2'; - _start( $self->cp, $sample_rate, $num_channels ) + $self->ffi_sub('_start')->( $self->cp, $sample_rate, $num_channels ) or croak 'Unable to start (start)'; } @@ -143,20 +138,20 @@ sub set_option { or croak('silence_threshold option must be between 0 and 32767'); } - _set_option( $self->cp, $name => $value ) + $self->ffi_sub('_set_option')->( $self->cp, $name => $value ) or croak("Error setting option $name (set_option)"); } sub finish { my $self = shift; - _finish( $self->cp ) + $self->ffi_sub('_finish')->( $self->cp ) or croak('Unable to finish (finish)'); } sub get_fingerprint_hash { my $self = shift; my $hash; - _get_fingerprint_hash( $self->cp, \$hash ) + $self->ffi_sub('_get_fingerprint_hash')->( $self->cp, \$hash ) or croak('Unable to get fingerprint hash (get_fingerprint_hash)'); return $hash; } @@ -164,10 +159,11 @@ sub get_fingerprint_hash { sub get_fingerprint { my $self = shift; my $ptr; - _get_fingerprint($self->cp, \$ptr) + $self->ffi_sub('_get_fingerprint')->($self->cp, \$ptr) or croak('Unable to get fingerprint (get_fingerprint)'); - my $str = _opaque_to_string($ptr); - _dealloc($ptr); + + my $str = $self->ffi->cast( 'opaque' => 'string' => $ptr ); + $self->ffi_sub('_dealloc')->($ptr); return $str; } @@ -175,68 +171,69 @@ sub get_raw_fingerprint { my $self = shift; my ( $ptr, $size ); - _get_raw_fingerprint( $self->cp, \$ptr, \$size ) + $self->ffi_sub('_get_raw_fingerprint')->( $self->cp, \$ptr, \$size ) or croak('Unable to get raw fingerprint (get_raw_fingerprint)'); # not espeically fast, but need a cast with a variable length array - my $fp = FFI::Platypus->new->cast( 'opaque' => "uint32[$size]", $ptr ); - _dealloc($ptr); + my $fp = $self->ffi->cast( 'opaque' => "uint32[$size]", $ptr ); + $self->ffi_sub('_dealloc')->($ptr); return $fp; } sub get_num_channels { my $self = shift; - return _get_num_channels($self->cp); + return $self->ffi_sub('_get_num_channels')->($self->cp); } sub get_sample_rate { my $self = shift; - return _get_sample_rate($self->cp); + return $self->ffi_sub('_get_sample_rate')->($self->cp); } sub get_item_duration { my $self = shift; - return _get_item_duration($self->cp); + return $self->ffi_sub('_get_item_duration')->($self->cp); } sub get_item_duration_ms { my $self = shift; - return _get_item_duration_ms($self->cp); + return $self->ffi_sub('_get_item_duration_ms')->($self->cp); } sub get_delay { my $self = shift; - return _get_delay($self->cp); + return $self->ffi_sub('_get_delay')->($self->cp); } sub get_delay_ms { my $self = shift; - return _get_delay_ms($self->cp); + return $self->ffi_sub('_get_delay_ms')->($self->cp); } sub get_raw_fingerprint_size { my $self = shift; my $size; - _get_raw_fingerprint_size($self->cp, \$size) + $self->ffi_sub('_get_raw_fingerprint_size')->($self->cp, \$size) or croak('Unable to get raw fingerprint size (get_raw_fingerprint_size)'); return $size; } sub clear_fingerprint { my $self = shift; - _clear_fingerprint( $self->cp ) + $self->ffi_sub('_clear_fingerprint')->( $self->cp ) or croak('Unable to clear fingerprint (clear_fingerprint)'); } sub feed { my ( $self, $data ) = @_; - _feed( $self->cp, $data, length($data) / BYTES_PER_SAMPLE() ) - or corak("unable to feed"); + $self->ffi_sub('_feed')->( + $self->cp, $data, length($data) / BYTES_PER_SAMPLE() + ) or corak("unable to feed"); } sub DEMOLISH { my $self = shift; - _free( $self->cp ); + $self->ffi_sub('_free')->( $self->cp ); } # TODO: chromaprint_encode_fingerprint diff --git a/lib/MooseX/Role/FFI.pm b/lib/MooseX/Role/FFI.pm new file mode 100644 index 0000000..a263cc6 --- /dev/null +++ b/lib/MooseX/Role/FFI.pm @@ -0,0 +1,69 @@ +package MooseX::Role::FFI; +# ABSTRACT: Easily create interfaces to FFI functions with Moose roles + +use Moose::Role; +use FFI::Platypus 0.89_01; +use FFI::CheckLib; + +requires qw< + ffi_subs_data + ffi_lib +>; + +has 'ffi' => ( + 'is' => 'ro', + 'reader' => '_ffi', + 'init_arg' => undef, + 'builder' => '_build_ffi', +); + +has 'ffi_subs_refs' => ( + 'is' => 'ro', + 'reader' => '_ffi_subs_refs', + 'init_arg' => undef, + 'builder' => '_build_ffi_subs_refs', + 'lazy' => 1, + 'traits' => ['Hash'], + 'handles' => { 'ffi_sub' => 'get' }, +); + +sub _build_ffi { + my $self = shift; + my $ffi = FFI::Platypus->new; + my $fallback = $self->can('ffi_alien'); + + $ffi->lib( + find_lib_or_exit( + 'lib' => $self->ffi_lib, + $fallback ? ( 'alien' => $fallback->() ) : (), + ) + ); + + return $ffi; +} + +sub _build_ffi_subs_refs { + my $self = shift; + my $ffi = $self->_ffi; + my %subs_data = %{ $self->ffi_subs_data }; + + my %subs_refs = map +( + $_ => $ffi->function( $_ => @{ $subs_data{$_} } )->sub_ref, + ), keys %subs_data; + + return \%subs_refs; +} + +sub BUILD { + # FFI subs are lazy so they can happen after ffi creation + # but we still want them created during instantiation + shift->_ffi_subs_refs; +} + +no Moose::Role; + +1; + +__END__ + +=head diff --git a/t/audio_chromaprint.t b/t/audio_chromaprint.t index 4ce58e7..e4d2517 100644 --- a/t/audio_chromaprint.t +++ b/t/audio_chromaprint.t @@ -3,7 +3,7 @@ use warnings; use Test::More; use Audio::Chromaprint; -note "version = ", Audio::Chromaprint->get_version; +note "version = ", Audio::Chromaprint->new->get_version; my $cp = Audio::Chromaprint->new; isa_ok $cp, 'Audio::Chromaprint';