#!/usr/bin/env perl
#
# svnwin - talk to svn.win.tue.nl's administration web interface
#
# $Id$

use warnings;
use strict;

use Getopt::Std;
use WWW::Mechanize;
use WWW::Mechanize::Plugin::FollowMetaRedirect;
use HTML::TableExtract;

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

my %opt;
getopts( 'hu:p:v', \%opt );

$opt{h} and HELP_MESSAGE();
$opt{r} || $opt{a} or $opt{m} = 1;

exit !doitall();

sub HELP_MESSAGE
{
  print STDERR <<ZZ;
Usage:

  $me [-u username] [-p password] [repository1 [repository2 [...]]

to print information on a svn.win.tue.nl repository of which you are admin.

Arguments:

  Names of repositories.
  Without any arguments, all repositories are used.

Options:

 -u username

  The username to use.
  If this option is missing, the username is asked interactively.

 -p password

  The password to use.
  If this option is missing, the password is asked interactively.

 -v

   Verbose; prints some progress messages to standard error.

Output:

  The list of users and administrators for each repository,
  in the form of a list of comma-separated values:

    repository,user,role

  where role is one of:

    ro  (user has read-only access)
    rw  (user has read-only access)
    ad  (user is administrator)

ZZ
  exit(0);
}

sub ask
# copied verbatim from ./picasaweb
{
  use Term::ReadKey;

  my ( $prompt, $repl ) = @_;
  my $pword;
  my $key;
  open( my $out_fh, '>', '/dev/tty' )
   or die "Cannot write to tty: $!\n";
  my $stdout = *STDOUT;
  select($out_fh);
  local $| = 1;    # Turn off STDOUT buffering for immediate response
  print "$prompt: ";
  ReadMode 2;      # Change to Raw Mode, disable Ctrl-C

  while (1)
  {
    while ( !defined( $key = ReadKey(-1) ) ) { }

    if ( $key =~ /^[\r\n]/ )
    {              # if Enter was pressed...
      print $key;    # print a newline
      last;          # and get out of here
    }
    print( $repl // $key );
    $pword .= $key;
  }
  ReadMode 0;        # Reset tty mode before exiting. <==IMPORTANT
  select($stdout);
  return $pword;
}

sub aargh
{
  die join( ' ', "$me: fatal error:", @_ ), "\n";
}

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

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

sub login
{
  my $hosturl = 'https://svn.win.tue.nl/';

  my $mech =
   WWW::Mechanize->new(
    ssl_opts => { verify_hostname => 0, cookie_jar => my $cjar } );

  my $res = $mech->get($hosturl);
  $res = $mech->follow_meta_redirect() // $res;

  $res->content =~ 'subversion repositories'
   or aargh('failed to reach svn.win.tue.nl overview page');

  my $username = $opt{u} // ask('Username');
  my $password = $opt{p} // ask( 'Password', '*' );

  $mech->credentials( $username, $password );

  $mech->follow_link( text_regex => qr/login/i ) && $mech->success()
   or aargh('cannot reach login page');

  ehm_v( 'on repository selection page', $mech->base() );

  $mech->form_number(1)
   or aargh('repository selection page looks weird (no form)');

  my ( $submit, $select ) = repository_selection_controls($mech);

  my @adminned = $select->possible_values;

  if (@ARGV)
  {
    # we need to reduce the repositories to the selected ones
    my %adminned = map { $_ => 1 } @adminned;
    my @unadminned = grep { !$adminned{$_} } @ARGV;
    @unadminned
     and ehm( 'not found (no admin rights?), ignored: ', @unadminned );
    my %in_argv = map { $_ => 1 } @ARGV;
    @adminned = grep { $in_argv{$_} } @adminned;
    @adminned
     or aargh('specified repository/ies not found (no admin rights?)');
  }

  my $editrepo_url = $hosturl . 'svnwebadmin/admin/editrepo';
  ( $mech->current_form->action eq $editrepo_url )
   or aargh( 'unexpected URL to go to repository admin page:',
    $mech->current_form->action );

  $mech->click_button( input => $submit );
  # go to the first repository's admin page!

  $mech->success()
   or aargh('cannot go to a repository admin page');

  ( $mech->uri eq $editrepo_url )
   or aargh( 'unexpected URL for repository admin page:', $mech->uri );

  ( $mech, \@adminned );
}

sub repository_selection_controls
{
  my ($mech) = @_;

  my ($editrepo_form) = grep { $_->action =~ /editrepo$/ } $mech->forms
   or aargh('cannot find repository selection form');

  my @inputs = $editrepo_form->inputs
   or aargh('repository selector looks weird (no inputs)');

  my ($submit) = grep { $_->type eq 'submit' && $_->value eq 'admin' } @inputs
   or aargh('repository selector looks weird (no submit)');

  my ($select) =
   grep { $_->type eq 'option' && $_->name eq 'repository' } @inputs
   or aargh('repository selector looks weird (no repositories)');

  ( $submit, $select );
}

sub list_users
{
  my ( $mech, $adminned ) = @_;

  foreach my $repo (@$adminned)
  {
    ehm_v("going to admin page for $repo");

    my ( $submit, $select ) = repository_selection_controls($mech);

    $select->value( [$repo] )
     or aargh('cannot set the repository to go to');

    $mech->click_button( input => $submit );
    # go to the first repository's admin page!

    $mech->success()
     or aargh( 'cannot reach admin page for repository:', $repo );

    #foreach my $form ( grep { $_->action eq 'deleteaccess' } )

    my $tblxtr = HTML::TableExtract->new();
    $tblxtr->parse( $mech->content )
     or aargh( 'cannot parse tables on admin page for repository', $repo );

    my @tables = $tblxtr->tables()
     or aargh( 'cannot find tables on admin page for repository', $repo );

    foreach my $table (@tables)
    {
      my @rows   = $table->rows()    or next;
      my @header = @{ shift(@rows) } or next;

      if ( @header == 4 && $header[1] eq 'access for:' )
      {
        ehm_v("listing members for $repo");
        #ehm('header:', @header);

        foreach my $row (@rows)
        {
          my ( $form, $user, $access, $path ) = @$row;
          #ehm('row:', map { "'$_'" } @$row);
          printf "%s,%s,%s\n", $repo, $access, $user, if $access =~ /^r[ow]$/;
        }
      }
      elsif ( @header == 3 && $header[$#header] eq 'as administrator' )
      {
        #ehm("listing administrators for $repo");
        #ehm('header ('.scalar(@header).' columns):', @header);

        foreach my $row (@rows)
        {
          my ( $form, $user, $asadmin ) = @$row;
          #ehm('row:', map { "'$_'" } @$row);
          printf "%s,%s,%s\n", $repo, 'adm', $user
           if $asadmin && $asadmin eq 'as administrator';
        }
      }
    }
  }
}

sub doitall
{
  my ( $mech, $adminned ) = login();

  if ( $opt{r} )
  {
    print "$_\n" for @$adminned;
  }
  else
  {
    list_users( $mech, $adminned );
  }
}