1 package Data::Dumper::ToXS;
5 sub newix { $_[0].'['.($ix{$_[0]}++).']' }
7 use B qw(svref_2object cstring);
8 use Scalar::Util qw(refaddr);
11 has target_package => (is => 'ro', required => 1);
13 has _to_generate => (is => 'ro', default => sub { [] });
16 my ($self, $name, $ref) = @_;
17 die "Generation target must be a reference" unless ref($ref);
18 push(@{$self->_to_generate}, [ $name => $ref ]);
23 my @do = @{$self->_to_generate};
24 join "\n\n", $self->_preamble,
25 (map $self->_generate_target(@$_), @do),
26 $self->_package_start($self->target_package),
27 (map $self->_generate_xsub($_->[0]), @do);
32 #define PERL_NO_GET_CONTEXT
41 my ($self, $package) = @_;
43 MODULE = ${package} PACKAGE = ${package}
51 my ($self, $name) = @_;
56 RETVAL = ${name}(aTHX);
62 sub _generate_target {
63 my ($self, $name, $ref) = @_;
64 local %ix = map +($_ => 0), qw(av hv sv);
66 my $first = newix('sv');
67 my $body = $self->_dump_svrv($first, $ref);
68 my $vars = join '', map +(
69 $ix{$_} ? " ${\uc}* ${_}[$ix{$_}];\n" : ""
74 ${vars}${body} return ${first};
80 my ($self, $ix, $ref) = @_;
83 # already seen this reference so make a copy
84 " ${ix} = newSVsv($seen{$ref});\n";
88 my $t_ix = newix('sv');
90 $self->_dump_sv($t_ix, $ref),
91 " ${ix} = newRV_noinc(${t_ix});\n";
92 } elsif ($r eq 'HASH') {
93 my $t_ix = newix('hv');
95 $self->_dump_hv($t_ix, $ref),
96 " ${ix} = newRV_noinc((SV *)${t_ix});\n";
97 } elsif ($r eq 'ARRAY') {
98 my $t_ix = newix('av');
100 $self->_dump_av($t_ix, $ref),
101 " ${ix} = newRV_noinc((SV *)${t_ix});\n";
102 } elsif ($r eq 'REF') {
103 my $t_ix = newix('sv');
105 $self->_dump_svrv($t_ix, $$ref),
106 " ${ix} = newRV_noinc(${t_ix});\n";
108 die "Can't handle reftype ${r}";
114 my ($self, $ix, $ref) = @_;
116 $self->_dump_svrv($ix, $$ref);
118 # Not a reference. What are we dumping?
119 my $sv = svref_2object($ref);
120 if (!defined($$ref)) {
121 " ${ix} = newSVsv(&PL_sv_undef);\n";
122 } elsif ($sv->isa('B::IV')) {
123 " ${ix} = newSViv(".$sv->int_value.");\n";
124 } elsif ($sv->isa('B::NV')) {
125 " ${ix} = newSVnv(".$sv->NV.");\n";
126 } elsif ($sv->isa('B::PV')) {
127 " ${ix} = newSVpvs(".cstring($$ref).");\n";
129 die "Unsure how to dump ".$$ref;
135 my ($self, $ix, $ref) = @_;
137 " ${ix} = newHV();\n",
139 my $t_ix = newix('sv');
140 ($self->_dump_sv($t_ix, \($ref->{$_})),
141 " hv_stores(${ix}, ${\cstring $_}, ${t_ix});\n")
146 my ($self, $ix, $ref) = @_;
148 " ${ix} = newAV();\n",
150 my $t_ix = newix('sv');
151 $self->_dump_sv($t_ix, \($ref->[$_])),
152 " av_push(${ix}, ${t_ix});\n"