Re: Creating new instance of Perl-Class in XS

[Tom Schindl]

Tels wrote:
-----BEGIN PGP SIGNED MESSAGE-----

Moin,

On Friday 05 March 2004 11:23, Tom Schindl wrote:

Hi,

how can I create an instance of a Perl-class in XS.


I don't know (dont even understand the question properly). However, I could 
not define a C++ class in XS because apparently  "class" is considered some 
keyword. :/ Does "CLASS" workaround this?
Yes.

Take a look at this.

-----------------------8<-----------------------
// some code
typedef struct {
  GdkPixbuf *pixbuf;
} SVGLibRSVG;
MODULE = Image::LibRSVG         PACKAGE = Image::LibRSVG

PROTOTYPES: ENABLE

## -------------------------------------------------------
## CONSTRUCTOR AND DESTRUCTOR
## -------------------------------------------------------
SVGLibRSVG *
new( CLASS )
        char *CLASS
    CODE:
        Newz(0, RETVAL, 1, SVGLibRSVG);
        RETVAL->pixbuf = NULL;
    OUTPUT:
        RETVAL
void
SVGLibRSVG::DESTROY()
    CODE:
        if( THIS->pixbuf ) {
            g_object_unref ( G_OBJECT (THIS->pixbuf) );
            THIS->pixbuf = NULL;
        }
int
SVGLibRSVG::loadFromFile( svgfile, dpi=0 )
        char   * svgfile
        double   dpi
    CODE:
        g_type_init ();
        if (dpi > 0.) {
            rsvg_set_default_dpi (dpi);
        }
        if( THIS->pixbuf ) {
            g_object_unref ( G_OBJECT (THIS->pixbuf) );
        }
        THIS->pixbuf = rsvg_pixbuf_from_file( svgfile, NULL );

        if( THIS->pixbuf ) {
            RETVAL = 1;
        } else {
            RETVAL = 0;
        }
    OUTPUT:
        RETVAL
## more xs-code
-----------------------8<-----------------------
typemap:
-----------------------8<-----------------------
TYPEMAP
SVGLibRSVG *  T_OBJECT
OUTPUT
T_OBJECT
        sv_setref_pv($arg, CLASS, (void*)$var);
INPUT
T_OBJECT
        if (sv_isobject($arg) && SvTYPE(SvRV($arg)) == SVt_PVMG)
        {
          IV tmp = SvIV((SV*)SvRV($arg));
          $var = INT2PTR($type, tmp);
        }
        else
          Perl_croak(aTHX_ \"${Package}::$func_name(): $var is not a 
blessed SV reference\");

-----------------------8<-----------------------

my.pl
-----------------------8<-----------------------
use Image::LibRSVG
my $rsvg = new Image::LibRSVG();
$rsvg->convert("foo.svg","bar.png");
-----------------------8<-----------------------
You should probably call new() from XS. See perldoc perlcall for some info.

Cheers,

Tels


1. Both defined in XS:
======================
Soccer.xs:
-----------------------8<-----------------------
MODULE = Soccer         PACKAGE = Soccer::Team
Team *
new(CLASS)
    char *CLASS
  CODE:
    .......
  OUTPUT:
    RETVAL
Player *
Team::getPlayer(p_id)
    int p_id
  CODE
    ## create a new player new Soccer::Player(p_id)
    ## how is this done?????
MODULE = Soccer		PACKAGE = Soccer::Player

Player *
new(CLASS,p_id)
    char *CLASS
    int p_id
  CODE:
    .......
  OUTPUT:
    RETVAL
-----------------------8<-----------------------
2. 1 defined in XS 1 defined in Perl:
=======================================
Soccer.xs:
-----------------------8<-----------------------
MODULE = Soccer         PACKAGE = Soccer::Team
Team *
new(CLASS)
    char *CLASS
  CODE:
    .......
  OUTPUT:
    RETVAL
Player *
Team::getPlayer(p_id)
    int p_id
  CODE
    ## create a new player new Soccer::Player(p_id)
    ## how is this done?????
-----------------------8<-----------------------
Soccer.pm:
-----------------------8<-----------------------
package Soccer::Player;
sub new {
  my $class = shift;
  my $p_id  = shift;
  return bless { id => $p_id }, $class;
}
-----------------------8<-----------------------