#!/afs/sipb/project/perldev/p -w

use strict;
use FileHandle;

# fix argv[0]
$0 =~ s@.*/@@g;

# Provide a default instance if needed.
#unshift(@ARGV, '-i', 'cigaM-etihW')
#  unless destination_specified(@ARGV);

# try reading the message from @ARGV [modifying it], or from standard input
push(@ARGV, '-m', message_from_STDIN())
  unless message_specified(@ARGV);

# randomize the message
@ARGV = randomize_message(@ARGV);

# run zwrite
exec 'zwrite', @ARGV;

### subroutines

# Read a message from standard input and return it.
sub message_from_STDIN {
  local($_);
  my ($msg) = '';
  print
  "Type your message now.  End with control-D or a dot on a line by itself.\n";
  while (<STDIN>) {
    /^\.$/ and last;
    $msg .= $_;
  }
  $msg;
}

# Randomize the -m arg[s] in an arg list
sub randomize_message {
  my (@args) = @_;
  my ($ix) = grep($args[$_] eq '-m', 0..$#args);
  die "no message!?!" unless defined $ix;
  my ($msg) = join ' ', splice @args, $ix+1;
  $msg =~ s/\n$//;
  push @args, join('', map(randomize_string($_),
			   split(/(\n)/, $msg)));
  @args;
}

# Randomize the order of characters in a string
sub randomize_string {
  my ($msg) = @_;
  my (@rmap) = map(rand, 0..length($msg)-1);
  join('', map(substr($msg, $_, 1),
	       sort {$rmap[$a]<=>$rmap[$b]} 0..(length($msg)-1)));
}

# Return true if the argument list specifies a message, false otherwise.
sub message_specified {
  scalar grep($_ eq '-m', @_);
}

# Return true if the argument list specifies a destination, false otherwise.
# We don't use Getopt::Std because it works differently.
sub destination_specified {
  my (@args, $a) = @_;
  while (@args) {
    $a = shift(@args);

    # message can't contain recipients
    ($a eq '-m') && return 0;

    # class or instance means destination
    ($a eq '-c') and return 1;
    ($a eq '-i') and return 1;

    # complain about senseless flags
    ($a eq '-f') and die "Can't reverse a FILSRV message!\n";
    ($a eq '-l') and die "$0: I can't deal with -l properly!\n";
    ($a eq '-n') and (warn("$0: I never send pings anyway!\n"), next);

    # skip other flags
    ($a =~ /^-[aodvqtu]$/) and next;
    ($a =~ /^-[Os]$/) and (shift(@args), next);
    ($a =~ /^-/) and (warn("unknown flag: '$a'\ncontinuing"), next);

    # not-a-flag is a username recipient
    return 1;
  }
}