#!/usr/bin/perl

# echo-mode-cb test for DOM
#
# John Jacobsen, John Jacobsen IT Services, for LBNL/IceCube
# Started Jul(?) 2003
# $Id: cbecho,v 1.1 2004/07/29 21:42:10 jacobsen Exp $

use Fcntl;
use strict;
use Getopt::Long;

my $verbose    = 0;
my $configboot = 0;

GetOptions("verbose|s"    => \$verbose,
	   "configboot|c" => \$configboot);

sub testecho; sub drain_iceboot;

my $domdev = shift;

if($domdev =~ /^(\d)(\d)(\w)$/) {
    my $dom    = $3;
    $dom    =~ tr/[a-z]/[A-Z]/;
    $domdev = "/dev/dhc$1"."w$2"."d$dom";
}

die "Usage: $0 [<card><pair><dom>|<dom_device_file>]\n" unless defined $domdev;
die "Couldn't find DOM device file $domdev" unless -e $domdev;

print "open $domdev...\n" if $verbose;
sysopen(DD, $domdev, O_RDWR)
    || die "Can't open $domdev: $!\n";

my $buf;

# Collect any extra iceboot strings...

print "Draining iceboot...\n" if $verbose;
drain_iceboot;

print "Sending echo command...\n" if $verbose;
syswrite DD, "\r\recho-mode-cfg\r";

# Have to do this 'cause Arthur is nuking his read buffer, everything
# will be lost until comms handshaking is reestablished
select undef,undef,undef,1.5;

print "Draining iceboot again...\n" if $verbose;

die "Echomode failed.\n" if drain_iceboot;

print "echo-mode of $domdev done.\n" if $verbose;

exit;

sub testecho {
    my $testmsg = shift;
    print "Testing \"$testmsg\"...\n" if $verbose;
    my $written = 0;
    my $wrtout = 100;

    for(1..$wrtout) {
	$written = syswrite DD, $testmsg, length($testmsg);
	if(defined $written && $written > 0) {
	    print "Wrote $written bytes.\n" if $verbose;
	    last;
	}
	if($_ == $wrtout-1) {
	    die "Unable to write data to DOM in timeout period.\n";
	}
	
	select undef,undef,undef,0.01;
    }
    my $gotreply = 0;
    my $nback = 0;
    my $reply = "";
    for(1..10) {
	my $read = sysread DD, $buf, 4096;
	my $err = $!;
	if(defined $read && $read > 0) {
	    $gotreply = 1;
	    print "Read [$buf] from iceboot.\n" if $verbose;
	    $reply .= $buf;
	    $nback += $read;
	} else {
	    select undef,undef,undef,0.001;
	}
    }
    if($gotreply == 0) {
	die "No reply from DOM in timeout period.\n";
    }
    die "Bad message length back (wanted "
	.length($testmsg).", got $nback bytes: \"$reply\")\n" unless $nback eq length($testmsg);
    die "Bad data back\nGot $reply\nWanted $testmsg\n\n" unless $reply eq $testmsg;
    print "ok.\n" if $verbose;
}

sub drain_iceboot {
    print "Getting iceboot data...\n" if $verbose;
    my $gotsomething = 0;
    my $dataread = "";
    for(1..10) {
	my $read = sysread DD, $buf, 4096;
	if($read > 0) {
	    print "$buf";
	    print "Read $read bytes ($buf) from DOM.\n" if $verbose;
	    $gotsomething++;
	    $dataread .= $buf;
	}
	select undef,undef,undef,0.001;
    }
    if($dataread =~ /error/i) {
	print "Error present on stream from DOM.\n";
	return 1;
    }
	
    print "Didn't drain any iceboot data.\n" if ($verbose && ! $gotsomething);
    return 0;
}


