line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#define PERL_NO_GET_CONTEXT // we'll define thread context if necessary (faster) |
2
|
|
|
|
|
|
|
#include "EXTERN.h" // globals/constant import locations |
3
|
|
|
|
|
|
|
#include "perl.h" // Perl symbols, structures and constants definition |
4
|
|
|
|
|
|
|
#include "XSUB.h" // xsubpp functions and macros |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
MODULE = XS::Tutorial::Three PACKAGE = XS::Tutorial::Three |
7
|
|
|
|
|
|
|
PROTOTYPES: ENABLE |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
BOOT: |
10
|
1
|
|
|
|
|
|
printf("We're starting up!\n"); |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
SV* |
13
|
|
|
|
|
|
|
get_tied_value(SV *foo) |
14
|
|
|
|
|
|
|
PPCODE: |
15
|
|
|
|
|
|
|
/* call FETCH() if it's a tied variable to populate the sv */ |
16
|
1
|
50
|
|
|
|
|
SvGETMAGIC(foo); |
|
|
50
|
|
|
|
|
|
17
|
1
|
|
|
|
|
|
PUSHs(sv_2mortal(foo)); |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
SV* |
20
|
|
|
|
|
|
|
is_utf8(SV *foo) |
21
|
|
|
|
|
|
|
PPCODE: |
22
|
|
|
|
|
|
|
/* if the UTF-8 flag is set return 1 "true" */ |
23
|
2
|
100
|
|
|
|
|
if (SvUTF8(foo)) { |
24
|
1
|
|
|
|
|
|
PUSHs(sv_2mortal(newSViv(1))); |
25
|
|
|
|
|
|
|
} |
26
|
|
|
|
|
|
|
/* else return undef "false" */ |
27
|
|
|
|
|
|
|
else { |
28
|
1
|
|
|
|
|
|
PUSHs(sv_newmortal()); |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
SV* |
32
|
|
|
|
|
|
|
is_downgradeable(SV *foo) |
33
|
|
|
|
|
|
|
PPCODE: |
34
|
|
|
|
|
|
|
/* if the UTF-8 flag is set and the scalar is not downgrade-able return "false" */ |
35
|
2
|
100
|
|
|
|
|
if (SvUTF8(foo) && !sv_utf8_downgrade(foo, TRUE)) { |
|
|
50
|
|
|
|
|
|
36
|
1
|
|
|
|
|
|
PUSHs(sv_newmortal()); |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
/* else return 1 "true" */ |
39
|
|
|
|
|
|
|
else { |
40
|
1
|
|
|
|
|
|
PUSHs(sv_2mortal(newSViv(1))); |
41
|
|
|
|
|
|
|
} |