$Net::FreeIPA::Convert::VERSION
=
'0.0.6'
;
Readonly::Hash
my
%CONVERT_DISPATCH
=> {
str
=>
sub
{
my
$val
=
shift
;
return
"$val"
;},
int
=>
sub
{
my
$val
=
shift
;
return
0 +
$val
;},
float
=>
sub
{
my
$val
=
shift
;
return
1.0 *
$val
;},
bool
=>
sub
{
my
$val
=
shift
;
return
$val
? Types::Serialiser::true : Types::Serialiser::false;},
};
Readonly::Hash
my
%CONVERT_ALIAS
=> {
str
=> [
qw(unicode DNSName)
],
};
Readonly
our
$API_METHOD_PREFIX
=>
'api_'
;
Readonly
my
$API_RPC_OPTION_PATTERN
=>
'^__'
;
sub
rpc_api
{
my
(
$self
,
$command
,
$args
,
$args_names
,
$args_types
,
$opts
,
$opts_keys
,
$opts_types
) =
@_
;
my
$method
=
"$API_METHOD_PREFIX$command"
;
my
$aidx
= 0;
my
@new_args
;
foreach
my
$arg
(
@$args
) {
$aidx
+= 1;
my
$args_name
=
shift
(
@$args_names
);
my
$emsg
=
"$method: mandatory $aidx-th argument $args_name"
;
if
(
defined
(
$arg
)) {
my
$cargs
=
$self
->check_type(
$arg
,
shift
(
@$args_types
),
$emsg
);
if
(
$cargs
) {
push
(
@new_args
,
$self
->convert(
@$cargs
));
}
else
{
return
;
}
}
else
{
$self
->error(
"$emsg undefined"
);
return
;
};
};
my
%opts_types_map
;
@opts_types_map
{
@$opts_keys
} =
@$opts_types
;
my
%new_opts
;
my
%rpc_opts
;
foreach
my
$key
(
sort
keys
%$opts
) {
my
$emsg
=
"$method: not a valid option key: $key"
;
if
(
$key
=~ m/
$API_RPC_OPTION_PATTERN
/) {
my
$val
=
$opts
->{
$key
};
$key
=~ s/
$API_RPC_OPTION_PATTERN
//;
$rpc_opts
{
$key
} =
$val
;
}
else
{
if
(
grep
{
$key
eq
$_
}
@$opts_keys
) {
my
$cargs
=
$self
->check_type(
$opts
->{
$key
},
$opts_types_map
{
$key
},
$emsg
);
if
(
$cargs
) {
$new_opts
{
$key
} =
$self
->convert(
@$cargs
);
}
else
{
return
;
}
}
else
{
$self
->error(
"$emsg (allowed "
.
join
(
","
,
@$opts_keys
).
")"
);
return
;
}
};
}
return
$self
->rpc(
$command
, \
@new_args
, \
%new_opts
,
%rpc_opts
);
}
sub
check_type
{
my
(
$self
,
$value
,
$typedata
,
$emsg
) =
@_
;
my
(
$type
,
$multi
) =
split
(
':'
,
$typedata
);
my
$ref
=
ref
(
$value
);
my
$res
= [
$value
,
$type
];
if
(
$multi
&&
$ref
ne
'ARRAY'
) {
$self
->error(
"$emsg has to be an arrayref (is multivalued)"
);
return
;
}
elsif
((!
$multi
) &&
$ref
ne
''
) {
$self
->error(
"$emsg has to be a scalar (is not multivalued)"
);
return
;
}
return
$res
}
sub
convert
{
my
(
$self
,
$value
,
$type
) =
@_
;
my
$funcref
=
$CONVERT_DISPATCH
{
$type
};
if
(!
defined
(
$funcref
)) {
foreach
my
$tmpref
(
sort
keys
%CONVERT_ALIAS
) {
$funcref
=
$CONVERT_DISPATCH
{
$tmpref
}
if
(
grep
{
$_
eq
$type
} @{
$CONVERT_ALIAS
{
$tmpref
}});
}
};
if
(
defined
(
$funcref
)) {
my
$vref
=
ref
(
$value
);
if
(
$vref
eq
'ARRAY'
) {
return
[
map
{
$funcref
->(
$_
)}
@$value
];
}
elsif
(
$vref
eq
'HASH'
) {
return
{
map
{
$_
=>
$funcref
->(
$value
->{
$_
})}
sort
keys
%$value
};
}
else
{
return
$funcref
->(
$value
);
};
}
else
{
$self
->
warn
(
"No conversion for type $type"
);
return
$value
;
}
}
1;