Ogg-Vorbis-LibVorbis

 view release on metacpan or  search on metacpan

LibVorbis.xs  view on Meta::CPAN

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

#include <stdio.h>
#include <string.h>
#include <sys/types.h>
#include <errno.h>
#include <stdlib.h>

#include <ogg/ogg.h>
#include <vorbis/codec.h>
#include <vorbis/vorbisenc.h>
#include <vorbis/vorbisfile.h>

#include "const-c.inc"

static size_t ovcb_read(void *ptr, size_t size, size_t nmemb, void *datasource);
static int    ovcb_seek(void *datasource, ogg_int64_t offset, int whence);
static int    ovcb_close(void *datasource);
static long   ovcb_tell(void *datasource);

/* http://www.xiph.org/ogg/vorbis/doc/vorbisfile/ov_callbacks.html */
ov_callbacks vorbis_callbacks = {
	ovcb_read,
	ovcb_seek,
	ovcb_close,
	ovcb_tell
};

/* Allow multiple instances of the decoder object. Stuff each filehandle into (void*)stream */
typedef struct {
	int is_streaming;
	int bytes_streamed;
	int last_bitstream;
	PerlIO *stream;

} ocvb_datasource;

typedef PerlIO *        OutputStream;
typedef PerlIO *        InputStream;

static int _arr_rows;
static int _arr_cols;

/* useful items from XMMS */
static size_t ovcb_read(void *ptr, size_t size, size_t nmemb, void *vdatasource) {

  size_t read_bytes = 0;
  ocvb_datasource *datasource = vdatasource;

  read_bytes = PerlIO_read(datasource->stream, ptr, size * nmemb);
  datasource->bytes_streamed += read_bytes;

  return read_bytes;
}

static int ovcb_seek(void *vdatasource, ogg_int64_t offset, int whence) {

  ocvb_datasource *datasource = vdatasource;

  if (datasource->is_streaming) {
    return -1;
  }

  /* For some reason PerlIO_seek fails miserably here. < 5.8.1 works */
  /* return PerlIO_seek(datasource->stream, offset, whence); */

  return fseek(PerlIO_findFILE(datasource->stream), offset, whence);
}

static int ovcb_close(void *vdatasource) {

  ocvb_datasource *datasource = vdatasource;

  return PerlIO_close(datasource->stream);
}

static long ovcb_tell(void *vdatasource) {

  ocvb_datasource *datasource = vdatasource;

  if (datasource->is_streaming) {
    return datasource->bytes_streamed;
  }

  return PerlIO_tell(datasource->stream);
}

static void * get_mortalspace ( size_t nbytes ) {
  SV * mortal;
  mortal = sv_2mortal( NEWSV(0, nbytes ) );
  return (void *) SvPVX( mortal );
}

/* Handler for unpacking (float **) */
float ** XS_unpack_floatPtrPtr(SV * arg ) { 
  AV * avref;
  AV * avref_2; 
  float ** array;
  SV ** data; 
  int len, len_2; 
  SV ** elem; 
  int i, j; 

  avref = (AV*)SvRV(arg); 
  len = av_len( avref ) + 1; 
  /* First allocate some memory for the pointers and a NULL for delimiter */ 
  array = (float **)get_mortalspace( (len+1) * sizeof( *array ));   
  /* Loop over each element copying pointers to the array */ 
  for (i=0; i<len; i++) { 
    /* now elem points to the 2nd array in 2D float array */
    elem = av_fetch( avref, i, 0); 
    /* get the pointer to inner array */
    avref_2 = (AV*)SvRV((SV *)*elem);
    /* get the length of the inner array */
    len_2 = av_len(avref_2) + 1;
    /* create mortal space for the 2D array (+1 for NULL delimiter) */
    array[i] = (float *)get_mortalspace( (len_2+1) * sizeof(float));
    for (j=0; j<len_2; j++) {
      /* get the element */   
      data = av_fetch(avref_2, j, 0);
      /* fill the ARRAY */
      array[i][j] = SvNV(*data); 
    }
  } 

  /* hard code the row and col length */
  _arr_rows = i;
  _arr_cols = j;		/* all arrays are of same size */

  return array; 
} 

/* Handler for packing (float **) */
void XS_pack_floatPtrPtr( SV * arg, float ** array) { 
  int i, j; 
  AV *avref, *avref_2; 
  /* create an array_ref */
  avref  = (AV*)sv_2mortal((SV*)newAV()); 
  for (i=0; i<_arr_rows; i++) { 
    /* ref to inner array */
    avref_2  = (AV*)sv_2mortal((SV*)newAV()); 

LibVorbis.xs  view on Meta::CPAN

  CODE:
    RETVAL = ov_fopen(path, vf);
  OUTPUT:
    RETVAL


=head2 ov_open_callbacks

an alternative function used to open and initialize an OggVorbis_File structure when using a data source 
other than a file, when its necessary to modify default file access behavior.
L<http://www.xiph.org/vorbis/doc/vorbisfile/ov_open.html>

B<Please read the official ov_open_callbacks doc before you use this.> The perl version uses
a different approach and uses vorbis_callbacks with custom functions to read, seek tell and close.

B<this module can accept file name, network socket or a file pointer.>

-Input:
  void *, (data source)
  OggVorbis_File, A pointer to the OggVorbis_File structure,
  char *, Typically set to NULL,
  int, Typically set to 0.

-Output:
  0 indicates succes,
  less than zero for failure:

    OV_EREAD - A read from media returned an error.
    OV_ENOTVORBIS - Bitstream is not Vorbis data.
    OV_EVERSION - Vorbis version mismatch.
    OV_EBADHEADER - Invalid Vorbis bitstream header.
    OV_EFAULT - Internal logic fault; indicates a bug or heap/stack corruption.

=cut

int
LibVorbis_ov_open_callbacks(path, vf, initial, ibytes)
    SV *       	     path  
    OggVorbis_File * vf
    char *	     initial
    int		     ibytes
  PREINIT:
    FILE *fp;
  CODE:
    int ret = 10;

    /* our stash for streams */
    ocvb_datasource *datasource = (ocvb_datasource *) safemalloc(sizeof(ocvb_datasource));
    memset(datasource, 0, sizeof(ocvb_datasource));

    /* check and see if a pathname was passed in, otherwise it might be a
     * IO::Socket subclass, or even a *FH Glob */
    if (SvOK(path) && (SvTYPE(SvRV(path)) != SVt_PVGV)) {

      if ((datasource->stream = PerlIO_open((char*)SvPV_nolen(path), "r")) == NULL) {
        safefree(vf);
        fprintf(stderr, "failed on open: [%d] - [%s]\n", errno, strerror(errno));
        XSRETURN_UNDEF;
      }

      datasource->is_streaming = 0;

    } else if (SvOK(path)) {

      /* Did we get a Glob, or a IO::Socket subclass? */		
      if (sv_isobject(path) && sv_derived_from(path, "IO::Socket")) {
        datasource->is_streaming = 1;
      } else {

        datasource->is_streaming = 0;
      }

      /* dereference and get the SV* that contains the Magic & FH,
       * then pull the fd from the PerlIO object */
      datasource->stream = IoIFP(GvIOp(SvRV(path)));

    } else {

      fp = PerlIO_findFILE((PerlIO *)IoIFP(sv_2io(path)));
      /* check whether it is a valid file handler */
      if (fp == (FILE*) 0 || fileno(fp) <= 0) {   
         XSRETURN_UNDEF;
      }
      datasource->stream = (PerlIO *)IoIFP(sv_2io(path));
    }

    if ((ret = ov_open_callbacks((void*)datasource, vf, NULL, 0, vorbis_callbacks)) < 0) {
      warn("Failed on registering callbacks: [%d]\n", ret);
      printf("failed on open: [%d] - [%s]\n", errno, strerror(errno));
      ov_clear(vf);

      XSRETURN_UNDEF;
    }

    datasource->bytes_streamed = 0;
    datasource->last_bitstream = -1;

    RETVAL = ret;

  OUTPUT:
    RETVAL


=head2 ov_test

This partially opens a vorbis file to test for Vorbis-ness.
L<http://www.xiph.org/vorbis/doc/vorbisfile/ov_test.html>

-Input:
  FILE *, File pointer to an already opened file or pipe,
  OggVorbis_File, A pointer to the OggVorbis_File structure,
  char *, Typically set to NULL,
  int, Typically set to 0.

-Output:
  0 indicates succes,
  less than zero for failure:

    OV_EREAD - A read from media returned an error.
    OV_ENOTVORBIS - Bitstream is not Vorbis data.
    OV_EVERSION - Vorbis version mismatch.
    OV_EBADHEADER - Invalid Vorbis bitstream header.
    OV_EFAULT - Internal logic fault; indicates a bug or heap/stack corruption.

=cut

int
LibVorbis_ov_test(f, vf, initial, ibytes)
    InputStream	     f
    OggVorbis_File * vf

LibVorbis.xs  view on Meta::CPAN

  CODE:
    RETVAL = ov_test_open(vf);
  OUTPUT:
    RETVAL


=head2 ov_test_callbacks

an alternative function used to open and test an OggVorbis_File structure when using a data source
other than a file, when its necessary to modify default file access behavior.
L<http://www.xiph.org/vorbis/doc/vorbisfile/ov_test_callbacks.html>

B<Please read the official ov_test_callbacks doc before you use this.> The perl version uses
a different approach and uses vorbis_callbacks with custom functions to read, seek tell and close.

B<this module can accept file name, network socket or a file pointer.>

-Input:
  void *, (data source)
  OggVorbis_File, A pointer to the OggVorbis_File structure,
  char *, Typically set to NULL,
  int, Typically set to 0.

-Output:
  0 indicates succes,
  less than zero for failure:

    OV_EREAD - A read from media returned an error.
    OV_ENOTVORBIS - Bitstream is not Vorbis data.
    OV_EVERSION - Vorbis version mismatch.
    OV_EBADHEADER - Invalid Vorbis bitstream header.
    OV_EFAULT - Internal logic fault; indicates a bug or heap/stack corruption.

=cut

int
LibVorbis_ov_test_callbacks(path, vf, initial, ibytes)
    SV *       	     path  
    OggVorbis_File * vf
    char *	     initial
    int		     ibytes
  PREINIT:
    FILE *fp;
  CODE:
    int ret = 10;

    /* our stash for streams */
    ocvb_datasource *datasource = (ocvb_datasource *) safemalloc(sizeof(ocvb_datasource));
    memset(datasource, 0, sizeof(ocvb_datasource));

    /* check and see if a pathname was passed in, otherwise it might be a
     * IO::Socket subclass, or even a *FH Glob */
    if (SvOK(path) && (SvTYPE(SvRV(path)) != SVt_PVGV)) {

      if ((datasource->stream = PerlIO_open((char*)SvPV_nolen(path), "r")) == NULL) {
        safefree(vf);
        printf("failed on open: [%d] - [%s]\n", errno, strerror(errno));
        XSRETURN_UNDEF;
      }

      datasource->is_streaming = 0;

    } else if (SvOK(path)) {

      /* Did we get a Glob, or a IO::Socket subclass? */		
      if (sv_isobject(path) && sv_derived_from(path, "IO::Socket")) {
        datasource->is_streaming = 1;
      } else {

        datasource->is_streaming = 0;
      }

      /* dereference and get the SV* that contains the Magic & FH,
       * then pull the fd from the PerlIO object */
      datasource->stream = IoIFP(GvIOp(SvRV(path)));

    } else {

      fp = PerlIO_findFILE((PerlIO *)IoIFP(sv_2io(path)));
      /* check whether it is a valid file handler */
      if (fp == (FILE*) 0 || fileno(fp) <= 0) {   
         XSRETURN_UNDEF;
      }
      datasource->stream = (PerlIO *)IoIFP(sv_2io(path));
    }

    if ((ret = ov_test_callbacks((void*)datasource, vf, NULL, 0, vorbis_callbacks)) < 0) {
      warn("Failed on registering callbacks: [%d]\n", ret);
      printf("failed on open: [%d] - [%s]\n", errno, strerror(errno));
      ov_clear(vf);

      XSRETURN_UNDEF;
    }

    datasource->bytes_streamed = 0;
    datasource->last_bitstream = -1;

    RETVAL = ret;

  OUTPUT:
    RETVAL



=head2 ov_clear

ov_clear() to clear the decoder's buffers and close the file
L<http://www.xiph.org/vorbis/doc/vorbisfile/ov_clear.html>

-Input:
  OggVorbis_File

-Output:
  0 for success

=cut

int
LibVorbis_ov_clear(vf)
    OggVorbis_File *	vf
  CODE:
    RETVAL = ov_clear(vf);
  OUTPUT:
    RETVAL


=head2 ov_seekable

This indicates whether or not the bitstream is seekable. 
L<http://www.xiph.org/vorbis/doc/vorbisfile/ov_seekable.html>



( run in 1.100 second using v1.01-cache-2.11-cpan-140bd7fdf52 )