mirror of
https://git.proxmox.com/git/pve-common
synced 2025-08-04 15:47:37 +00:00
remove PodParser.pm, implement keyAlias feature
The keyAlias feature replaces the previous 'group_ feature.
This commit is contained in:
Dietmar Maurer
parent
457c3fcb1e
commit
bf27456b4e
@ -11,7 +11,6 @@ LIB_SOURCES= \
|
||||
SectionConfig.pm \
|
||||
Network.pm \
|
||||
ProcFSTools.pm \
|
||||
PodParser.pm \
|
||||
CLIHandler.pm \
|
||||
RESTHandler.pm \
|
||||
JSONSchema.pm \
|
||||
|
||||
@ -7,7 +7,6 @@ use Data::Dumper;
|
||||
use PVE::SafeSyslog;
|
||||
use PVE::Exception qw(raise raise_param_exc);
|
||||
use PVE::RESTHandler;
|
||||
use PVE::PodParser;
|
||||
use PVE::INotify;
|
||||
|
||||
use base qw(PVE::RESTHandler);
|
||||
@ -157,60 +156,6 @@ sub print_asciidoc_synopsys {
|
||||
return $synopsis;
|
||||
}
|
||||
|
||||
sub print_simple_pod_manpage {
|
||||
my ($podfn, $class, $name, $arg_param, $uri_param) = @_;
|
||||
|
||||
die "not initialized" if !$cli_handler_class;
|
||||
|
||||
my $pwcallback = $cli_handler_class->can('read_password');
|
||||
my $stringfilemap = $cli_handler_class->can('string_param_file_mapping');
|
||||
|
||||
my $synopsis = " $name help\n\n";
|
||||
my $str = $class->usage_str($name, $name, $arg_param, $uri_param, 'long', $pwcallback, $stringfilemap);
|
||||
$str =~ s/^USAGE://;
|
||||
$str =~ s/\n/\n /g;
|
||||
$synopsis .= $str;
|
||||
|
||||
my $parser = PVE::PodParser->new();
|
||||
$parser->{include}->{synopsis} = $synopsis;
|
||||
$parser->parse_from_file($podfn);
|
||||
}
|
||||
|
||||
sub print_pod_manpage {
|
||||
my ($podfn) = @_;
|
||||
|
||||
die "not initialized" if !($cmddef && $exename && $cli_handler_class);
|
||||
die "no pod file specified" if !$podfn;
|
||||
|
||||
my $pwcallback = $cli_handler_class->can('read_password');
|
||||
my $stringfilemap = $cli_handler_class->can('string_param_file_mapping');
|
||||
|
||||
my $synopsis = "";
|
||||
|
||||
$synopsis .= " $exename <COMMAND> [ARGS] [OPTIONS]\n\n";
|
||||
|
||||
my $style = 'full'; # or should we use 'short'?
|
||||
my $oldclass;
|
||||
foreach my $cmd (sorted_commands()) {
|
||||
my ($class, $name, $arg_param, $uri_param) = @{$cmddef->{$cmd}};
|
||||
my $str = $class->usage_str($name, "$exename $cmd", $arg_param,
|
||||
$uri_param, $style, $pwcallback,
|
||||
$stringfilemap);
|
||||
$str =~ s/^USAGE: //;
|
||||
|
||||
$synopsis .= "\n" if $oldclass && $oldclass ne $class;
|
||||
$str =~ s/\n/\n /g;
|
||||
$synopsis .= " $str\n\n";
|
||||
$oldclass = $class;
|
||||
}
|
||||
|
||||
$synopsis .= "\n";
|
||||
|
||||
my $parser = PVE::PodParser->new();
|
||||
$parser->{include}->{synopsis} = $synopsis;
|
||||
$parser->parse_from_file($podfn);
|
||||
}
|
||||
|
||||
sub print_usage_verbose {
|
||||
|
||||
die "not initialized" if !($cmddef && $exename && $cli_handler_class);
|
||||
@ -416,31 +361,6 @@ sub find_cli_class_source {
|
||||
return $filename;
|
||||
}
|
||||
|
||||
sub generate_pod_manpage {
|
||||
my ($class, $podfn) = @_;
|
||||
|
||||
$cli_handler_class = $class;
|
||||
|
||||
$exename = &$get_exe_name($class);
|
||||
|
||||
$podfn = find_cli_class_source($exename) if !defined($podfn);
|
||||
|
||||
die "unable to find source for class '$class'" if !$podfn;
|
||||
|
||||
no strict 'refs';
|
||||
my $def = ${"${class}::cmddef"};
|
||||
|
||||
if (ref($def) eq 'ARRAY') {
|
||||
print_simple_pod_manpage($podfn, @$def);
|
||||
} else {
|
||||
$cmddef = $def;
|
||||
|
||||
$cmddef->{help} = [ __PACKAGE__, 'help', ['cmd'] ];
|
||||
|
||||
print_pod_manpage($podfn);
|
||||
}
|
||||
}
|
||||
|
||||
sub generate_asciidoc_synopsys {
|
||||
my ($class) = @_;
|
||||
|
||||
@ -463,7 +383,7 @@ sub generate_asciidoc_synopsys {
|
||||
}
|
||||
|
||||
my $handle_cmd = sub {
|
||||
my ($def, $cmdname, $cmd, $args, $pwcallback, $podfn, $preparefunc, $stringfilemap) = @_;
|
||||
my ($def, $cmdname, $cmd, $args, $pwcallback, $preparefunc, $stringfilemap) = @_;
|
||||
|
||||
$cmddef = $def;
|
||||
$exename = $cmdname;
|
||||
@ -476,10 +396,6 @@ my $handle_cmd = sub {
|
||||
} elsif ($cmd eq 'verifyapi') {
|
||||
PVE::RESTHandler::validate_method_schemas();
|
||||
return;
|
||||
} elsif ($cmd eq 'printmanpod') {
|
||||
$podfn = find_cli_class_source($exename) if !defined($podfn);
|
||||
print_pod_manpage($podfn);
|
||||
return;
|
||||
} elsif ($cmd eq 'bashcomplete') {
|
||||
&$print_bash_completion($cmddef, 0, @$args);
|
||||
return;
|
||||
@ -503,7 +419,7 @@ my $handle_cmd = sub {
|
||||
};
|
||||
|
||||
my $handle_simple_cmd = sub {
|
||||
my ($def, $args, $pwcallback, $podfn, $preparefunc, $stringfilemap) = @_;
|
||||
my ($def, $args, $pwcallback, $preparefunc, $stringfilemap) = @_;
|
||||
|
||||
my ($class, $name, $arg_param, $uri_param, $outsub) = @{$def};
|
||||
die "no class specified" if !$class;
|
||||
@ -521,10 +437,6 @@ my $handle_simple_cmd = sub {
|
||||
} elsif ($args->[0] eq 'verifyapi') {
|
||||
PVE::RESTHandler::validate_method_schemas();
|
||||
return;
|
||||
} elsif ($args->[0] eq 'printmanpod') {
|
||||
$podfn = find_cli_class_source($name) if !defined($podfn);
|
||||
print_simple_pod_manpage($podfn, @$def);
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
@ -538,11 +450,7 @@ my $handle_simple_cmd = sub {
|
||||
sub run_cli {
|
||||
my ($class, $pwcallback, $podfn, $preparefunc) = @_;
|
||||
|
||||
# Note: "depreciated function run_cli - use run_cli_handler instead";
|
||||
|
||||
die "password callback is no longer supported" if $pwcallback;
|
||||
|
||||
run_cli_handler($class, podfn => $podfn, prepare => $preparefunc);
|
||||
die "depreciated function run_cli - use run_cli_handler instead";
|
||||
}
|
||||
|
||||
sub run_cli_handler {
|
||||
@ -553,13 +461,11 @@ sub run_cli_handler {
|
||||
$ENV{'PATH'} = '/sbin:/bin:/usr/sbin:/usr/bin';
|
||||
|
||||
foreach my $key (keys %params) {
|
||||
next if $key eq 'podfn';
|
||||
next if $key eq 'prepare';
|
||||
next if $key eq 'no_init'; # used by lxc hooks
|
||||
die "unknown parameter '$key'";
|
||||
}
|
||||
|
||||
my $podfn = $params{podfn};
|
||||
my $preparefunc = $params{prepare};
|
||||
my $no_init = $params{no_init};
|
||||
|
||||
@ -585,11 +491,11 @@ sub run_cli_handler {
|
||||
my $def = ${"${class}::cmddef"};
|
||||
|
||||
if (ref($def) eq 'ARRAY') {
|
||||
&$handle_simple_cmd($def, \@ARGV, $pwcallback, $podfn, $preparefunc, $stringfilemap);
|
||||
&$handle_simple_cmd($def, \@ARGV, $pwcallback, $preparefunc, $stringfilemap);
|
||||
} else {
|
||||
$cmddef = $def;
|
||||
my $cmd = shift @ARGV;
|
||||
&$handle_cmd($cmddef, $exename, $cmd, \@ARGV, $pwcallback, $podfn, $preparefunc, $stringfilemap);
|
||||
&$handle_cmd($cmddef, $exename, $cmd, \@ARGV, $pwcallback, $preparefunc, $stringfilemap);
|
||||
}
|
||||
|
||||
exit 0;
|
||||
|
||||
@ -9,6 +9,7 @@ use PVE::Tools qw(split_list $IPV6RE $IPV4RE);
|
||||
use PVE::Exception qw(raise);
|
||||
use HTTP::Status qw(:constants);
|
||||
use Net::IP qw(:PROC);
|
||||
use Data::Dumper;
|
||||
|
||||
use base 'Exporter';
|
||||
|
||||
@ -513,16 +514,15 @@ sub parse_property_string {
|
||||
my ($k, $v) = ($1, $2);
|
||||
die "duplicate key in comma-separated list property: $k\n" if defined($res->{$k});
|
||||
my $schema = $format->{$k};
|
||||
if (my $group = $schema->{group}) {
|
||||
die "keys $res->{$group} and $k are part of the same group and cannot be used together\n"
|
||||
if defined($res->{$group});
|
||||
$res->{$group} = $k;
|
||||
$schema = $format->{$group};
|
||||
}
|
||||
if (my $alias = $schema->{alias}) {
|
||||
if (my $key_alias = $schema->{keyAlias}) {
|
||||
die "key alias '$key_alias' is already defined\n" if defined($res->{$key_alias});
|
||||
$res->{$key_alias} = $k;
|
||||
}
|
||||
$k = $alias;
|
||||
$schema = $format->{$k};
|
||||
}
|
||||
|
||||
die "invalid key in comma-separated list property: $k\n" if !$schema;
|
||||
if ($schema->{type} && $schema->{type} eq 'boolean') {
|
||||
$v = 1 if $v =~ m/^(1|on|yes|true)$/i;
|
||||
@ -556,91 +556,6 @@ sub parse_property_string {
|
||||
return $res;
|
||||
}
|
||||
|
||||
sub print_property_string {
|
||||
my ($data, $format, $skip, $path) = @_;
|
||||
|
||||
if (ref($format) ne 'HASH') {
|
||||
my $schema = $format_list->{$format};
|
||||
die "not a valid format: $format\n" if !$schema;
|
||||
$format = $schema;
|
||||
}
|
||||
|
||||
my $errors = {};
|
||||
check_object($path, $format, $data, undef, $errors);
|
||||
if (scalar(%$errors)) {
|
||||
raise "format error", errors => $errors;
|
||||
}
|
||||
|
||||
my $default_key;
|
||||
my %skipped = map { $_ => 1 } @$skip;
|
||||
my %allowed;
|
||||
my %required; # this is a set, all present keys are required regardless of value
|
||||
my %group_for_key;
|
||||
foreach my $key (keys %$format) {
|
||||
$allowed{$key} = 1;
|
||||
my $keyfmt = $format->{$key};
|
||||
my $group = $keyfmt->{group};
|
||||
if (defined($group)) {
|
||||
$skipped{$group} = 1;
|
||||
if (defined(my $grpalias = $format->{$group}->{alias})) {
|
||||
$group_for_key{$grpalias} = $group;
|
||||
} else {
|
||||
$group_for_key{$key} = $group;
|
||||
}
|
||||
}
|
||||
if (!$keyfmt->{optional} && !$keyfmt->{alias} && !defined($group) && !$skipped{$key}) {
|
||||
$required{$key} = 1;
|
||||
}
|
||||
|
||||
# Skip default keys
|
||||
if ($keyfmt->{default_key}) {
|
||||
if ($default_key) {
|
||||
warn "multiple default keys in schema ($default_key, $key)\n";
|
||||
} else {
|
||||
$default_key = $key;
|
||||
$skipped{$key} = 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
my ($text, $comma);
|
||||
if ($default_key && !defined($format->{$default_key}->{alias})) {
|
||||
$text = "$data->{$default_key}";
|
||||
$comma = ',';
|
||||
} else {
|
||||
$text = '';
|
||||
$comma = '';
|
||||
}
|
||||
|
||||
foreach my $key (sort keys %$data) {
|
||||
delete $required{$key};
|
||||
next if $skipped{$key};
|
||||
die "invalid key: $key\n" if !$allowed{$key};
|
||||
|
||||
my $keyfmt = $format->{$key};
|
||||
my $typeformat = $keyfmt->{format};
|
||||
my $value = $data->{$key};
|
||||
next if !defined($value);
|
||||
if (my $group = $group_for_key{$key}) {
|
||||
$key = $data->{$group};
|
||||
}
|
||||
$text .= $comma;
|
||||
$comma = ',';
|
||||
if ($typeformat && $typeformat eq 'disk-size') {
|
||||
$text .= "$key=" . format_size($value);
|
||||
} else {
|
||||
die "illegal value with commas for $key\n" if $value =~ /,/;
|
||||
$text .= "$key=$value";
|
||||
}
|
||||
}
|
||||
|
||||
if (my $missing = join(',', keys %required)) {
|
||||
die "missing properties: $missing\n";
|
||||
}
|
||||
|
||||
return $text;
|
||||
}
|
||||
|
||||
sub add_error {
|
||||
my ($errors, $path, $msg) = @_;
|
||||
|
||||
@ -785,31 +700,8 @@ sub check_object {
|
||||
return;
|
||||
}
|
||||
|
||||
my %groups;
|
||||
foreach my $k (keys %$schema) {
|
||||
if (defined(my $group = $schema->{$k}->{group})) {
|
||||
# When a group is aliased then the key/value pair will match the
|
||||
# schema, but if it's not then the group key contains the key-name
|
||||
# which will not match the group key's defined schema and we have
|
||||
# to match it against that...
|
||||
if (!defined($schema->{$group}->{alias})) {
|
||||
$groups{$group} = 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
foreach my $k (keys %$schema) {
|
||||
my $orig_key = $k;
|
||||
my $v;
|
||||
if ($groups{$k}) {
|
||||
if (defined($orig_key = $value->{$k})) {
|
||||
$v = $value->{$orig_key};
|
||||
} else {
|
||||
$orig_key = $k; # now only used for the 'path' parameter
|
||||
}
|
||||
} else {
|
||||
$v = $value->{$k};
|
||||
}
|
||||
check_prop($v, $schema->{$k}, $path ? "$path.$orig_key" : $orig_key, $errors);
|
||||
check_prop($value->{$k}, $schema->{$k}, $path ? "$path.$k" : $k, $errors);
|
||||
}
|
||||
|
||||
foreach my $k (keys %$value) {
|
||||
@ -1116,10 +1008,11 @@ my $default_schema_noref = {
|
||||
optional => 1,
|
||||
description => "When a key represents the same property as another it can be an alias to it, causing the parsed datastructure to use the other key to store the current value under.",
|
||||
},
|
||||
group => {
|
||||
keyAlias => {
|
||||
type => 'string',
|
||||
optional => 1,
|
||||
description => "If a key is part of a group then setting it will additionally set the group name in the resulting data structure to the key used to fill the group. Only one key of a group can be assigned.",
|
||||
description => "Allows to store the current 'key' as value of another property. Only valid if used together with 'alias'.",
|
||||
requires => 'alias',
|
||||
},
|
||||
default => {
|
||||
type => "any",
|
||||
@ -1536,4 +1429,231 @@ sub dump_config {
|
||||
return $data;
|
||||
}
|
||||
|
||||
# helpers used to generate our manual pages
|
||||
|
||||
my $find_schema_default_key = sub {
|
||||
my ($format) = @_;
|
||||
|
||||
my $default_key;
|
||||
my $keyAliasProps = {};
|
||||
|
||||
foreach my $key (keys %$format) {
|
||||
my $phash = $format->{$key};
|
||||
if ($phash->{default_key}) {
|
||||
die "multiple default keys in schema ($default_key, $key)\n"
|
||||
if defined($default_key);
|
||||
die "default key '$key' is an alias - this is not allowed\n"
|
||||
if defined($phash->{alias});
|
||||
die "default key '$key' with keyAlias attribute is not allowed\n"
|
||||
if $phash->{keyAlias};
|
||||
|
||||
$default_key = $key;
|
||||
}
|
||||
my $key_alias = $phash->{keyAlias};
|
||||
if ($phash->{alias} && $key_alias) {
|
||||
die "inconsistent keyAlias '$key_alias' definition"
|
||||
if defined($keyAliasProps->{$key_alias}) &&
|
||||
$keyAliasProps->{$key_alias} ne $phash->{alias};
|
||||
$keyAliasProps->{$key_alias} = $phash->{alias};
|
||||
}
|
||||
}
|
||||
|
||||
return wantarray ? ($default_key, $keyAliasProps) : $default_key;
|
||||
};
|
||||
|
||||
sub generate_typetext {
|
||||
my ($format) = @_;
|
||||
|
||||
my $default_key = &$find_schema_default_key($format);
|
||||
|
||||
my $res = '';
|
||||
my $add_sep = 0;
|
||||
|
||||
my $add_option_string = sub {
|
||||
my ($text, $optional) = @_;
|
||||
|
||||
if ($add_sep) {
|
||||
$text = ",$text";
|
||||
$res .= ' ';
|
||||
}
|
||||
$text = "[$text]" if $optional;
|
||||
$res .= $text;
|
||||
$add_sep = 1;
|
||||
};
|
||||
|
||||
my $format_key_value = sub {
|
||||
my ($key, $phash) = @_;
|
||||
|
||||
die "internal error" if defined($phash->{alias});
|
||||
|
||||
my $keytext = $key;
|
||||
|
||||
my $typetext = '';
|
||||
|
||||
if (my $desc = $phash->{format_description}) {
|
||||
$typetext .= "<$desc>";
|
||||
} elsif (my $text = $phash->{typetext}) {
|
||||
$typetext .= $text;
|
||||
} elsif (my $enum = $phash->{enum}) {
|
||||
$typetext .= '<' . join('|', @$enum) . '>';
|
||||
} elsif ($phash->{type} eq 'boolean') {
|
||||
$typetext .= '<1|0>';
|
||||
} elsif ($phash->{type} eq 'integer') {
|
||||
$typetext .= '<integer>';
|
||||
} elsif ($phash->{type} eq 'number') {
|
||||
$typetext .= '<number>';
|
||||
} else {
|
||||
die "internal error: neither format_description nor typetext found for option '$key'";
|
||||
}
|
||||
|
||||
if (defined($default_key) && ($default_key eq $key)) {
|
||||
&$add_option_string("[$keytext=]$typetext", $phash->{optional});
|
||||
} else {
|
||||
&$add_option_string("$keytext=$typetext", $phash->{optional});
|
||||
}
|
||||
};
|
||||
|
||||
if (defined($default_key)) {
|
||||
my $phash = $format->{$default_key};
|
||||
&$format_key_value($default_key, $phash);
|
||||
}
|
||||
|
||||
foreach my $key (sort keys %$format) {
|
||||
next if defined($default_key) && ($key eq $default_key);
|
||||
|
||||
my $phash = $format->{$key};
|
||||
|
||||
next if $phash->{alias};
|
||||
next if $phash->{group};
|
||||
|
||||
&$format_key_value($key, $phash);
|
||||
|
||||
if (my $keyAlias = $phash->{keyAlias}) {
|
||||
&$add_option_string("<$keyAlias>=<$key>", 1);
|
||||
}
|
||||
}
|
||||
|
||||
return $res;
|
||||
}
|
||||
|
||||
sub print_property_string {
|
||||
my ($data, $format, $skip, $path) = @_;
|
||||
|
||||
if (ref($format) ne 'HASH') {
|
||||
my $schema = get_format($format);
|
||||
die "not a valid format: $format\n" if !$schema;
|
||||
$format = $schema;
|
||||
}
|
||||
|
||||
my $errors = {};
|
||||
check_object($path, $format, $data, undef, $errors);
|
||||
if (scalar(%$errors)) {
|
||||
raise "format error", errors => $errors;
|
||||
}
|
||||
|
||||
my ($default_key, $keyAliasProps) = &$find_schema_default_key($format);
|
||||
|
||||
my $res = '';
|
||||
my $add_sep = 0;
|
||||
|
||||
my $add_option_string = sub {
|
||||
my ($text) = @_;
|
||||
|
||||
$res .= ',' if $add_sep;
|
||||
$res .= $text;
|
||||
$add_sep = 1;
|
||||
};
|
||||
|
||||
my $format_value = sub {
|
||||
my ($key, $value, $format) = @_;
|
||||
|
||||
if (defined($format) && ($format eq 'disk-size')) {
|
||||
return format_size($value);
|
||||
} else {
|
||||
die "illegal value with commas for $key\n" if $value =~ /,/;
|
||||
return $value;
|
||||
}
|
||||
};
|
||||
|
||||
my $done = {};
|
||||
|
||||
my $cond_add_key = sub {
|
||||
my ($key) = @_;
|
||||
|
||||
return if $done->{$key}; # avoid duplicates
|
||||
|
||||
$done->{$key} = 1;
|
||||
|
||||
my $value = $data->{$key};
|
||||
|
||||
return if !defined($value);
|
||||
|
||||
my $phash = $format->{$key};
|
||||
|
||||
# try to combine values if we have key aliases
|
||||
if (my $combine = $keyAliasProps->{$key}) {
|
||||
if (defined(my $combine_value = $data->{$combine})) {
|
||||
my $combine_format = $format->{$combine}->{format};
|
||||
my $value_str = &$format_value($key, $value, $phash->{format});
|
||||
my $combine_str = &$format_value($combine, $combine_value, $combine_format);
|
||||
&$add_option_string("${value_str}=${combine_str}");
|
||||
$done->{$combine} = 1;
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
if ($phash && $phash->{alias}) {
|
||||
$phash = $format->{$phash->{alias}};
|
||||
}
|
||||
|
||||
die "invalid key '$key'\n" if !$phash;
|
||||
die "internal error" if defined($phash->{alias});
|
||||
|
||||
my $value_str = &$format_value($key, $value, $phash->{format});
|
||||
&$add_option_string("$key=${value_str}");
|
||||
};
|
||||
|
||||
# add default key first
|
||||
&$cond_add_key($default_key) if defined($default_key);
|
||||
|
||||
foreach my $key (sort keys %$data) {
|
||||
&$cond_add_key($key);
|
||||
}
|
||||
|
||||
return $res;
|
||||
}
|
||||
|
||||
sub schema_get_type_text {
|
||||
my ($phash) = @_;
|
||||
|
||||
if ($phash->{typetext}) {
|
||||
return $phash->{typetext};
|
||||
} elsif ($phash->{format_description}) {
|
||||
return "<$phash->{format_description}>";
|
||||
} elsif ($phash->{enum}) {
|
||||
return "(" . join(' | ', sort @{$phash->{enum}}) . ")";
|
||||
} elsif ($phash->{pattern}) {
|
||||
return $phash->{pattern};
|
||||
} elsif ($phash->{type} eq 'integer' || $phash->{type} eq 'number') {
|
||||
if (defined($phash->{minimum}) && defined($phash->{maximum})) {
|
||||
return "$phash->{type} ($phash->{minimum} - $phash->{maximum})";
|
||||
} elsif (defined($phash->{minimum})) {
|
||||
return "$phash->{type} ($phash->{minimum} - N)";
|
||||
} elsif (defined($phash->{maximum})) {
|
||||
return "$phash->{type} (-N - $phash->{maximum})";
|
||||
}
|
||||
} elsif ($phash->{type} eq 'string') {
|
||||
if (my $format = $phash->{format}) {
|
||||
$format = get_format($format) if ref($format) ne 'HASH';
|
||||
if (ref($format) eq 'HASH') {
|
||||
return generate_typetext($format);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
my $type = $phash->{type} || 'string';
|
||||
|
||||
return $type;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
@ -1,195 +0,0 @@
|
||||
package PVE::PodParser;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Pod::Parser;
|
||||
use base qw(Pod::Parser);
|
||||
|
||||
my $currentYear = (localtime(time))[5] + 1900;
|
||||
|
||||
my $stdinclude = {
|
||||
pve_copyright => <<EODATA,
|
||||
\=head1 COPYRIGHT AND DISCLAIMER
|
||||
|
||||
Copyright (C) 2007-$currentYear Proxmox Server Solutions GmbH
|
||||
|
||||
This program is free software: you can redistribute it and\/or modify
|
||||
it under the terms of the GNU Affero General Public License as
|
||||
published by the Free Software Foundation, either version 3 of the
|
||||
License, or (at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU Affero General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU Affero General Public License
|
||||
along with this program. If not, see L<http://www.gnu.org/licenses/>.
|
||||
EODATA
|
||||
};
|
||||
|
||||
sub command {
|
||||
my ($self, $cmd, $text, $line_num, $pod_para) = @_;
|
||||
|
||||
if (($cmd eq 'include' && $text =~ m/^\s*(\S+)\s/)) {
|
||||
my $incl = $1;
|
||||
my $data = $stdinclude->{$incl} ? $stdinclude->{$incl} :
|
||||
$self->{include}->{$incl};
|
||||
chomp $data;
|
||||
$self->textblock("$data\n\n", $line_num, $pod_para);
|
||||
} else {
|
||||
$self->textblock($pod_para->raw_text(), $line_num, $pod_para);
|
||||
}
|
||||
}
|
||||
|
||||
# helpers used to generate our manual pages
|
||||
|
||||
sub generate_typetext {
|
||||
my ($schema) = @_;
|
||||
my $typetext = '';
|
||||
my (@optional, @required);
|
||||
foreach my $key (sort keys %$schema) {
|
||||
my $entry = $schema->{$key};
|
||||
next if $entry->{alias};
|
||||
next if !$entry->{format_description} &&
|
||||
!$entry->{typetext} &&
|
||||
!$entry->{enum} &&
|
||||
$entry->{type} ne 'boolean';
|
||||
if ($schema->{$key}->{optional}) {
|
||||
push @optional, $key;
|
||||
} else {
|
||||
push @required, $key;
|
||||
}
|
||||
}
|
||||
my ($pre, $post) = ('', '');
|
||||
my $add = sub {
|
||||
my ($key) = @_;
|
||||
$typetext .= $pre;
|
||||
my $entry = $schema->{$key};
|
||||
if (my $alias = $entry->{alias}) {
|
||||
$key = $alias;
|
||||
$entry = $schema->{$key};
|
||||
}
|
||||
if (!defined($entry->{typetext})) {
|
||||
$typetext .= $entry->{default_key} ? "[$key=]" : "$key=";
|
||||
}
|
||||
if (my $desc = $entry->{format_description}) {
|
||||
$typetext .= "<$desc>";
|
||||
} elsif (my $text = $entry->{typetext}) {
|
||||
$typetext .= $text;
|
||||
} elsif (my $enum = $entry->{enum}) {
|
||||
$typetext .= '<' . join('|', @$enum) . '>';
|
||||
} elsif ($entry->{type} eq 'boolean') {
|
||||
$typetext .= '<1|0>';
|
||||
} else {
|
||||
die "internal error: neither format_description nor typetext found";
|
||||
}
|
||||
$typetext .= $post;
|
||||
};
|
||||
foreach my $key (@required) {
|
||||
&$add($key);
|
||||
$pre = ', ';
|
||||
}
|
||||
$pre = $pre ? ' [,' : '[';
|
||||
$post = ']';
|
||||
foreach my $key (@optional) {
|
||||
&$add($key);
|
||||
$pre = ' [,';
|
||||
}
|
||||
return $typetext;
|
||||
}
|
||||
|
||||
sub schema_get_type_text {
|
||||
my ($phash) = @_;
|
||||
|
||||
if ($phash->{typetext}) {
|
||||
return $phash->{typetext};
|
||||
} elsif ($phash->{format_description}) {
|
||||
return "<$phash->{format_description}>";
|
||||
} elsif ($phash->{enum}) {
|
||||
return "(" . join(' | ', sort @{$phash->{enum}}) . ")";
|
||||
} elsif ($phash->{pattern}) {
|
||||
return $phash->{pattern};
|
||||
} elsif ($phash->{type} eq 'integer' || $phash->{type} eq 'number') {
|
||||
if (defined($phash->{minimum}) && defined($phash->{maximum})) {
|
||||
return "$phash->{type} ($phash->{minimum} - $phash->{maximum})";
|
||||
} elsif (defined($phash->{minimum})) {
|
||||
return "$phash->{type} ($phash->{minimum} - N)";
|
||||
} elsif (defined($phash->{maximum})) {
|
||||
return "$phash->{type} (-N - $phash->{maximum})";
|
||||
}
|
||||
} elsif ($phash->{type} eq 'string') {
|
||||
if (my $format = $phash->{format}) {
|
||||
$format = PVE::JSONSchema::get_format($format) if ref($format) ne 'HASH';
|
||||
if (ref($format) eq 'HASH') {
|
||||
return generate_typetext($format);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
my $type = $phash->{type} || 'string';
|
||||
|
||||
return $type;
|
||||
}
|
||||
|
||||
sub generate_property_text {
|
||||
my ($schema) = @_;
|
||||
my $data = '';
|
||||
foreach my $key (sort keys %$schema) {
|
||||
my $d = $schema->{$key};
|
||||
next if $d->{alias};
|
||||
my $desc = $d->{description};
|
||||
my $typetext = schema_get_type_text($d);
|
||||
$desc = 'No description available' if !$desc;
|
||||
$data .= "=item $key: $typetext\n\n$desc\n\n";
|
||||
}
|
||||
return $data;
|
||||
}
|
||||
|
||||
# generate pod from JSON schema properties
|
||||
sub dump_properties {
|
||||
my ($properties) = @_;
|
||||
|
||||
my $data = "=over 1\n\n";
|
||||
|
||||
my $idx_param = {}; # -vlan\d+ -scsi\d+
|
||||
|
||||
foreach my $key (sort keys %$properties) {
|
||||
my $d = $properties->{$key};
|
||||
my $base = $key;
|
||||
if ($key =~ m/^([a-z]+)(\d+)$/) {
|
||||
my $name = $1;
|
||||
next if $idx_param->{$name};
|
||||
$idx_param->{$name} = 1;
|
||||
$base = "${name}[n]";
|
||||
}
|
||||
|
||||
my $descr = $d->{description} || 'No description avalable.';
|
||||
chomp $descr;
|
||||
|
||||
if (defined(my $dv = $d->{default})) {
|
||||
my $multi = $descr =~ m/\n\n/; # multi paragraph ?
|
||||
$descr .= $multi ? "\n\n" : " ";
|
||||
$descr .= "Default value is '$dv'.";
|
||||
}
|
||||
|
||||
my $typetext = schema_get_type_text($d);
|
||||
$data .= "=item $base: $typetext\n\n";
|
||||
$data .= "$descr\n\n";
|
||||
|
||||
if ($d->{type} eq 'string') {
|
||||
my $format = $d->{format};
|
||||
if ($format && ref($format) eq 'HASH') {
|
||||
$data .= "=over 1.1\n\n";
|
||||
$data .= generate_property_text($format);
|
||||
$data .= "=back\n\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
$data .= "=back";
|
||||
|
||||
return $data;
|
||||
}
|
||||
|
||||
1;
|
||||
@ -6,7 +6,6 @@ use warnings;
|
||||
use PVE::SafeSyslog;
|
||||
use PVE::Exception qw(raise raise_param_exc);
|
||||
use PVE::JSONSchema;
|
||||
use PVE::PodParser;
|
||||
use HTTP::Status qw(:constants :is status_message);
|
||||
use Text::Wrap;
|
||||
use Clone qw(clone);
|
||||
@ -421,7 +420,7 @@ my $get_property_description = sub {
|
||||
|
||||
chomp $descr;
|
||||
|
||||
my $type = PVE::PodParser::schema_get_type_text($phash);
|
||||
my $type = PVE::JSONSchema::schema_get_type_text($phash);
|
||||
|
||||
if ($hidepw && $name eq 'password') {
|
||||
$type = '';
|
||||
|
||||
Loading…
Reference in New Issue
Block a user