# $Id$

use strict;
use warnings;
use Cwd qw();
use English qw(-no_match_vars);

use Sympa::ConfDef;
use Sympa::ListDef;
use Sympa::ListOpt;

my @groups = (
    [description => 'List definition'],
    [sending     => 'Sending/receiving setup'],
    [command     => 'Privileges'],
    [archives    => 'Archives'],
    [bounces     => 'Bounces'],
    [data_source => 'Data sources setup'],
    [dkim        => 'DKIM'],
    [other       => 'Miscellaneous'],
);

my %overrides;
foreach my $pitem (@Sympa::ConfDef::params) {
    next unless $pitem and exists $pitem->{name};
    $overrides{$pitem->{name}} = $pitem->{vhost};
}

my $parameters = '';

foreach my $g (@groups) {
    my ($group, $gdesc) = @$g;
    $parameters .= sprintf "=head2 %s\n\n", $gdesc;

    my $pinfo = {%Sympa::ListDef::pinfo};
    foreach my $key (_keys($pinfo)) {
        next
            unless $pinfo->{$key}->{group}
                and $pinfo->{$key}->{group} eq $group;

        my $pii = $pinfo->{$key};
        my $ppi = [$key];

        $parameters .= sprintf "=head3 C<%s>\n\n", _escape_pod($key);
        _render($pii, $ppi);
    }
}

printf do { local $RS; <DATA> }, $parameters;

exit 0;

sub _render {
    my $pii = shift;
    my $ppi = shift;

    if ($pii->{obsolete}) {
        if ($pii->{obsolete} eq '1') {
            $parameters .= "Deprecated.\n\n";
        } else {
            $parameters .= sprintf "Obsoleted. Use L<C<%s>|/%s>.\n\n",
                $pii->{obsolete}, $pii->{obsolete};
        }
    } elsif ($pii->{occurrence} =~ /n$/ and ref $pii->{format} eq 'ARRAY') {
        _render_set($pii, $ppi);
    } elsif (ref $pii->{format} eq 'HASH') {
        _render_paragraph($pii, $ppi);
    } else {
        _render_scalar($pii, $ppi);
    }

}

sub _render_paragraph {
    my $pinfo  = shift;
    my $pnames = shift;

    $parameters .= sprintf "%s\n\n", _escape_pod($pinfo->{gettext_id});

    $parameters .= "=over\n\n";
    $parameters .=
        ($pinfo->{occurrence} =~ /n$/)
        ? "=item Multiple occurrences allowed"
        : "=item Single occurrence";
    $parameters .=
        ($pinfo->{occurrence} =~ /^1/) ? ", I<mandatory>\n\n" : "\n\n";
    $parameters .= "=back\n\n";

    $parameters .= sprintf "%s\n\n", join "\n\n", split /\n/,
        _escape_pod($pinfo->{gettext_comment})
        if exists $pinfo->{gettext_comment};

    foreach my $key (_keys($pinfo->{format})) {
        my $pii = $pinfo->{format}->{$key};
        my $ppi = [@$pnames, $key];

        $parameters .= sprintf "=head4 C<%s>\n\n", join '.', @$ppi;
        #$parameters .= "=over\n\n" x (scalar @$pnames);

        if ($pii->{obsolete}) {
            if ($pii->{obsolete} eq '1') {
                $parameters .= "Deprecated.\n\n";
            } else {
                $parameters .= sprintf "Obsoleted. Use L<C<%s>|/%s>.\n\n",
                    $pii->{obsolete}, join '.', @$pnames, $pii->{obsolete};
            }
        } elsif ($pii->{occurrence} =~ /n$/ and ref $pii->{format} eq 'ARRAY')
        {
            _render_set($pii, $ppi);
        } elsif (ref $pii->{format} eq 'HASH') {
            _render_paragraph($pii, $ppi);
        } else {
            _render_scalar($pii, $ppi);
        }

        #$parameters .= "=back\n\n" x (scalar @$pnames);
    }
}

sub _render_set {
    my $pinfo  = shift;
    my $pnames = shift;

    $parameters .= sprintf "%s\n\n", _escape_pod($pinfo->{gettext_id});

    $parameters .= "=over\n\n";
    _format($pinfo);
    _default($pinfo);
    $parameters .= "=back\n\n";

    $parameters .= sprintf "%s\n\n", join "\n\n", split /\n/,
        _escape_pod($pinfo->{gettext_comment})
        if exists $pinfo->{gettext_comment};

}

sub _render_scalar {
    my $pinfo  = shift;
    my $pnames = shift;

    $parameters .= sprintf "%s\n\n", _escape_pod($pinfo->{gettext_id})
        if exists $pinfo->{gettext_id};

    $parameters .= "=over\n\n";

    _format($pinfo);
    _default($pinfo);

    $parameters .= "=back\n\n";

    $parameters .= sprintf "%s\n\n", join "\n\n", split /\n/,
        _escape_pod($pinfo->{gettext_comment})
        if exists $pinfo->{gettext_comment};
}

sub _format {
    my $pinfo = shift;

    $parameters .= "=item Format:\n\n";

    if ($pinfo->{occurrence} =~ /n$/) {
        if ($pinfo->{split_char}) {
            $parameters .=
                sprintf "Multiple values allowed, separated by C<%s>.\n\n",
                $pinfo->{split_char};
        } else {
            $parameters .= "Multiple occurrences allowed.\n\n";
        }
    }

    if (exists $pinfo->{field_type}) {
        my $desc = {
            dayofweek  => 'Day of week, C<0> - C<6>.',
            lang       => 'Language tag.',
            password   => 'The value to be concealed.',
            reception  => 'Reception mode of list member.',
            status     => 'Status of list.',
            listtopic  => 'List topic.',
            unixtime   => 'The time in second from Unix epoch.',
            visibility => 'Visibility mode of list memeber.',
            }->{$pinfo->{field_type}}
            || $pinfo->{field_type};
        $parameters .= sprintf "%s\n\n", $desc;
    } elsif (exists $pinfo->{scenario}) {
        my $function = $pinfo->{scenario};
        my $cwd      = Cwd::getcwd();
        chdir '../default/scenari/' or die $ERRNO;
        $parameters .= sprintf "Name of C<%s> scenario:\n\n",
            $pinfo->{scenario};

        $parameters .= "=over\n\n";
        my @names = sort map {
            my $file = [split m{/}, $_]->[-1];
            substr $file, 1 + length $function
        } <$function.*>;
        foreach my $name (@names) {
            my $fh;
            open $fh, '<', "$function.$name" or die $ERRNO;
            my $content = do { local $RS; <$fh> };
            close $fh;
            if ($content =~ /(?:\A|\n)title(?:[.][-\w]+)\s+(.+)/) {
                $parameters .= sprintf "=item C<%s> - %s\n\n", $name, $1;
            } else {
                $parameters .= sprintf "=item C<%s>\n\n", $name;
            }
        }
        $parameters .= "=back\n\n";

        chdir $cwd;
    } elsif (ref $pinfo->{format} eq 'ARRAY') {
        $parameters .= "=over\n\n";
        foreach my $item (@{$pinfo->{format}}) {
            my $desc =
                ($Sympa::ListOpt::list_option{$item} || {})->{gettext_id}
                || $item;
            $desc =~ s/^\s+//;
            $desc =~ s/\s+$//;

            $parameters .= sprintf "=item C<%s> - %s\n\n", $item,
                _escape_pod($desc);
        }
        $parameters .= "=back\n\n";
    } elsif (exists $pinfo->{gettext_unit}) {
        $parameters .= sprintf "Number of %s.\n\n", $pinfo->{gettext_unit};
    } elsif (exists $pinfo->{format_s} or exists $pinfo->{format}) {
        my $format =
            (exists $pinfo->{format_s})
            ? $pinfo->{format_s}
            : $pinfo->{format};
        $format =~ s/\A\(\?\^:(.*)\)\z/$1/
            or $format =~ s/\A\(\?-xism:(.*)\)\z/$1/;
        $parameters .= sprintf "/C<%s>/\n\n", _escape_pod($format);
    }
}

sub _default {
    my $pinfo = shift;

    $parameters .= "=item Default:\n\n";
    if (exists $pinfo->{default}) {
        if (ref $pinfo->{default} eq 'ARRAY') {
            $parameters .= sprintf "%s\n\n", join ', ',
                map { sprintf "C<%s>", $_ } @{$pinfo->{default}};
        } elsif (ref $pinfo->{default} eq 'HASH'
            and $pinfo->{default}->{conf}) {
            $parameters .=
                sprintf
                "Value of L<C<%s>|sympa.conf(5)/%s> parameter in F<sympa.conf>%s.\n\n",
                $pinfo->{default}->{conf}, $pinfo->{default}->{conf},
                (
                $overrides{$pinfo->{default}->{conf}}
                ? ' or F<robot.conf>'
                : ''
                );
        } else {
            $parameters .= sprintf "C<%s>\n\n", $pinfo->{default};
        }
    } elsif ($pinfo->{occurrence} =~ /^1/) {
        $parameters .= "None, I<mandatory>.\n\n";
    } else {
        $parameters .= "None.\n\n";
    }
}

sub _keys {
    my $hash = shift;
    my $phash = shift || $hash;

    return sort {
        ($phash->{$a}->{order} || 999) <=> ($phash->{$b}->{order} || 999)
            || ($a cmp $b)
    } CORE::keys %$hash;
}

sub _escape_pod {
    my $string = shift;
    $string =~ s/([&<>])/
        'E<' . {'&' => 'amp', '<' => 'lt', '>' => 'gt'}->{$1} . '>'
    /eg;
    return $string;
}

__END__

=encoding utf-8

=head1 NAME

list_config - Configuration file for mailing list

=head1 DESCRIPTION

F<config> is main configuration file of the mailing list.

Format of F<config> is as following:

=over

=item *

Lines beginning with C<#> and containing only spaces are ignored.

=item *

There are parameters with single line and multiple lines:

=over

=item *

On single line parameters,
each line has the form "I<parameter> I<value>".
I<value> may contain spaces but may not contain newlines.

Several parameters may have multiple values.
If it's the case, values may be separated by comma (C<,>)
or parameter lines may be repeated.
Some of parameters must have one or more of limited values.

Example:

  subject This is subject of my list
  
  remove_headers User-Agent,Importance
  
  custom_headers X-List: mylist
  custom_headers X-Face: %%`-W7!?^]Sg'I-K>P<cdn&k:~A^{x>(]Gc{V...
  
  rfc2369_header_fields post,owner 

=item *

A multiple line parameter, so-called "paragraph", consists of
the first line specifying parameter name and subsequent one or more
sub-parameter lines.  Paragraph must be separated by one or more empty lines
from the other parameters.

Several multiple line parameters may occur multiple times.

=back

=back

=head1 PARAMETERS

Below is entire list of configuration parameters.
"Default" is built-in default value if any.

%s

=head1 FILES

=over

=item F<$EXPLDIR/E<lt>list nameE<gt>/config>
or F<$EXPLDIR/E<lt>mail domain nameE<gt>/E<lt>list nameE<gt>/config>

List main configuration file.

=back

=head1 SEE ALSO

L<sympa.conf(5)>.

I<Sympa Administration Manual>.
L<https://sympa-community.github.io/manual/>.

=cut
