1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
// Derived from the following:
/////////////////////////////////////////////////////////////////////////////
// Name: cpp/helpers.cpp
// Purpose: implementation for helpers.h
// Author: Mattia Barbon
// Modified by:
// Created: 29/10/2000
// RCS-ID: $Id: helpers.cpp 3397 2012-09-30 02:26:07Z mdootson $
// Copyright: (c) 2000-2011 Mattia Barbon
// Licence: This program is free software; you can redistribute it and/or
// modify it under the same terms as Perl itself
/////////////////////////////////////////////////////////////////////////////
#ifdef __cplusplus
extern "C" {
#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
#undef do_open
#undef do_close
#ifdef __cplusplus
}
#endif
//#include <xsinit.h>
// ----------------------------------------------------------------------------
// Utility functions for working with MAGIC
// ----------------------------------------------------------------------------
struct my_magic
{
my_magic() : object( NULL ), deleteable( true ) { }
void* object;
bool deleteable;
};
//STATIC MGVTBL my_vtbl = { 0, 0, 0, 0, 0, 0, 0, 0 };
my_magic* wxPli_get_magic( pTHX_ SV* rv )
{
// check for reference
if( !SvROK( rv ) )
return NULL;
SV* ref = SvRV( rv );
// if it isn't a SvPVMG, then it can't have MAGIC
// so it is deleteable
if( !ref || SvTYPE( ref ) < SVt_PVMG )
return NULL;
// search for '~' / PERL_MAGIC_ext magic, and check the value
// MAGIC* magic = mg_findext( ref, PERL_MAGIC_ext, &my_vtbl );
MAGIC* magic = mg_find( ref, '~' );
if( !magic )
return NULL;
return (my_magic*)magic->mg_ptr;
}
// gets 'this' pointer from a blessed scalar/hash reference
void* wxPli_sv_2_object( pTHX_ SV* scalar, const char* classname )
{
// is it correct to use undef as 'NULL'?
if( !SvOK( scalar ) )
{
return NULL;
}
if( !SvROK( scalar ) )
croak( "variable is not an object: it must have type %s", classname );
if( !classname || sv_derived_from( scalar, (char*) classname ) )
{
SV* ref = SvRV( scalar );
my_magic* mg = wxPli_get_magic( aTHX_ scalar );
// rationale: if this is an hash-ish object, it always
// has both mg and mg->object; if however this is a
// scalar-ish object that has been marked/unmarked deletable
// it has mg, but not mg->object
if( !mg || !mg->object )
return INT2PTR( void*, SvOK( ref ) ? SvIV( ref ) : 0 );
return mg->object;
}
else
{
croak( "variable is not of type %s", classname );
return NULL; // dummy, for compiler
}
}
|
