line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
/* vi: set ft=xs : */ |
2
|
|
|
|
|
|
|
#define PERL_NO_GET_CONTEXT |
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
#include "EXTERN.h" |
5
|
|
|
|
|
|
|
#include "perl.h" |
6
|
|
|
|
|
|
|
#include "XSUB.h" |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
#include "class_plain_class.h" |
9
|
|
|
|
|
|
|
#include "class_plain_field.h" |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
void ClassPlain_need_PLparser(pTHX); |
12
|
|
|
|
|
|
|
|
13
|
38
|
|
|
|
|
|
FieldMeta *ClassPlain_create_field(pTHX_ SV *field_name, ClassMeta *class) |
14
|
|
|
|
|
|
|
{ |
15
|
|
|
|
|
|
|
FieldMeta *field; |
16
|
38
|
|
|
|
|
|
Newxz(field, 1, FieldMeta); |
17
|
|
|
|
|
|
|
|
18
|
38
|
|
|
|
|
|
field->name = SvREFCNT_inc(field_name); |
19
|
38
|
|
|
|
|
|
field->class = class; |
20
|
|
|
|
|
|
|
|
21
|
38
|
|
|
|
|
|
return field; |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
|
24
|
26
|
|
|
|
|
|
void ClassPlain_field_apply_attribute(pTHX_ FieldMeta *field, const char *name, SV *value) |
25
|
|
|
|
|
|
|
{ |
26
|
26
|
50
|
|
|
|
|
if(value && (!SvPOK(value) || !SvCUR(value))) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
27
|
|
|
|
|
|
|
value = NULL; |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
{ |
31
|
26
|
|
|
|
|
|
ENTER; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
// The reader |
34
|
26
|
100
|
|
|
|
|
if (strcmp(name, "reader") == 0) { |
35
|
|
|
|
|
|
|
// The reader code |
36
|
8
|
|
|
|
|
|
SV* sv_reader_code = sv_2mortal(newSVpv("", 0)); |
37
|
8
|
|
|
|
|
|
sv_catpv(sv_reader_code, "sub "); |
38
|
8
|
50
|
|
|
|
|
sv_catpv(sv_reader_code, SvPV_nolen(field->class->name)); |
39
|
8
|
|
|
|
|
|
sv_catpv(sv_reader_code, "::"); |
40
|
8
|
100
|
|
|
|
|
if (value) { |
41
|
1
|
50
|
|
|
|
|
sv_catpv(sv_reader_code, SvPV_nolen(value)); |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
else { |
44
|
7
|
50
|
|
|
|
|
sv_catpv(sv_reader_code, SvPV_nolen(field->name)); |
45
|
|
|
|
|
|
|
} |
46
|
8
|
|
|
|
|
|
sv_catpv(sv_reader_code, " {\n my $self = shift;\n $self->{"); |
47
|
8
|
50
|
|
|
|
|
sv_catpv(sv_reader_code, SvPV_nolen(field->name)); |
48
|
8
|
|
|
|
|
|
sv_catpv(sv_reader_code, "};\n}"); |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
// Generate the reader |
51
|
8
|
50
|
|
|
|
|
Perl_eval_pv(aTHX_ SvPV_nolen(sv_reader_code), 1); |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
// The writer |
54
|
18
|
100
|
|
|
|
|
else if (strcmp(name, "writer") == 0) { |
55
|
|
|
|
|
|
|
// The writer code |
56
|
5
|
|
|
|
|
|
SV* sv_writer_code = sv_2mortal(newSVpv("", 0)); |
57
|
5
|
|
|
|
|
|
sv_catpv(sv_writer_code, "sub "); |
58
|
5
|
50
|
|
|
|
|
sv_catpv(sv_writer_code, SvPV_nolen(field->class->name)); |
59
|
5
|
|
|
|
|
|
sv_catpv(sv_writer_code, "::"); |
60
|
5
|
100
|
|
|
|
|
if (value) { |
61
|
1
|
50
|
|
|
|
|
sv_catpv(sv_writer_code, SvPV_nolen(value)); |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
else { |
64
|
4
|
|
|
|
|
|
sv_catpv(sv_writer_code, "set_"); |
65
|
4
|
50
|
|
|
|
|
sv_catpv(sv_writer_code, SvPV_nolen(field->name)); |
66
|
|
|
|
|
|
|
} |
67
|
5
|
|
|
|
|
|
sv_catpv(sv_writer_code, " {\n my $self = shift;\n $self->{"); |
68
|
5
|
50
|
|
|
|
|
sv_catpv(sv_writer_code, SvPV_nolen(field->name)); |
69
|
5
|
|
|
|
|
|
sv_catpv(sv_writer_code, "} = shift;\n return $self;\n}"); |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
// Generate the writer |
72
|
5
|
50
|
|
|
|
|
Perl_eval_pv(aTHX_ SvPV_nolen(sv_writer_code), 1); |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
// The read-write accessor |
75
|
13
|
50
|
|
|
|
|
else if (strcmp(name, "rw") == 0) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
76
|
|
|
|
|
|
|
// The rw code |
77
|
13
|
|
|
|
|
|
SV* sv_rw_code = sv_2mortal(newSVpv("", 0)); |
78
|
13
|
|
|
|
|
|
sv_catpv(sv_rw_code, "sub "); |
79
|
13
|
50
|
|
|
|
|
sv_catpv(sv_rw_code, SvPV_nolen(field->class->name)); |
80
|
13
|
|
|
|
|
|
sv_catpv(sv_rw_code, "::"); |
81
|
13
|
100
|
|
|
|
|
if (value) { |
82
|
1
|
50
|
|
|
|
|
sv_catpv(sv_rw_code, SvPV_nolen(value)); |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
else { |
85
|
12
|
50
|
|
|
|
|
sv_catpv(sv_rw_code, SvPV_nolen(field->name)); |
86
|
|
|
|
|
|
|
} |
87
|
13
|
|
|
|
|
|
sv_catpv(sv_rw_code, " {\n my $self = shift;\n if (@_) {\n $self->{"); |
88
|
13
|
50
|
|
|
|
|
sv_catpv(sv_rw_code, SvPV_nolen(field->name)); |
89
|
13
|
|
|
|
|
|
sv_catpv(sv_rw_code, "} = shift;\n return $self;\n }\n"); |
90
|
13
|
|
|
|
|
|
sv_catpv(sv_rw_code, "$self->{"); |
91
|
13
|
50
|
|
|
|
|
sv_catpv(sv_rw_code, SvPV_nolen(field->name)); |
92
|
13
|
|
|
|
|
|
sv_catpv(sv_rw_code, "};\n}"); |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
// Generate the rw |
95
|
13
|
50
|
|
|
|
|
Perl_eval_pv(aTHX_ SvPV_nolen(sv_rw_code), 1); |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|
98
|
26
|
|
|
|
|
|
LEAVE; |
99
|
|
|
|
|
|
|
} |
100
|
26
|
|
|
|
|
|
} |