#!/usr/bin/env perl
#
# mailmanage - reconfigure Mailman mailing lists
#
# $Id: mailmanage 825 2012-03-01 13:37:36Z rp $

use warnings;
use strict;

use Getopt::Std;
use WWW::Mailman;
use JSON;

my %opt;
getopts( 'h?l:mp:s:u:v', \%opt )
 or oomph('error parsing the command line, try -h for help');

HELP_MESSAGE() if grep { /^[h?]/ } keys %opt;

my ($me) = $0 =~ m#([^/\\]+)$#;

sub HELP_MESSAGE
{
  print STDERR <<'ZZ';

Usage:

  $me [-s server] [-m | -u user] [-p password] [-v] -l list [setting [setting2 [...]]]

to show settings, or a setting, or change a setting,
for the specified Mailman mailing list.

Arguments:

   setting setting2 ...

     A whitespace-separated list of setting specifications;
     each setting specification is the name of a setting,
     optionally followed by an equals sign and a value, e.g.

       real_name
       real_name=OPENCOSS
       default_member_moderation=0

If no setting is specified, print the list of settings and their values
in JSON format, grouped by the 'section' (form) they are in.

Note that this is a mixture of read-write, read-only,
and write-only settings, and that when setting a setting, you only
need to specify its name, not the section it is in.

If at least one setting is specified, for each setting:

  if it is just an setting name, print the name and value as a JSON pair;
  if it also specifies a value, attempt to set the setting to the value.

Order is insignificant: a request to set a setting is always executed
before a request to show its value.

Abort on failure (e.g. when a nonexistent setting is specified).

Options:

  -l list(s)

     The name(s) of the mailing list(s, separated by a comma).
     This option is required!

  -s server

    The hostname of the mailman server, with optionally
      - the protocol prefix
      - the path to the Mailman installation.  For instance:

      listserver.example.org
      listserver.example.org/mailman
      https://lists.sourceforge.net/lists

    However, the last example doesn't work because the underlying
    library requires the presence of a 'mailman' component in the path.

  -m

    Print the list of members (subscribers).
    Cannot be used together with -u.

  -u user

    When specified, act on the subscription settings for this user.
    If not specified, act on the configuration settings for the list.
    Note that these are completely different.

    The value must be an email address.  For instance:

      jdoe@example.com

  -p password

    The list moderator's password.

  -v

    Verbose: print some information on what is going on.

ZZ
  exit(0);
}

sub oops
{
  warn join( ' ', "$me:", @_ ), "\n";
}

sub oomph
{
  oops(@_);
  die "$me: aborting - try $me -h for help\n";
}

sub ehm
{
  $opt{v} and oops(@_);
}

$opt{u} && $opt{m}
 and oomph('-m and -u do not go together, try -h for help');

my @lists = grep { /\S/ } split( /,/, ( $opt{l} // '' ) )
 or oomph('supply a list name with -l, or try -h for help');

$opt{m} && @ARGV
 and oomph('-m does not take any settings, try -h for help');

# quick hack - loses the order!
my %settings_with_values =
 map { my @p = split /=/; @p == 2 ? @p : ( @p, undef ) } grep { /=/ } @ARGV;
# (support undef values)
my @settings_wo_values = grep { !/=/ } @ARGV;

my $server = $opt{s} // 'listserver.tue.nl';
$server =~ s#/+$##;

if ( $server !~ m#/# )
{
  $server .= '/mailman';
}

if ( $server !~ m#^\w+://# )
{
  $server = 'http://' . $server;
}

my $email    = $opt{u};
my $password = $opt{p};

foreach my $list (@lists)
{
  main($list);
}

exit(0);

sub main
{
  my ($list) = @_;

  my $mm = WWW::Mailman->new(
    uri         => "$server/listinfo/$list",
    cookie_file => "$ENV{HOME}/.mailmanrc"
  ) or oomph("cannot create Mailman interface to $server");

  $mm->moderator_password($password) if defined $password;
  my $uri = $mm->uri();
  eval { $mm->robot->get($uri)->is_success() }
   or oomph("cannot connect to Mailman interface at $uri");
  # will *succeed* for nonexistent lists on an existing Mailman installation

  if ( defined $opt{m} )
  {
    ehm('printing list of subscribers');
    print map { "$_\n" } $mm->roster();
    exit(0);
  }
  elsif ( defined $email )
  {
    $mm->email($email);

    ehm("processing settings for subscriber $email for list $list ...");

    my %result = (
      'address' => process_section( 'address', sub { $mm->address(@_) } ),
      #'changepw' => process_section( 'changepw', sub { $mm->changepw(@_) } ),
      #'options' =>  process_section( 'options',  sub { $mm->options(@_) } ),
      #'unsub' =>  process_section( 'unsub',  sub { $mm->unsub(@_) } )
    );
    # this isn't quite right yet: each section contains *all* sessings!

    if ( !@ARGV )
    {
      print_as_json( \%result );
    }
  }
  else
  {
    ehm("processing settings for admin for list $list ...");
    my @sections =
     qw( general passwords language nondigest digest bounce archive gateway autoreply contentfilter topics members/list members/add members/remove nondigest privacy/subscribing privacy/sender privacy/recipient privacy/spam );
    #my @sections = qw( members/list );
    #my @sections = qw( privacy/sender );

    my %result = map {
      $_ => process_section( $_, sub { $mm->admin( $_, @_ ) } )
    } @sections;

    if ( !@ARGV )
    {
      print_as_json( \%result );
    }
  }
}

sub process_section
{
  my ( $section, $accessor ) = @_;

  ehm("processing settings in section $section ...");

  if ( !@ARGV )
  {
    # return all settings
    return &$accessor();
  }

  # we must show or set the settings

  # attempt to set the ones with values that exist in this section
  if (%settings_with_values)
  {
    my $existing_settings = &$accessor();

    if (
      my @to_set =
      grep { exists $existing_settings->{$_} } keys %settings_with_values
     )
    {
      # set them in one POST!  (this doesn't appear to work ...)
      @to_set = sort keys %settings_with_values;
      ehm( 'setting:', $_, 'to:', $settings_with_values{$_} ) for @to_set;
      &$accessor( { map { $_ => $settings_with_values{$_} } @to_set } );
    }
  }

  # show the ones without values that exist in this section
  if (@settings_wo_values)
  {
    my $existing_settings = &$accessor();

    if (
      my @to_show =
      grep { exists $existing_settings->{$_} } @settings_wo_values
     )
    {
      ehm( 'showing:', @to_show );
      print_as_json(
        { $section => { map { $_ => $existing_settings->{$_} } @to_show } } );
    }
  }
}

sub print_as_json
{
  print to_json( $_[0], { utf8 => 1, pretty => 1 } );
}