116cc2564ce10265553dd9977914891718771664
[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->{alias};
54         next if !$entry->{format_description} &&
55                 !$entry->{typetext} &&
56                 !$entry->{enum} &&
57                 $entry->{type} ne 'boolean';
58         if ($schema->{$key}->{optional}) {
59             push @optional, $key;
60         } else {
61             push @required, $key;
62         }
63     }
64     my ($pre, $post) = ('', '');
65     my $add = sub {
66         my ($key) = @_;
67         $typetext .= $pre;
68         my $entry = $schema->{$key};
69         if (my $alias = $entry->{alias}) {
70             $key = $alias;
71             $entry = $schema->{$key};
72         }
73         if (!defined($entry->{typetext})) {
74             $typetext .= $entry->{default_key} ? "[$key=]" : "$key=";
75         }
76         if (my $desc = $entry->{format_description}) {
77             $typetext .= "<$desc>";
78         } elsif (my $text = $entry->{typetext}) {
79             $typetext .= $text;
80         } elsif (my $enum = $entry->{enum}) {
81             $typetext .= '<' . join('|', @$enum) . '>';
82         } elsif ($entry->{type} eq 'boolean') {
83             $typetext .= '<1|0>';
84         } else {
85             die "internal error: neither format_description nor typetext found";
86         }
87         $typetext .= $post;
88     };
89     foreach my $key (@required) {
90         &$add($key);
91         $pre = ', ';
92     }
93     $pre = $pre ? ' [,' : '[';
94     $post = ']';
95     foreach my $key (@optional) {
96         &$add($key);
97         $pre = ' [,';
98     }
99     return $typetext;
100 }
101
102 sub schema_get_type_text {
103     my ($phash) = @_;
104
105     if ($phash->{typetext}) {
106         return $phash->{typetext};
107     } elsif ($phash->{enum}) {
108         return "(" . join(' | ', sort @{$phash->{enum}}) . ")";
109     } elsif ($phash->{pattern}) {
110         return $phash->{pattern};
111     } elsif ($phash->{type} eq 'integer' || $phash->{type} eq 'number') {
112         if (defined($phash->{minimum}) && defined($phash->{maximum})) {
113             return "$phash->{type} ($phash->{minimum} - $phash->{maximum})";
114         } elsif (defined($phash->{minimum})) {
115             return "$phash->{type} ($phash->{minimum} - N)";
116         } elsif (defined($phash->{maximum})) {
117             return "$phash->{type} (-N - $phash->{maximum})";
118         }
119     } elsif ($phash->{type} eq 'string') {
120         if (my $format = $phash->{format}) {
121             $format = PVE::JSONSchema::get_format($format) if ref($format) ne 'HASH';
122             if (ref($format) eq 'HASH') {
123                 return generate_typetext($format);
124             }
125         }
126     }
127
128     my $type = $phash->{type} || 'string';
129
130     return $type;
131 }
132
133 sub generate_property_text {
134     my ($schema) = @_;
135     my $data = '';
136     foreach my $key (sort keys %$schema) {
137         my $d = $schema->{$key};
138         next if $d->{alias};
139         my $desc = $d->{description};
140         my $typetext = schema_get_type_text($d);
141         $desc = 'No description available' if !$desc;
142         $data .= "=item $key: $typetext\n\n$desc\n\n";
143     }
144     return $data;
145 }
146
147 # generate pod from JSON schema properties
148 sub dump_properties {
149     my ($properties) = @_;
150
151     my $data = "=over 1\n\n";
152
153     my $idx_param = {}; # -vlan\d+ -scsi\d+
154
155     foreach my $key (sort keys %$properties) {
156         my $d = $properties->{$key};
157         my $base = $key;
158         if ($key =~ m/^([a-z]+)(\d+)$/) {
159             my $name = $1;
160             next if $idx_param->{$name};
161             $idx_param->{$name} = 1;
162             $base = "${name}[n]";
163         }
164
165         my $descr = $d->{description} || 'No description avalable.';
166         chomp $descr;
167
168         if (defined(my $dv = $d->{default})) {
169             my $multi = $descr =~ m/\n\n/; # multi paragraph ?
170             $descr .= $multi ? "\n\n" : " ";
171             $descr .= "Default value is '$dv'.";
172         }
173
174         my $typetext = schema_get_type_text($d);
175         $data .= "=item $base: $typetext\n\n";
176         $data .= "$descr\n\n";
177
178         if ($d->{type} eq 'string') {
179             my $format = $d->{format};
180             if ($format && ref($format) eq 'HASH') {
181                 $data .= "=over 1.1\n\n";
182                 $data .= generate_property_text($format);
183                 $data .= "=back\n\n";
184             }
185         }
186     }
187
188     $data .= "=back";
189
190     return $data;
191 }
192
193 1;