$Net::FreeIPA::API::Convert::VERSION
=
'3.0.2'
;
our
@EXPORT_OK
=
qw(process_args)
;
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
? JSON::XS::true : JSON::XS::false;},
};
Readonly::Hash
my
%CONVERT_ALIAS
=> {
str
=> [
qw(unicode DNSName)
],
};
Readonly
my
$API_RPC_OPTION_PATTERN
=>
'^__'
;
sub
convert
{
my
(
$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
{
return
$value
;
}
}
sub
check_command
{
my
(
$cmd
,
$value
,
$where
) =
@_
;
my
$errmsg
;
my
$ref
=
ref
(
$value
);
my
$name
=
$cmd
->{name};
my
$mandatory
= (
$cmd
->{required} && (!
$cmd
->{autofill})) ? 1 : 0;
my
$multi
=
$cmd
->{multivalue} ? 1 : 0;
if
(!
defined
(
$value
)) {
if
(
$mandatory
) {
$errmsg
=
"name $name mandatory with undefined value"
;
};
}
elsif
((!
$ref
&& !
$multi
) ||
((
$ref
eq
'ARRAY'
) &&
$multi
) ) {
my
$wref
=
ref
(
$where
);
local
$@;
eval
{
if
(
$wref
eq
'ARRAY'
) {
push
(
@$where
, convert(
$value
,
$cmd
->{type}));
}
elsif
(
$wref
eq
'HASH'
) {
$where
->{
$name
} = convert(
$value
,
$cmd
->{type});
}
else
{
$errmsg
=
"name $name unknown where ref $wref"
;
};
};
$errmsg
=
"name $name where ref $wref died $@"
if
($@);
}
else
{
$errmsg
=
"name $name wrong multivalue (multi $multi, ref $ref)"
;
};
return
$errmsg
;
}
sub
process_args
{
my
(
$cmds
,
@args
) =
@_
;
my
$cmdname
=
$cmds
->{name};
my
$posargs
= [];
my
$opts
= {};
my
$rpc
= {};
my
$errmsg
;
my
$err_req
=
sub
{
$errmsg
=
join
(
" "
,
"$cmdname:"
,
shift
,
$errmsg
);
return
mkrequest(
$cmdname
,
error
=>
$errmsg
);
};
my
$aidx
= 0;
foreach
my
$cmd
(@{
$cmds
->{takes_args} || []}) {
$aidx
+= 1;
$errmsg
= check_command(
$cmd
,
shift
(
@args
),
$posargs
);
return
&$err_req
(
"$aidx-th argument"
)
if
$errmsg
;
}
my
%origopts
=
@args
;
foreach
my
$cmd
(@{
$cmds
->{takes_options} || []}) {
my
$name
=
$cmd
->{name};
$errmsg
= check_command(
$cmd
,
delete
$origopts
{
$name
},
$opts
);
return
&$err_req
(
"option"
)
if
$errmsg
;
}
foreach
my
$name
(
sort
keys
%origopts
) {
if
(
$name
=~ m/
$API_RPC_OPTION_PATTERN
/) {
my
$val
=
$origopts
{
$name
};
$name
=~ s/
$API_RPC_OPTION_PATTERN
//;
$rpc
->{
$name
} =
$val
;
}
else
{
return
&$err_req
(
"option invalid name $name"
);
};
}
return
mkrequest(
$cmdname
,
args
=>
$posargs
,
opts
=>
$opts
,
rpc
=>
$rpc
);
}
1;