// преобразование С++ класса в Perl-объект
SV *
class2pobj(IV iv, const char *class_name, int no_ptr)
{
    HV *hv = newHV();                    // создание хеша
    SV *retval = newSV(0);               // переменная, в которую помещается указатель на класс
    sv_setiv(retval, iv);                // почти retval = (SV*)iv;
    hv_store(hv, "_ptr", 4, retval, 0);  // копирование переменной в $хеш{_ptr}
    hv_store(hv, "_del", 4, newSViv(no_ptr), 0); // пометка-разрешение на вызов деструктора
    return sv_bless(newRV_noinc((SV*)hv), gv_stashpv(class_name, 0));
    // вызов bless и возврат уже готового Perl-объекта
}

// преобразование Perl-объекта в C++ класс
IV
pobj2class(SV *sv, const char *class_name, const char *func, const char *var)
{
    char pclass_name[512];
    char fn_warn[512];
    char ptr_warn[512];
    snprintf(pclass_name, 512, "Qt::%s", class_name);         // воссоздание имени класса
    snprintf(fn_warn, 512, "%s() -- %s is not blessed Qt::%s", func, var, class_name);
    snprintf(ptr_warn, 512, "%s() -- %s->{_ptr} is NULL", func, var);

    if( sv_derived_from(sv, pclass_name) && (SvTYPE(SvRV(sv)) == SVt_PVHV) )
    { // если это искомый класс и тип данных является указателем на хеш, то
        HV *hv = (HV*)SvRV( sv );                             // получаем хеш из указателя
        SV **ssv = hv_fetch(hv, "_ptr", 4, 0);                // получаем реальный указатель
        if ( ssv != NULL )                                    // если указатель не пустой
            return SvIV(*ssv);                                // возвращаем его
        warn( ptr_warn );
        return (IV)NULL;                                      // иначе – возвращаем 'ничего'
    }
    warn( fn_warn );
    return (IV)NULL;
}

SV *
new()
    CODE:
        QSize * out_data;
        out_data = new QSize( );
        RETVAL = class2pobj(PTR2IV(out_data), "Qt::QSize", 1);
    OUTPUT:
        RETVAL

void
QSize::DESTROY()
    CODE:
        // предварительно проверяем можно ли удалять класс
        SV **ssv = hv_fetch((HV*)SvRV(ST(0)), "_del", 4, 0);
        if ( SvIV(*ssv) )
            delete THIS;

INPUT

O_OBJECT
        $var = INT2PTR($type,
                pobj2class($arg,
                        \"${(my $ttt = $type) =~ s/^(?:Perl)?([0-9A-Za-z_]+) \*/$1/;\$ttt}\",
                        \"${Package}::$func_name\", \"$var\"));
        if ( $var == NULL )
                XSRETURN_UNDEF;

OUTPUT

O_OBJECT
        $arg = class2pobj(PTR2IV($var),
                \"Qt::${(my $ttt = $type) =~ s/^([0-9A-Za-z_]+) \*/$1/;\$ttt}\", 1);