From: Dietmar Maurer Date: Wed, 11 May 2016 07:28:09 +0000 (+0200) Subject: remove PodParser.pm, implement keyAlias feature X-Git-Url: https://git.proxmox.com/?p=pve-common.git;a=commitdiff_plain;h=bf27456b4e6f7da0e75331e88a8bd70d6281c9c6 remove PodParser.pm, implement keyAlias feature The keyAlias feature replaces the previous 'group_ feature. --- diff --git a/src/Makefile b/src/Makefile index 92a323d..a07e2e4 100644 --- a/src/Makefile +++ b/src/Makefile @@ -11,7 +11,6 @@ LIB_SOURCES= \ SectionConfig.pm \ Network.pm \ ProcFSTools.pm \ - PodParser.pm \ CLIHandler.pm \ RESTHandler.pm \ JSONSchema.pm \ diff --git a/src/PVE/CLIHandler.pm b/src/PVE/CLIHandler.pm index b684ca8..0e7f202 100644 --- a/src/PVE/CLIHandler.pm +++ b/src/PVE/CLIHandler.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 [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; diff --git a/src/PVE/JSONSchema.pm b/src/PVE/JSONSchema.pm index cde941e..f731856 100644 --- a/src/PVE/JSONSchema.pm +++ b/src/PVE/JSONSchema.pm @@ -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 .= ''; + } elsif ($phash->{type} eq 'number') { + $typetext .= ''; + } 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; diff --git a/src/PVE/PodParser.pm b/src/PVE/PodParser.pm deleted file mode 100644 index 4f2868a..0000000 --- a/src/PVE/PodParser.pm +++ /dev/null @@ -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 -}; - -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; diff --git a/src/PVE/RESTHandler.pm b/src/PVE/RESTHandler.pm index 93abe84..3b95114 100644 --- a/src/PVE/RESTHandler.pm +++ b/src/PVE/RESTHandler.pm @@ -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 = '';