#!/usr/bin/perl
#
# mctest - interactive testing of Mail::Cclient library
# Copyright (C) 1998 by Malcolm Beattie
#
use Mail::Cclient qw(set_callback);
use Term::ReadLine;
use Term::ReadKey;
use IO::Handle;

if (@ARGV) {
    print STDERR "Usage: mctest\n";
    exit 2;
}
my $term = Term::ReadLine->new("Mail::Cclient test");

set_callback
	login => sub {
	    my ($netmbx, $trial) = @_;
	    print "Login trial #$trial\n";
	    my $user = $netmbx->{user} || $term->readline("login: ");
	    print "Password for $user: ";
	    STDOUT->flush;
	    ReadMode "noecho";
	    chomp(my $password = <STDIN>);
	    ReadMode "restore";
	    print "\n";
	    return ($user, $password);
	},
	"log" => sub {
	    my ($str, $type) = @_;
	    print "$type: $str\n";
	},
	dlog => sub { print "debug: $_[0]\n" },
	list => sub {
	    shift;
	    print "list: @_\n";
	};

my $mc;
my $mailbox = "<none>";

while (defined($_ = $term->readline("mctest> "))) {
    $term->addhistory($_) if /\S/;
    eval {
	if (/^open (.*)/) {
	    my $f = $1;
	    print "opening mailbox $f...\n";
	    $mc = defined($mc) ? $mc->open($f) : Mail::Cclient->new($f);
	    if (defined($mc)) {
		$mailbox = $f;
		print "mailbox $mailbox: open OK\n";
	    } else {
		$mailbox = "<none>";
		print "mailbox $mailbox: open failed\n";
	    }
	}
	elsif (/^close/) {
	    $mc->close;
	    undef $mc;
	    print "close mailbox $mailbox\n";
	    $mailbox = "<none>";
	}
	elsif (/^expunge/) {
	    $mc->expunge;
	    print "expunged mailbox $mailbox\n";
	}
	elsif (/^flags (\d+)/) {
	    my $msgno = $1;
	    $mc->fetchstructure($msgno);
	    $elt = $mc->elt($msgno);
	    print join(", ", @{$elt->flags}), "\n";
	}
	elsif (my ($seq, $flag) = /^setflag (.*?) (.*)/) {
	    $mc->setflag($seq, $flag);
	}
	elsif (my ($seq, $flag) = /^clearflag (.*?) (.*)/) {
	    $mc->clearflag($seq, $flag);
	}
	elsif (/^stat/) {
	    print $mc->nmsgs, " messages in mailbox $mailbox\n";
	    my @flags;
	    push(@flags, "perm_seen") if $mc->perm_seen;
	    push(@flags, "perm_deleted") if $mc->perm_deleted;
	    push(@flags, "perm_flagged") if $mc->perm_flagged;
	    push(@flags, "perm_answered") if $mc->perm_answered;
	    push(@flags, "perm_draft") if $mc->perm_draft;
	    push(@flags, "kwd_create") if $mc->kwd_create;
	    push(@flags, "perm_user_flags") if $mc->perm_user_flags;
	    print "mailbox flags: ", join(", ", @flags), "\n";
	}
	elsif (/^head (\d+)/) {
	    my $msgno = $1;
	    print $mc->fetchheader($msgno);
	}
	elsif (/^text (\d+)/) {
	    my $msgno = $1;
	    print $mc->fetchtext($msgno);
	}
	elsif (my ($msgno, $part) = /^body (\d+) (\d+)/) {
	    print $mc->fetchbody($msgno, $part);
	}
	elsif (my ($seq, $mailbox) = /^move (.*?) (.*)/) {
	    print $mc->move($seq, $mailbox) ? "OK\n" : "failed\n";
	}
	elsif (my ($seq, $mailbox) = /^copy (.*?) (.*)/) {
	    print $mc->copy($seq, $mailbox) ? "OK\n" : "failed\n";
	}
	elsif (my ($mailbox) = /^create (.*)/) {
	    print $mc->create($mailbox) ? "OK\n" : "failed\n";
	}
	elsif (/^size (\d+)/) {
	    my $msgno = $1;
	    my ($e, $body) = $mc->fetchstructure($msgno);
	    print $body->lines, " lines, ", $body->bytes, " bytes\n";
	}
	elsif (my ($ref, $pat) = /^list (.*?) (.*)/) {
	    $mc->list($ref, $pat);
	}
	elsif (my ($mailbox, $file) = /^append (.*?) (.*)/) {
	    my $msg = `cat $file`;
	    $mc->append($mailbox, $msg);
	}
	elsif (my ($file) = /^>\s*(.*)/) {
	    my $filespec = $file;
	    $filespec = ">>$file" unless $file =~ /^\|/;
	    if (open(OUT, $filespec)) {
		print "Switched output to $file\n";
		select(OUT);
	    } else {
		print "Failed to switch output to $file\n";
	    }
	}
	else {
	    warn "bad command: $_\n" unless /^\?/ || /^help/;
	    print <<'EOT';
Commands:
open mailbox
close
expunge
flags msgno
setflag seq flag
clearflag seq flag
stat
head msgno
body msgno part
text msgno
move seq mailbox
copy seq mailbox
create mailbox
size msgno
list
append mailbox file
> file
EOT
	}
    };
    print "command died with error: $@\n" if $@;
}

