#!/usr/bin/perl use strict; use warnings; # both these structures have typemaps and a common 'options' field: my @options = ( ["PLTUBA", "JSON::SL::Tuba", [qw(utf8 no_cache_mro cb_unified allow_unhandled)]], ["PLJSONSL", "JSON::SL", [qw(utf8 nopath noqstr max_size object_drip)]] ); print <<"EOC"; # This file generated by '$0' and is meant to generate easy boolean # getters and setters EOC foreach (@options) { my ($ctype,$pkgname,$opts) = @$_; print <<"EOC"; MODULE = JSON::SL PACKAGE = $pkgname PREFIX = $ctype\_ PROTOTYPES: DISABLED EOC my $ix_counter = 1; my @defines; foreach my $optname (@$opts) { push @defines, ["$ctype\_OPTION_IX_$optname", $ix_counter, $optname]; $ix_counter++; } foreach (@defines) { my ($macro,$val) = @$_; print "#define $macro $val\n"; } print <<"EOC"; int $ctype\__options($ctype* obj, ...) ALIAS: EOC foreach (@defines) { my $macro = $_->[0]; my $optname = $_->[2]; printf(<<"EOC", $optname, $macro); %-15s = %s EOC } print <<"EOC"; CODE: RETVAL = 0; if (ix == 0) { die("Do not call this function (_options) directly"); } if (items > 2) { die("Usage: %s(o, ... boolean)", GvNAME(GvCV(cv))); } switch(ix) { EOC foreach (@defines) { my ($macro,$optname) = @{$_}[0,2]; print <<"EOC"; case $macro: RETVAL = obj->options.$optname; if (items == 2) { obj->options.$optname = SvIV(ST(1)); } break; EOC } print <<"EOC"; default: die("Unrecognized IX!?"); break; } OUTPUT: RETVAL EOC }