The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#
# This file is part of AnyEvent-Riak
#
# This software is copyright (c) 2014 by Damien Krotkine.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
use 5.012;
use strict;
use warnings;
use FindBin qw($Bin);

my @content = split(m|\n|, do{local(@ARGV,$/)="$Bin/riak.proto";(<>)});

my $pod = "package AnyEvent::Riak::Documentation;\n\n1;\n\n";

my $current_comment = '';
my $request_name = '';
my $response_name = '';
my $object_name = '';

my %enums;
my $enum_name = '';

my $methods_pod = "=head1 METHODS\n\n";
my $responses_pod = "=head1 RESPONSE OBJECTS\n\n";
my $objects_pod = "=head1 OTHER OBJECTS\n\n";

my $current_pod = '';

my %mapper = (
  bytes => string =>
  uint32 => number =>
  bool => boolean =>
);

while (defined ($_ = shift @content)) {

state $c++;
    s/^\s*$//;
    length or
      $current_comment = '',
      next;

    if (m|^\s*//\s*([A-Z]?)(.*)$|) {
        $current_comment .= ($1 ? ($current_comment ? ". $1$2" : "$1$2"): " $2");
        next;
    }

    my $postfix_comment = '';
    s|//\s*(.*)$||
      and $postfix_comment = $1;

    if (/^message Rpb(\w+)Req {$/) {
        $request_name = $1;
        my $method_name = _from_camel($request_name);
        $current_pod .= "=head2 $method_name\n\n";
        $current_comment
          and $current_pod .= "$current_comment\n\n";
        $current_comment = '';
        $current_pod .= "=over\n\n";
        next;
    }
    if (/^message (Rpb\w+Resp) {$/) {
        $response_name = $1;
        $current_pod .= "=head2 $response_name\n\n";
        $current_comment
          and $current_pod .= "$current_comment\n\n";
        $current_comment = '';
        $current_pod .= "=over\n\n";
        next;
    }
    if (/^message (Rpb\w+) {$/) {
        $object_name = $1;
        next;
    }
    if (/^\s*}$/) {
        if ($enum_name) {
            $enum_name = '';
            next;
        }
        $current_pod .= "=back\n\n";
        if ($request_name) {
            $request_name = '';
            $methods_pod .= $current_pod;
            $current_pod = '';
            next;
        }
        if ($response_name) {
            $response_name = '';
            $responses_pod .= $current_pod;
            $current_pod = '';
            next;
        }
        if ($object_name) {
            $object_name = '';
            $objects_pod .= $current_pod;
            $current_pod = '';
            next;
        }
        die "mofa";
    }
    if (/^    enum (.*) {/) {
        $enum_name = $1;
        # $current_pod .= "=item $1\n\n";
        # $current_comment
        #   and $current_pod .= "$current_comment\n\n";
        # $current_pod .= "=over\n\n";
        next;
    }
    if (/^\s+(.*)$/) {
        my $item = $1;
        $item =~ s/ = \d+;$//;
        if ($enum_name) {
            push @{$enums{$enum_name} //= []}, $item;
            next;
        }
        my ($p1, $type, $name) = split(/\s+/, $item);
        defined $name or
          say STDERR "$c ($_)";
        $current_pod .= "=item $name\n\n";
        $type = $mapper{$type} // $type;
        if (exists $enums{$type}) {
            $type = 'one of ' . join(', ', map { "'$_'" } @{$enums{$type}} )
        }
        $current_pod .= "$p1, $type\n\n";
        $current_comment
          and $current_pod .= $current_comment;
        $postfix_comment
          and $current_pod .= ($current_comment ? '. ': '') . $postfix_comment;
        $postfix_comment || $postfix_comment
          and $current_pod .= "\n\n";
        $current_comment = '';
        next;
    }
}

$pod .= $methods_pod . $responses_pod . $objects_pod;

say $pod;

sub _from_camel {
    my $s = $_[0];
    $s =~ s/(.)([A-Z])([a-z])/$1 . '_' . lc($2) . $3/ge;
    $s =~ s/^([A-Z])([a-z])/lc($1) . $2/e;
    $s;
}