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;