#!/usr/bin/perl -w
#
# $Id: mailman-util,v 1.4 2006/08/01 14:25:33 jmates Exp $
#
# The author disclaims all copyrights and releases this document into
# the public domain.
#
# Utility routines to interact with the mailman mailing list manager.
#
# TODO Mailman 2.0.5 lacks "disable reminder" support? Ugh.

use strict;

my $VERSION;
( $VERSION = '$Revision: 1.4 $ ' ) =~ s/[^0-9.]//g;

# registered mode handlers
my %handlers = ( notify => { code => \&handle_notify, }, );

use Getopt::Std;
my %opts;
getopts( 'h?', \%opts );

print_help() if exists $opts{h} or exists $opts{'?'} or not @ARGV;

my $mode = shift;
if ( !exists $handlers{$mode} ) {
  die "error: no such mode: name=$mode\n";
}

$handlers{$mode}->{code}->(@ARGV);

exit;

# handlers
sub handle_notify {
  # NOTE remind => 1 means do not remind. Go figure. Here, default to
  # not sending reminders, unless something "enable" or the like
  # supplied.
  my $send_reminder = shift || '';
  if ( $send_reminder =~ m/^(enable|1|yes)$/ ) {
    $send_reminder = 0;
  } else {
    $send_reminder = 1;
  }

  my $input_fh = shift || \*STDIN;

  my %user_data;
  my $remaining_lines;

  while (<$input_fh>) {
    # KLUGE fragile parse for the URL and password to access user
    # prefs with.
    if (m/^----/) {
      $remaining_lines = do { local $/; <$input_fh> };
      if ( $remaining_lines =~ m{ \s+ (\S+) \s+ ^(http://.+) $}msx ) {
        ( $user_data{password}, $user_data{raw_url} ) = ( $1, $2 );

      } else {
        warn "error: could not parse user password and URL\n";
        exit 101;
      }
      last;
    } else {
      next;
    }
  }

  # mailman changed format on us, or bogus data supplied
  if ( !defined $remaining_lines ) {
    warn "error: failed to match expected mailman data\n";
    exit 101;
  }

  use URI ();
  $user_data{url} = URI->new( $user_data{raw_url} )->canonical;
  if ( !defined $user_data{url} ) {
    warn "error: could not parse: url=$user_data{raw_url}\n";
    exit 101;
  }

  use WWW::Mechanize ();
  my $mech = WWW::Mechanize->new( autocheck => 1, cookie_jar => {} );

  # KLUGE login
  $mech->get( $user_data{url} );

  # this is due to folks throwing random new forms into the page, and me
  # not wanting to search for the right form. XML-RPC interface would be
  # much nicer, or a certain default disabled to begin with globally!
  for my $form_number ( 1 .. 99 ) {
    eval {
      $mech->form_number($form_number);
      $mech->field( 'password', $user_data{password} );
      $mech->click_button( name => 'login' );
    };
    if ( $@ and $form_number == 99 ) {
      die "error: could not find login form, errno=$@\n";
    } elsif ( not $@ ) {
      last;
    }
  }

  # KLUGE set value we want
  for my $form_number ( 1 .. 99 ) {
    eval {
      $mech->form_number($form_number);
      if ( $mech->value('remind') != $send_reminder ) {
        $mech->set_fields( remind => $send_reminder );

        print $mech->value('remind'), "\n";

        # KLUGE yes, all of this. Onwards!
        $mech->click_button( name => 'options-submit' );
      } else {
        #print "nothing to do!\n";
      }
    };
    if ( $@ and $form_number == 99 ) {
      die "error: could not find options form: errno=$@\n";
    } elsif ( not $@ ) {
      last;
    }

  }
}

# a generic help blarb
sub print_help {
  print <<"HELP";
Usage: $0 [opts] mode [mode args]

Utility routines to interact with the mailman mailing list manager.

Options for version $VERSION:
  -h/-?  Display this message

HELP
  exit 100;
}