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
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
/*****************************************************************************/
/* */
/* Copyright (c) 2001 by Steffen Beyer. */
/* All rights reserved. */
/* */
/* This package is free software; you can redistribute it */
/* and/or modify it under the same terms as Perl itself. */
/* */
/*****************************************************************************/
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#define INTERNALS_REFERENCE(ref,obj) ( ref && SvROK(ref) && (obj = SvRV(ref)) )
#define INTERNALS_NUMBER(ref,val) ( ref && !(SvROK(ref)) && ((val = (U32)SvIV(ref)) | 1) )
#define INTERNALS_ERROR(name,error) croak("Internals::" name "(): " error)
#define INTERNALS_NO_REFERENCE(name) INTERNALS_ERROR(name,"argument is not a reference")
#define INTERNALS_NO_NUMBER(name) INTERNALS_ERROR(name,"argument is not a number")
MODULE = Internals PACKAGE = Internals
PROTOTYPES: DISABLE
void
IsWriteProtected(ref)
SV * ref
PPCODE:
{
SV *obj;
if ( INTERNALS_REFERENCE(ref,obj) )
{
PUSHs(sv_2mortal(newSViv((IV)( SvREADONLY(obj) ? 1 : 0 ))));
}
else INTERNALS_NO_REFERENCE("IsWriteProtected");
}
void
SetReadOnly(ref)
SV * ref
PPCODE:
{
SV *obj;
if ( INTERNALS_REFERENCE(ref,obj) )
{
SvREADONLY_on(obj);
PUSHs(sv_mortalcopy(ref));
}
else INTERNALS_NO_REFERENCE("SetReadOnly");
}
void
SetReadWrite(ref)
SV * ref
PPCODE:
{
SV *obj;
if ( INTERNALS_REFERENCE(ref,obj) )
{
SvREADONLY_off(obj);
PUSHs(sv_mortalcopy(ref));
}
else INTERNALS_NO_REFERENCE("SetReadWrite");
}
void
GetRefCount(ref)
SV * ref
PPCODE:
{
SV *obj;
if ( INTERNALS_REFERENCE(ref,obj) )
{
PUSHs(sv_2mortal(newSViv((IV)( obj->sv_refcnt ))));
}
else INTERNALS_NO_REFERENCE("GetRefCount");
}
void
SetRefCount(ref,val)
SV * ref
SV * val
PPCODE:
{
SV *obj;
U32 cnt;
if ( INTERNALS_REFERENCE(ref,obj) )
{
if ( INTERNALS_NUMBER(val,cnt) )
{
obj->sv_refcnt = cnt;
}
else INTERNALS_NO_NUMBER("SetRefCount");
}
else INTERNALS_NO_REFERENCE("SetRefCount");
}
|
