#!/usr/atria/bin/Perl
#
# ck_all_ver_cltxt_len.pl (the VOB is implicitly the current directory's VOB)
#
# check all of the elements in the the current VOB
# and detect any version whose constructed cleartext length mismatches
# what the VOB thinks it should be.
# *** need to be in a view (any view will do) ***
# *** need to be cd'd to the VOB to check ***
#
# % setview <any view>
# % cd <vob root dir>
# % ct lock -vob .  (OPTIONAL keep reading)
# % ck_all_ver_cltxt_len.pl | tee ck_all_ver_cltxt_len.out
# ... sit back ...
# % ct unlock -vob .
#
# NOTE: this code isn't quite NT ready...
# There are a couple of gotchas (and I don't have the time to
# fix everything at this point). So for now, do the following to
# run this on NT:
#
#   - Add a new comment line (an empty one is fine) at the
#     beginning of the script BEFORE the existing line:
#         #!/usr/atria/bin/Perl
#
#   - Uncomment the next line
#     $NT = '1';
#
# 
#
# Note: actually, you need only lock the source pools, not the
# entire VOB.  That way folks can still do everything except
# make branches, checkin and checkout (if doing so involves making a branch).
#
# Warning: this script will take a long time for a large VOB.
# Sorry, I can't give you a size / time factor. FYI, the
# check consists of a "find -all" and *for each element found*,
# a "ct desc" and a "ct dump".  Then there is a 
# a "lsvtree" and a couple of "ct dump's" and a construct_version
# type manager operation for each version of the element.
#
# It isn't necessary to lock the VOB being checked, however,
# not locking it may result in "false" errors (in the unlikely
# event that an element is changing -e.g., checkin, mkbranch-
# while it is being checked).
#

$ct='/usr/atria/bin/cleartool';

if ($NT) {
    $dev_null='NUL';
    $created_since="created_since(01-Jan-1970)";
} else {
    $dev_null='/dev/null';
    $created_since="'created_since(01-Jan-1970)'";
}

# force non-buffered output (so we see progress even when redirecting
# output to a file).
$| = 1;

sub parray {
    foreach (@_) {
	print $_, "\n";
    }
}

# cleartool command
# maintains global file handles CT_WRITE and CT_READ
#
sub cleartool {
    local($cmd) = @_;
    local($_);
    local($cmd_terminator) = ("ThisIsABadCommand");
    local(@response);

    # Spawn a cleartool process if we haven't yet done so
    if (! $spawned_ct) {
	pipe(CT_READ, CT_P_WRITE) || die("can't create pipe\n");
	local($oldfh) = select(CT_P_WRITE); $| = 1; select($oldfh);

	# redirect STDOUT to CT_P_WRITE, ditto for STDERR
	open(SAVED_STDOUT, ">&STDOUT") || die("can't dup stdout\n");
	close(STDOUT);
	open(STDOUT, "<&CT_P_WRITE") || die("can't redirect STDERR\n");

	open(SAVED_STDERR, ">&STDERR") || die("can't dup stderr\n");
	close(STDERR);
	open(STDERR, "<&CT_P_WRITE") || die("can't redirect STDERR\n");

	# spawn the cleatool and get a WRITE fh for its input.
	# Its output / errout is inherited from our (redirected) STD{OUT,ERR}
	open(CT_WRITE, "| $ct") || die("can't spawn $ct\n");
        $oldfh = select(CT_WRITE); $| = 1; select($oldfh);

	close(CT_P_WRITE);   # this isn't our side of the pipe

	# redirect STD{OUT,ERR} back to their original state
	close(STDOUT);
	open(STDOUT, ">&SAVED_STDOUT");
	close(SAVED_STDOUT);

	close(STDERR);
	open(STDERR, ">&SAVED_STDERR");
	close(SAVED_STDERR);

        $spawned_ct = "yes";
    }

    # Send the command.
    print CT_WRITE  $cmd, "\n";

    # Send a special piece of swill so we can recognize the end of the response
    print CT_WRITE  "$cmd_terminator", "\n";

    # Get the response
    while (<CT_READ>) {
	chop;
	last if (/$cmd_terminator/);
	push(@response, $_);
    }
    @response;
}

# obj_get_oid <obj_sel>
#
sub obj_get_oid {
    local($obj_sel) = @_;
    local(@_, $_, $oid);

    ($oid) = grep(/^oid=/, &cleartool("dump $obj_sel"));
    $oid || die("no oid for pname '$obj_sel'\n");
    $oid =~ /^oid=([^\s]+)/;
    $oid = $1;
    $oid || die("no oid for pname '$obj_sel'\n");
    $oid;
}

# ver_get_cntr <ver_xpn>
#
sub ver_get_cntr {
    local($ver_xpn) = @_;
    local(@_, $_, $cntr);

    ($cntr) = grep(/^source cont=/, &cleartool("dump $ver_xpn"));
    return 0 if (!$cntr);    # return nil for ndata versions
    $cntr =~ /^source cont="(.*)"/;
    $cntr = $1;
}

# ver_get_len <ver_xpn>
# assume this is only called for non-ndata versions
#
sub ver_get_len {
    local($ver_xpn) = @_;
    local(@_, $_, $cntr, $cltxt_len);

    ($cltxt_len, $junk) = grep(/^nlink:/, &cleartool("dump $ver_xpn"));
    return -1 if (!$cltxt_len);    # error
    $cltxt_len =~ /^.*; size: (.*); blsz: /;
    $cltxt_len = $1;
}

# ver_construct_cleartext <ver_xpn> <typemgr> <src_cntr> <cltxt_cntr_pname>
#
sub ver_construct_cleartext {
    local($ver_xpn, $typemgr, $src_cntr, $cltxt_cntr_pname) = @_;
    local(@_, $_, $ver_oid, $cmd);

    truncate($cltxt_cntr_pname, 0);

    if ($typemgr =~ /^whole_copy/) {
	system("/bin/cp $src_cntr $cltxt_cntr_pname");
    } else {
	($ver_oid) = &obj_get_oid($ver_xpn);

	$cmd = "/usr/atria/lib/mgrs/$typemgr/construct_version $src_cntr $cltxt_cntr_pname $ver_oid";
	# print ("$cmd\n");

	system($cmd);

	if ($? == 26112) { # MGR_CONSTRUCT_USE_NEW_FILE ??? should be 102
	    $? = 0; # success
	} elsif ($? == 101) { # MGR_CONSTRUCT_USE_SRC_CONTAINER
	    system("/bin/cp $src_cntr $cltxt_cntr_pname");
	}
    }

    if ($? != 0) { print("##### ERROR: unable to construct cleartext\n"); }
    return ($? != 0) ? -1 : 0; 
}

# elem_get_mgr <elem_xpn>
#
sub elem_get_mgr {
    local($elem_xpn) = @_;
    local(@_, $_, $eltype, $typemgr);

    ($eltype) = grep(/element type:/, &cleartool("desc $elem_xpn"));
    $eltype =~ /element type:\s+([^\s]+)/;
    $eltype = $1;

    $typemgr = $eltype_mgrs{$eltype};
    if (! $typemgr) {
	($typemgr) = grep (/type manager:/, &cleartool("desc -type $eltype"));
	$typemgr =~ /type manager:\s+([^\s]+)/;
	$typemgr = $1;
	$eltype_mgrs{$eltype} = $typemgr;
    }
    $typemgr || die("no typemgr for pname '$elem_xpn'\n");
    $typemgr;
}

###########
# main
###########

$cwd = `pwd`;
chop($cwd);
print "
##### checking all source containers for VOB at '$cwd' ...


***** IF THIS VOB ISN'T LOCKED, YOU CAN GET FALSE ERROR DETECTIONS *****

";

$nelems = 0;
$ncntrs = 0;

# find each element in the VOB and check it
#
if ( ! @ARGV ) {
   $find_path = "-all";
} else {
   $find_path = join(" ",@ARGV);
}

foreach (`$ct find $find_path -type f -print`) {
    chop;
    next unless $_;
    $ver_errors += &ck_elem($_);
}

print "\n##### checked $nelems elements\n\n";
if ($ver_errors != 0) {
    print "***************************\n";
    print "***** $ver_errors ERRORS DETECTED\n";
    print "***************************\n";
} else {
    print "******************\n";
    print "***** ALL OK *****\n";
    print "******************\n";
}
exit $exit_status;


sub ck_elem {
    local($elem_xpn) = @_;
    local($_, @stat_info, $ver_len, $cltxt_size);
    local($typemgr, $eltype, $cntr, $cltxt_cntr_pname, $ver_xpn, $ver_errors);

    $ver_errors = 0;
    $nelems++;

    # determine the element's type mgr
    #
    $typemgr = &elem_get_mgr($elem_xpn);

    # check all versions' cltxt length
    #
    # if it's a whole manager,
    #    just use its source container's length
    # otherwise
    #    need to access each of the element's versions
    #
    print "##### checking each non-ndata version of '$elem_xpn' (manager '$typemgr')...\n";
    foreach (`$ct find $elem_xpn -ver $created_since -print`) {
	chop;
	$ver_xpn = $_;
	next if ($ver_xpn =~ /CHECKEDOUT/);
	$cntr = &ver_get_cntr($ver_xpn);

	# ignore ndata versions
	#
	next if (!$cntr);

	# get the ver id string
	#
	$ver_xpn =~ /.*@@(.*)/;
	$ver_id_str = $1;

	# construct the version's cleartext
	#
	$cltxt_cntr_pname = '/tmp/junk_cleartext_container';
	if (&ver_construct_cleartext($ver_xpn, $typemgr, 
				     $cntr, $cltxt_cntr_pname)) {
	    $ver_errors++;
	    next;
	}

	# get the size of the constructed cleartext
	#
	@stat_info = stat($cltxt_cntr_pname);
	$cltxt_size = $stat_info[7];

	# get the VOB's idea of what the len should be
	#
	$ver_len = &ver_get_len($ver_xpn);

	if ($cltxt_size != $ver_len) {
	    print "##### ver *** ERROR ***: $ver_id_str\n";
	    print "----- cleartext size is $cltxt_size; should be $ver_len\n";
	    $ver_errors++;
	} else {
	    print "##### ver OK: $ver_id_str\n";
	}
    }

    if ($ver_errors != 0) {
	print "##### elem *** ERROR ***: $elem_xpn\n";
    } else {
	print "##### elem OK: $elem_xpn\n";
    }

    $ver_errors;
}

