generate_typetext: handle enums and booleans automatically
[pve-common.git] / src / PVE / PodParser.pm
1 package PVE::PodParser;
2
3 use strict;
4 use warnings;
5 use Pod::Parser;
6 use base qw(Pod::Parser);
7
8 my $currentYear = (localtime(time))[5] + 1900;
9
10 my $stdinclude = {
11 pve_copyright => <<EODATA,
12 \=head1 COPYRIGHT AND DISCLAIMER
13
14 Copyright (C) 2007-$currentYear Proxmox Server Solutions GmbH
15
16 This program is free software: you can redistribute it and\/or modify
17 it under the terms of the GNU Affero General Public License as
18 published by the Free Software Foundation, either version 3 of the
19 License, or (at your option) any later version.
20
21 This program is distributed in the hope that it will be useful,
22 but WITHOUT ANY WARRANTY; without even the implied warranty of
23 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 GNU Affero General Public License for more details.
25
26 You should have received a copy of the GNU Affero General Public License
27 along with this program. If not, see L<http://www.gnu.org/licenses/>.
28 EODATA
29 };
30
31 sub command {
32 my ($self, $cmd, $text, $line_num, $pod_para) = @_;
33
34 if (($cmd eq 'include' && $text =~ m/^\s*(\S+)\s/)) {
35 my $incl = $1;
36 my $data = $stdinclude->{$incl} ? $stdinclude->{$incl} :
37 $self->{include}->{$incl};
38 chomp $data;
39 $self->textblock("$data\n\n", $line_num, $pod_para);
40 } else {
41 $self->textblock($pod_para->raw_text(), $line_num, $pod_para);
42 }
43 }
44
45 # helpers used to generate our manual pages
46
47 sub generate_typetext {
48 my ($schema) = @_;
49 my $typetext = '';
50 my (@optional, @required);
51 foreach my $key (sort keys %$schema) {
52 my $entry = $schema->{$key};
53 next if !$entry->{format_description} &&
54 !$entry->{typetext} &&
55 !$entry->{enum} &&
56 $entry->{type} ne 'boolean';
57 if ($schema->{$key}->{optional}) {
58 push @optional, $key;
59 } else {
60 push @required, $key;
61 }
62 }
63 my ($pre, $post) = ('', '');
64 my $add = sub {
65 my ($key) = @_;
66 $typetext .= $pre;
67 my $entry = $schema->{$key};
68 if (my $alias = $entry->{alias}) {
69 $key = $alias;
70 $entry = $schema->{$key};
71 }
72 if (!defined($entry->{typetext})) {
73 $typetext .= $entry->{default_key} ? "[$key=]" : "$key=";
74 }
75 if (my $desc = $entry->{format_description}) {
76 $typetext .= "<$desc>";
77 } elsif (my $text = $entry->{typetext}) {
78 $typetext .= $text;
79 } elsif (my $enum = $entry->{enum}) {
80 $typetext .= '<' . join('|', @$enum) . '>';
81 } elsif ($entry->{type} eq 'boolean') {
82 $typetext .= '<1|0>';
83 } else {
84 die "internal error: neither format_description nor typetext found";
85 }
86 $typetext .= $post;
87 };
88 foreach my $key (@required) {
89 &$add($key);
90 $pre = ', ';
91 }
92 $pre = $pre ? ' [,' : '[';
93 $post = ']';
94 foreach my $key (@optional) {
95 &$add($key);
96 $pre = ' [,';
97 }
98 return $typetext;
99 }
100
101 sub schema_get_type_text {
102 my ($phash) = @_;
103
104 if ($phash->{typetext}) {
105 return $phash->{typetext};
106 } elsif ($phash->{enum}) {
107 return "(" . join(' | ', sort @{$phash->{enum}}) . ")";
108 } elsif ($phash->{pattern}) {
109 return $phash->{pattern};
110 } elsif ($phash->{type} eq 'integer' || $phash->{type} eq 'number') {
111 if (defined($phash->{minimum}) && defined($phash->{maximum})) {
112 return "$phash->{type} ($phash->{minimum} - $phash->{maximum})";
113 } elsif (defined($phash->{minimum})) {
114 return "$phash->{type} ($phash->{minimum} - N)";
115 } elsif (defined($phash->{maximum})) {
116 return "$phash->{type} (-N - $phash->{maximum})";
117 }
118 } elsif ($phash->{type} eq 'string') {
119 if (my $format = $phash->{format}) {
120 $format = PVE::JSONSchema::get_format($format) if ref($format) ne 'HASH';
121 if (ref($format) eq 'HASH') {
122 return generate_typetext($format);
123 }
124 }
125 }
126
127 my $type = $phash->{type} || 'string';
128
129 return $type;
130 }
131
132 sub generate_property_text {
133 my ($schema) = @_;
134 my $data = '';
135 foreach my $key (sort keys %$schema) {
136 my $d = $schema->{$key};
137 next if $d->{alias};
138 my $desc = $d->{description};
139 my $typetext = schema_get_type_text($d);
140 $desc = 'No description available' if !$desc;
141 $data .= "=item $key: $typetext\n\n$desc\n\n";
142 }
143 return $data;
144 }
145
146 # generate pod from JSON schema properties
147 sub dump_properties {
148 my ($properties) = @_;
149
150 my $data = "=over 1\n\n";
151
152 my $idx_param = {}; # -vlan\d+ -scsi\d+
153
154 foreach my $key (sort keys %$properties) {
155 my $d = $properties->{$key};
156 my $base = $key;
157 if ($key =~ m/^([a-z]+)(\d+)$/) {
158 my $name = $1;
159 next if $idx_param->{$name};
160 $idx_param->{$name} = 1;
161 $base = "${name}[n]";
162 }
163
164 my $descr = $d->{description} || 'No description avalable.';
165 chomp $descr;
166
167 if (defined(my $dv = $d->{default})) {
168 my $multi = $descr =~ m/\n\n/; # multi paragraph ?
169 $descr .= $multi ? "\n\n" : " ";
170 $descr .= "Default value is '$dv'.";
171 }
172
173 my $typetext = schema_get_type_text($d);
174 $data .= "=item $base: $typetext\n\n";
175 $data .= "$descr\n\n";
176
177 if ($d->{type} eq 'string') {
178 my $format = $d->{format};
179 if ($format && ref($format) eq 'HASH') {
180 $data .= "=over 1.1\n\n";
181 $data .= generate_property_text($format);
182 $data .= "=back\n\n";
183 }
184 }
185 }
186
187 $data .= "=back";
188
189 return $data;
190 }
191
192 1;