While a functional interface for the get_version function was useful, the chromaprint library, as many libraries do, has context. This means we would be better off using an object oriented interface.
We will convert the get_version function into a method and then create a new method to generate a new bless()ed hash reference. The second step can easily be done with Perl itself (which we will also demonstrate), but we're trying to learn us some XS, aren't we?
First of all, we create a new skeleton which has the same structure as the old one but with new file names and using a proper namespace.
Create a new Makefile.PL file with the following content:
use 5.008005;
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => 'Audio::Chromaprint',
VERSION_FROM => 'lib/Audio/Chromaprint.pm',
PREREQ_PM => { 'Test::More' => 0 },
ABSTRACT_FROM => 'lib/Audio/Chromaprint.pm',
AUTHOR => 'You',
LIBS => ['-lchromaprint'],
DEFINE => '',
INC => '-I.',
OBJECT => '$(O_FILES)',
);You can generate the ppport.h file using the following command:
perl -MDevel::PPPort -E'Devel::PPPort::WriteFile'Or on Windows cmd.exe with Strawberry Perl:
perl -MDevel::PPPort -E"Devel::PPPort::WriteFile"Create a directory structure lib/Audio and inside the file Chromaprint.pm:
package Audio::Chromaprint;
use strict;
use warnings;
use XSLoader;
our $VERSION = '0.001';
XSLoader::load( 'Audio::Chromaprint', $VERSION );
1;
__END__
=head1 NAME
Audio::Chromaprint - Interface to the Chromaprint libraryYou'll notice we removed the exporting, which is unnecessary for object oriented interfaces, and added a NAME section in the documentation at the bottom to provide an abstract to Makefile.PL.
The MANIFEST file can be easily created with the command:
# Perl on GNU/Linux, BSD, Solaris:
perl Makefile.PL && make manifest && make distclean(if you're using Strawberry Perl on Windows, use dmake instead of make)
Now we create the Chromaprint.xs file which is associated with the correct package loaded by our Chromaprint.pm file:
#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
#include <chromaprint.h>
/* Custom C functions can go here */
MODULE = Audio::Chromaprint PACKAGE = Audio::Chromaprint
# XS code goes here
PROTOTYPES: ENABLEDWe define the module and package as Audio::Chromaprint.
You will notice we also added a definition for PROTOTYPES. This isn't necessary, and the default value is ENABLED anyway, but it will remove a warning the XS layer adds, so we add it explicitly.
Our previous get_version function had one major problem: it assumed that we did not have any parameters.
If you are unfamiliar with methods in Perl, it's important to know that when you call a method, it will send the object as the first parameter. Assuming we were using an object oriented interface:
$object->my_method();The method my_method is not without parameters at all. It receives the object as the first parameter:
sub my_method {
my $self = shift;
...
}Thus, as soon as we try to use our get_version as a method, because it assumes there are no parameters, it will fail. The XS layer will generate a check for any possible arguments and will croak mentioning the "proper" way of calling it (assuming it shouldn't receive parameters at all).
In order to fix this, the only thing we need is to include a parameter in the name definition for the function, which will now be a method:
const char *
version(SV *self)
CODE:
RETVAL = chromaprint_get_version();
OUTPUT: RETVALThis way the XS layer will generate a check that the function is called as a method (providing at least one parameter, an SV), instead of being called as a function with no parameters.
You will notice we also took the liberty to change the method name to version.
The above version method will be a Perl sub that requires exactly one parameter. That means in Perl, it can be called in two ways:
$obj->version()
version($obj)So the XSUB behaves just the same as any other sub would do in Perl. The only difference is that if the method were implemented in Perl, it wouldn't use its object parameter at all, so
version() # look Ma, no arguments!would also be legal. However, the XSUB will croak on that. In this case that is probably a good thing. But if you wanted it to behave even more like an actual Perl function that could be called without arguments, the XS code would look like this instead:
const char *
version(...)
CODE:
RETVAL = chromaprint_get_version();
OUTPUT: RETVALSee what we did there? We dropped the explicit parameter self and replaced it with ..., which basically says "any number of parameters is okay". Later on we will see how to actually use parameters passed to such a variadic XSUB.
In order to call version as a method, we need a blessed hash reference. We can easily create one with the following code inside Chromaprint.pm:
sub new { bless {}, shift }In a single line, this creates a subroutine called new which blesses an empty hash reference into the class name that is sent as a parameter.
However, as we're trying to practice XS, let us do it in XS:
SV *
new( const char *class )
CODE:
/* Create a hash */
HV* hash = newHV();
/* Create a reference to the hash */
SV *const self = newRV_noinc( (SV *)hash );
/* bless into the proper package */
RETVAL = sv_bless( self, gv_stashpv( class, 0 ) );
OUTPUT: RETVALnewHV creates a new hash value. It returns a pointer to a hash value structure (HV).
Then we want to create a reference to it (RV - Reference Value structure). newRV_inc and newRV_noinc create a reference from an SV. It expects an SV, so we cast our HV as one. We return the data back into a new SV.
The last step is to bless the SV. We use gv_stashpv to fetch a pointer to the stash of a specified package. We send it the class name as the package, and 0 as the indication of no additional flags to the function. sv_bless is called with the hash reference we created with newRV_noinc and the pointer from gv_stashpv.
In case you're wondering where the heck that weird RETVAL thing is coming from: It's a C variable that is automatically declared for us and which has the same type as the return value of the XSUB. We can set it in our XS code and then tell the XS compiler using OUTPUT: RETVAL that yes, really, its content is to be returned to Perl.
Let's write a test for our code. We can write the following as t/version.t:
#!perl
use strict;
use warnings;
use Test::More tests => 3;
use Audio::Chromaprint;
my $cp = Audio::Chromaprint->new();
isa_ok( $cp, 'Audio::Chromaprint' );
can_ok( $cp, 'version' );
is( $cp->version, '1.2.0', 'chromaprint version is 1.2.0' );Try it out:
perl Makefile.PL && make && make test(if you're using Strawberry Perl on Windows, use dmake instead of make)
You might notice both newRV_inc and newRV_noinc were mentioned, but only newRV_noinc was used. Why is that?
Perl uses a reference counting memory management system. When a new value is created, its reference count is set to 1. No matter whether it came into life as a variable in Perl code, as a temporary deep inside the bowels of the runtime, or explicitly using newRV* or its siblings in your XS code.
Perl keeps a count of "live" values (technically, the most generic form of a Perl value is an SV) using the count of things that refer to it.
When they go out of scope, or get explicitly undefed, their reference count is decremented. When it reaches zero, perl (the interpreter) knows it can free that value and will generally do so immediately.
When we create an HV, it has a single reference count. Our code effectively "owns" that value. When we create an RV that points at the HV, the RV should now have its own reference count to the HV.
We can now use newRV_inc to create the RV. That increments the hash's reference count to 2, and both the RV and our code own one reference to it.
newRV_noinc creates an RV without increasing the reference count. Generally, this means that the RV is taking ownership of one of the existing references.
Why is this important? We don't plan to hold on to that HV in our code. The RV will fully own it and we will return the reference, the RV from the XSUB. If that RV is freed, it will give up its reference (count) to the HV and perl will free the HV correctly.
To understand this better write the following test in t/leak.t:
#!perl
use strict;
use warnings;
use Test::More tests => 1;
use Audio::Chromaprint;
my $called = 0;
package Audio::Chromaprint {
sub DESTROY { $called++ }
}
{ my $cp = Audio::Chromaprint->new }
cmp_ok( $called, '==', 1, 'Destruction successful' );In this test we add a DESTROY method to the Audio::Chromaprint package namespace, which will get called when the object is entirely destroyed. We use that method to increment a counter. Then we create an object in an internal scope. Once out of the scope, we check that the counter was called once and only once.
If you run make test, it will succeed. Try changing in the XS code the newRV_noinc to newRV_inc, rebuild and rerun the test. It will fail because there's a stray reference to the objects' HVs and they will never be freed (and the destructor will never be called).