our
$VERSION
= 0.005_000;
our
hashref
$properties
= {};
sub
ast_to_rperl__generate {
{
my
string_hashref::method
$RETURN_TYPE
};
(
my
object
$self
,
my
string_hashref
$modes
) =
@ARG
;
my
string_hashref
$rperl_source_group
= {
PMC
=>
q{}
};
my
string_hashref
$rperl_source_subgroup
;
if
( (
ref
$self
) ne
'Expression_154'
) {
die
RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASRP000, CODE GENERATOR, ABSTRACT SYNTAX TO RPERL: Grammar rule '
. (
ref
$self
)
.
' found where Expression_154 expected, dying'
)
.
"\n"
;
}
my
string
$type
=
$self
->{children}->[0]->{children}->[0];
my
string
$thin_arrow_new_left_paren
=
$self
->{children}->[1];
my
object
$properties_init_optional
=
$self
->{children}->[2];
my
string
$right_paren
=
$self
->{children}->[3];
$rperl_source_group
->{PMC} .=
$type
.
$thin_arrow_new_left_paren
;
if
(
defined
$properties_init_optional
->{children}->[0] ) {
$rperl_source_subgroup
=
$properties_init_optional
->{children}->[0]->ast_to_rperl__generate(
$modes
);
RPerl::Generator::source_group_append(
$rperl_source_group
,
$rperl_source_subgroup
);
}
$rperl_source_group
->{PMC} .=
$right_paren
;
return
$rperl_source_group
;
}
sub
ast_to_cpp__generate__CPPOPS_PERLTYPES {
{
my
string_hashref::method
$RETURN_TYPE
};
(
my
object
$self
,
my
string_hashref
$modes
) =
@ARG
;
my
string_hashref
$cpp_source_group
= {
CPP
=>
q{// <<< RP::O::E::SC::MC::CC __DUMMY_SOURCE_CODE CPPOPS_PERLTYPES >>>}
.
"\n"
};
return
$cpp_source_group
;
}
sub
ast_to_cpp__generate__CPPOPS_CPPTYPES {
{
my
string_hashref::method
$RETURN_TYPE
};
(
my
object
$self
,
my
string_hashref
$modes
) =
@ARG
;
my
string_hashref
$cpp_source_group
= {
CPP
=>
q{}
};
my
string_hashref
$cpp_source_subgroup
;
if
( (
ref
$self
) ne
'Expression_154'
) {
die
RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP000, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Grammar rule '
. (
ref
$self
) .
' found where Expression_154 expected, dying'
) .
"\n"
;
}
my
string
$type
=
$self
->{children}->[0]->{children}->[0];
my
string
$type_cpp
= RPerl::Generator::type_convert_perl_to_cpp(
$type
, 0);
my
object
$properties_init_optional
=
$self
->{children}->[2];
if
( (
substr
$type
, 0, 7) eq
'MongoDB'
) {
if
((not
exists
$modes
->{_enable_mongodb}) or (not
defined
$modes
->{_enable_mongodb}) or (not
$modes
->{_enable_mongodb})) {
die
RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP091b, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Found constructor call for package '
.
q{'}
.
$type
.
q{'}
.
' but MongoDB support is not enabled, perhaps you forgot to load MongoDB support via `use RPerl::Support::MongoDB;`, dying'
)
.
"\n"
;
}
if
(
$type
ne
'MongoDB::MongoClient'
) {
die
RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP092b, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Found constructor call for package '
.
q{'}
.
$type
.
q{'}
.
' but only '
.
q{'}
. 'MongoDB::MongoClient
' . q{'
} .
' may be directly constructed, please see the MongoDB documentation on CPAN for more information, dying'
)
.
"\n"
;
}
my
string
$mongodb_host
;
if
(
defined
$properties_init_optional
->{children}->[0] ) {
my
$properties_init
=
$properties_init_optional
->{children}->[0];
if
((
ref
$properties_init
) ne
'HashReference_232'
) {
die
RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP097a, CODE GENERATOR, ABSTRACT SYNTAX TO C++: In constructor call for package '
.
q{'}
.
$type
.
q{()'}
.
', invalid arguments found, must be exactly 1 non-empty hashref, only '
.
q{'host'}
.
' key with '
.
q{'mongodb://HOST:PORT'}
.
' value currently supported, dying'
) .
"\n"
;
}
elsif
((not
exists
$properties_init
->{children}) or
(not
defined
$properties_init
->{children}) or
(
scalar
@{
$properties_init
->{children}}) != 4) {
die
RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP098a, CODE GENERATOR, ABSTRACT SYNTAX TO C++: In constructor call for package '
.
q{'}
.
$type
.
q{()'}
.
', wrong number of arguments found, must be exactly 1 non-empty hashref, only '
.
q{'host'}
.
' key with '
.
q{'mongodb://HOST:PORT'}
.
' value currently supported, dying'
) .
"\n"
;
}
elsif
((not
defined
$properties_init
->{children}->[2]) or
((
ref
$properties_init
->{children}->[2]) ne
'_STAR_LIST'
)) {
die
RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP097b, CODE GENERATOR, ABSTRACT SYNTAX TO C++: In constructor call for package '
.
q{'}
.
$type
.
q{()'}
.
', invalid or no arguments found, must be exactly 1 non-empty hashref, only '
.
q{'host'}
.
' key with '
.
q{'mongodb://HOST:PORT'}
.
' value currently supported, dying'
) .
"\n"
;
}
elsif
((not
exists
$properties_init
->{children}->[2]->{children}) or
(not
defined
$properties_init
->{children}->[2]->{children}) or
((
scalar
@{
$properties_init
->{children}->[2]->{children}}) != 0)) {
die
RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP098b, CODE GENERATOR, ABSTRACT SYNTAX TO C++: In constructor call for package '
.
q{'}
.
$type
.
q{()'}
.
', wrong number of arguments found, must be exactly 1 non-empty hashref, only '
.
q{'host'}
.
' key with '
.
q{'mongodb://HOST:PORT'}
.
' value currently supported, dying'
) .
"\n"
;
}
elsif
((not
defined
$properties_init
->{children}->[1]) or
((
ref
$properties_init
->{children}->[1]) ne
'HashEntry_225'
)) {
die
RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP097c, CODE GENERATOR, ABSTRACT SYNTAX TO C++: In constructor call for package '
.
q{'}
.
$type
.
q{()'}
.
', invalid or no arguments found, must be exactly 1 non-empty hashref, only '
.
q{'host'}
.
' key with '
.
q{'mongodb://HOST:PORT'}
.
' value currently supported, dying'
) .
"\n"
;
}
elsif
((not
exists
$properties_init
->{children}->[1]->{children}) or
(not
defined
$properties_init
->{children}->[1]->{children}) or
((
scalar
@{
$properties_init
->{children}->[1]->{children}}) != 4)) {
die
RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP098c, CODE GENERATOR, ABSTRACT SYNTAX TO C++: In constructor call for package '
.
q{'}
.
$type
.
q{()'}
.
', wrong number of arguments found, must be exactly 1 non-empty hashref, only '
.
q{'host'}
.
' key with '
.
q{'mongodb://HOST:PORT'}
.
' value currently supported, dying'
) .
"\n"
;
}
elsif
((not
defined
$properties_init
->{children}->[1]->{children}->[0]) or
((
ref
$properties_init
->{children}->[1]->{children}->[0]) ne
'VarOrLitOrOpStrOrWord_252'
)) {
die
RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP097d, CODE GENERATOR, ABSTRACT SYNTAX TO C++: In constructor call for package '
.
q{'}
.
$type
.
q{()'}
.
', invalid or no arguments found, must be exactly 1 non-empty hashref, only '
.
q{'host'}
.
' key with '
.
q{'mongodb://HOST:PORT'}
.
' value currently supported, dying'
) .
"\n"
;
}
elsif
((not
exists
$properties_init
->{children}->[1]->{children}->[0]->{children}) or
(not
defined
$properties_init
->{children}->[1]->{children}->[0]->{children}) or
((
scalar
@{
$properties_init
->{children}->[1]->{children}->[0]->{children}}) != 1)) {
die
RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP098d, CODE GENERATOR, ABSTRACT SYNTAX TO C++: In constructor call for package '
.
q{'}
.
$type
.
q{()'}
.
', wrong number of arguments found, must be exactly 1 non-empty hashref, only '
.
q{'host'}
.
' key with '
.
q{'mongodb://HOST:PORT'}
.
' value currently supported, dying'
) .
"\n"
;
}
elsif
((not
defined
$properties_init
->{children}->[1]->{children}->[0]->{children}->[0]) or
((
ref
$properties_init
->{children}->[1]->{children}->[0]->{children}->[0]) ne
'OpStringOrWord_279'
)) {
die
RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP097e, CODE GENERATOR, ABSTRACT SYNTAX TO C++: In constructor call for package '
.
q{'}
.
$type
.
q{()'}
.
', invalid or no arguments found, must be exactly 1 non-empty hashref, only '
.
q{'host'}
.
' key with '
.
q{'mongodb://HOST:PORT'}
.
' value currently supported, dying'
) .
"\n"
;
}
elsif
((not
exists
$properties_init
->{children}->[1]->{children}->[0]->{children}->[0]->{children}) or
(not
defined
$properties_init
->{children}->[1]->{children}->[0]->{children}->[0]->{children}) or
((
scalar
@{
$properties_init
->{children}->[1]->{children}->[0]->{children}->[0]->{children}}) != 1)) {
die
RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP098e, CODE GENERATOR, ABSTRACT SYNTAX TO C++: In constructor call for package '
.
q{'}
.
$type
.
q{()'}
.
', wrong number of arguments found, must be exactly 1 non-empty hashref, only '
.
q{'host'}
.
' key with '
.
q{'mongodb://HOST:PORT'}
.
' value currently supported, dying'
) .
"\n"
;
}
elsif
((not
defined
$properties_init
->{children}->[1]->{children}->[0]->{children}->[0]->{children}->[0]) or
(
$properties_init
->{children}->[1]->{children}->[0]->{children}->[0]->{children}->[0] ne
'host'
)) {
die
RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP097f, CODE GENERATOR, ABSTRACT SYNTAX TO C++: In constructor call for package '
.
q{'}
.
$type
.
q{()'}
.
', invalid or no arguments found, must be exactly 1 non-empty hashref, only '
.
q{'host'}
.
' key with '
.
q{'mongodb://HOST:PORT'}
.
' value currently supported, dying'
) .
"\n"
;
}
elsif
((not
defined
$properties_init
->{children}->[1]->{children}->[3]) or
((
ref
$properties_init
->{children}->[1]->{children}->[3]) ne
'SubExpression_157'
)) {
die
RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP097g, CODE GENERATOR, ABSTRACT SYNTAX TO C++: In constructor call for package '
.
q{'}
.
$type
.
q{()'}
.
', invalid or no arguments found, must be exactly 1 non-empty hashref, only '
.
q{'host'}
.
' key with '
.
q{'mongodb://HOST:PORT'}
.
' value currently supported, dying'
) .
"\n"
;
}
elsif
((not
exists
$properties_init
->{children}->[1]->{children}->[3]->{children}) or
(not
defined
$properties_init
->{children}->[1]->{children}->[3]->{children}) or
((
scalar
@{
$properties_init
->{children}->[1]->{children}->[3]->{children}}) != 1)) {
die
RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP098g, CODE GENERATOR, ABSTRACT SYNTAX TO C++: In constructor call for package '
.
q{'}
.
$type
.
q{()'}
.
', wrong number of arguments found, must be exactly 1 non-empty hashref, only '
.
q{'host'}
.
' key with '
.
q{'mongodb://HOST:PORT'}
.
' value currently supported, dying'
) .
"\n"
;
}
elsif
((not
defined
$properties_init
->{children}->[1]->{children}->[3]->{children}->[0]) or
((
ref
$properties_init
->{children}->[1]->{children}->[3]->{children}->[0]) ne
'Literal_256'
)) {
die
RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP097h, CODE GENERATOR, ABSTRACT SYNTAX TO C++: In constructor call for package '
.
q{'}
.
$type
.
q{()'}
.
', invalid or no arguments found, must be exactly 1 non-empty hashref, only '
.
q{'host'}
.
' key with '
.
q{'mongodb://HOST:PORT'}
.
' value currently supported, dying'
) .
"\n"
;
}
elsif
((not
exists
$properties_init
->{children}->[1]->{children}->[3]->{children}->[0]->{children}) or
(not
defined
$properties_init
->{children}->[1]->{children}->[3]->{children}->[0]->{children}) or
((
scalar
@{
$properties_init
->{children}->[1]->{children}->[3]->{children}->[0]->{children}}) != 1)) {
die
RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP098h, CODE GENERATOR, ABSTRACT SYNTAX TO C++: In constructor call for package '
.
q{'}
.
$type
.
q{()'}
.
', wrong number of arguments found, must be exactly 1 non-empty hashref, only '
.
q{'host'}
.
' key with '
.
q{'mongodb://HOST:PORT'}
.
' value currently supported, dying'
) .
"\n"
;
}
elsif
((not
defined
$properties_init
->{children}->[1]->{children}->[3]->{children}->[0]->{children}->[0]) or
(
((
substr
$properties_init
->{children}->[1]->{children}->[3]->{children}->[0]->{children}->[0], 1, 10) ne
q{mongodb://}
) and
((
substr
$properties_init
->{children}->[1]->{children}->[3]->{children}->[0]->{children}->[0], 2, 10) ne
q{mongodb://}
)
) ) {
die
RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP097i, CODE GENERATOR, ABSTRACT SYNTAX TO C++: In constructor call for package '
.
q{'}
.
$type
.
q{()'}
.
', invalid or no arguments found, must be exactly 1 non-empty hashref, only '
.
q{'host'}
.
' key with '
.
q{'mongodb://HOST:PORT'}
.
' value currently supported, dying'
) .
"\n"
;
}
$mongodb_host
=
$properties_init
->{children}->[1]->{children}->[3]->{children}->[0]->{children}->[0];
if
((
substr
$mongodb_host
, 0, 1) eq
q{'}
) {
substr
$mongodb_host
, 0, 1,
q{}
;
substr
$mongodb_host
, -1, 1,
q{}
;
}
elsif
((
substr
$mongodb_host
, 0, 1) eq
'q'
) {
substr
$mongodb_host
, 0, 2,
q{}
;
substr
$mongodb_host
, -1, 1,
q{}
;
}
else
{
die
RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP097j, CODE GENERATOR, ABSTRACT SYNTAX TO C++: In constructor call for package '
.
q{'}
.
$type
.
q{()'}
.
', invalid or no arguments found, must be exactly 1 non-empty hashref, only '
.
q{'host'}
.
' key with '
.
q{'mongodb://HOST:PORT'}
.
' value currently supported, dying'
) .
"\n"
;
}
}
else
{
}
$cpp_source_group
->{CPP} .=
'{mongodb_host{"'
.
$mongodb_host
.
'"}}'
;
}
elsif
(
defined
$properties_init_optional
->{children}->[0] ) {
$properties_init_optional
=
$properties_init_optional
->{children}->[0];
my
object
$property_0
=
$properties_init_optional
->{children}->[1];
if
( (
ref
$property_0
) ne
'HashEntry_225'
) {
die
RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP036, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Grammar rule '
. (
ref
$property_0
) .
' found where HashEntry_225 expected, object property value initialization hashref must contain normal key/value pairs only, dying'
) .
"\n"
;
}
$cpp_source_subgroup
=
$self
->ast_to_cpp__generate__CPPOPS_CPPTYPES__property_init(
$modes
,
$property_0
);
$cpp_source_group
->{CPP} .=
'(NEW_'
.
$type_cpp
.
'{}).'
.
$cpp_source_subgroup
->{CPP_name} .
'('
.
$cpp_source_subgroup
->{CPP_value} .
')'
;
my
object
$properties
=
$properties_init_optional
->{children}->[2];
if
(
defined
$properties
->{children}->[0]) {
foreach
my
object
$property
(@{
$properties
->{children}}) {
if
((
exists
$property
->{attr}) and (
defined
$property
->{attr}) and (
$property
->{attr} eq
','
)) {
next
;
}
$cpp_source_subgroup
=
$self
->ast_to_cpp__generate__CPPOPS_CPPTYPES__property_init(
$modes
,
$property
);
$cpp_source_group
->{CPP} .=
'.'
.
$cpp_source_subgroup
->{CPP_name} .
'('
.
$cpp_source_subgroup
->{CPP_value} .
')'
;
}
}
$cpp_source_group
->{CPP} .=
'.NEW()'
;
}
else
{
$cpp_source_group
->{CPP} .=
'new '
.
$type_cpp
;
}
return
$cpp_source_group
;
}
sub
ast_to_cpp__generate__CPPOPS_CPPTYPES__property_init {
{
my
string_hashref::method
$RETURN_TYPE
};
(
my
object
$self
,
my
string_hashref
$modes
,
my
object
$property
) =
@ARG
;
my
string_hashref
$cpp_source_group
= {
CPP_name
=>
q{}
,
CPP_value
=>
q{}
};
my
string_hashref
$cpp_source_subgroup
;
my
object
$property_name
=
$property
->{children}->[0];
my
object
$property_type_inner_optional
=
$property
->{children}->[2];
my
object
$property_value
=
$property
->{children}->[3];
if
( (
ref
$property_name
) ne
'VarOrLitOrOpStrOrWord_252'
) {
die
RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP036, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Grammar rule '
. (
ref
$property_name
) .
' found where VarOrLitOrOpStrOrWord_252 expected, object property value initialization hashref must contain normal key/value pairs only, dying'
) .
"\n"
;
}
$property_name
=
$property_name
->{children}->[0];
if
( (
ref
$property_name
) ne
'OpStringOrWord_279'
) {
die
RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP037, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Grammar rule '
. (
ref
$property_name
) .
' found where OpStringOrWord_279 expected, object property value initialization hashref must contain bareword keys only, dying'
) .
"\n"
;
}
$property_name
=
$property_name
->{children}->[0];
if
(
exists
$property_type_inner_optional
->{children}->[0] ) {
die
RPerl::Parser::rperl_rule__replace(
'ERROR ECOGEASCP038, CODE GENERATOR, ABSTRACT SYNTAX TO C++: Object property initialization, hashref entry for property name '
.
q{'}
.
$property_name
.
q{'}
.
' has inner type when it should have no inner type, dying'
) .
"\n"
;
}
$cpp_source_group
->{CPP_name} =
$property_name
;
$cpp_source_subgroup
=
$property_value
->ast_to_cpp__generate__CPPOPS_CPPTYPES(
$modes
);
$cpp_source_group
->{CPP_value} =
$cpp_source_subgroup
->{CPP};
return
$cpp_source_group
;
}
1;