File Coverage

src/class_plain_field.c
Criterion Covered Total %
statement 50 50 100.0
branch 33 54 61.1
condition n/a
subroutine n/a
pod n/a
total 83 104 79.8


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_meta)
14             {
15             FieldMeta *fieldmeta;
16 38           Newx(fieldmeta, 1, FieldMeta);
17              
18 38           fieldmeta->name = SvREFCNT_inc(field_name);
19 38           fieldmeta->class = class_meta;
20              
21 38           return fieldmeta;
22             }
23              
24 26           void ClassPlain_field_apply_attribute(pTHX_ FieldMeta *fieldmeta, 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(fieldmeta->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(fieldmeta->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(fieldmeta->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(fieldmeta->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(fieldmeta->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(fieldmeta->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(fieldmeta->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(fieldmeta->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(fieldmeta->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(fieldmeta->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           }