The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package main;

use strict;
use warnings;

use File::Spec;
use Test::More 0.88;	# For done_testing();

my $my_user = eval { getlogin || getpwuid ($<) };

my $reactos = $^O eq 'MSWin32'
    && defined $ENV{OS} && lc $ENV{OS} eq 'reactos';

require_ok 'Win32::Process::Info'
    or BAIL_OUT;

eval {
    Win32::Process::Info->import();
    1;
} or BAIL_OUT 'Win32::Process::Info->import() failed';

is Win32::Process::Info::Version(), $Win32::Process::Info::VERSION,
    'Get our version';

foreach my $variant ( qw{ NT WMI PT } ) {

    SKIP: {

	my $tests = 10;

	my $prefix = "Variant $variant:";

	my $skip = Win32::Process::Info->variant_support_status( $variant );
	note "\nTesting variant $variant";
	$skip
	    and skip "$prefix $skip", $tests;

	my $pi = Win32::Process::Info->new (undef, $variant);
	ok $pi, "Instantiate variant $variant."
	    or skip "Failed to instantiate $variant", --$tests;

	ok eval { $pi->Set( elapsed_in_seconds => 1 ) },
	    "$prefix Ask for elapssed time in seconds";

	my $my_pid = $pi->My_Pid();

	my @pids = $pi->ListPids();
	ok scalar @pids, "$prefix Ability to list processes";

	my @mypid = grep { $my_pid eq $_ } @pids;
	ok scalar @mypid, "$prefix Our own PID should be in the list";


	my @pinf = $pi->GetProcInfo();
	ok scalar @pinf, "$prefix Ability to get process info";

	my ( $me ) = $pi->GetProcInfo( $my_pid );
	ok $me, "$prefix Ability to get our own info";

	SKIP: {
	    defined $me
		and defined $me->{Name}
		or skip "$prefix Could not get process name", 1;

	    like $me->{Name}, qr{ perl }smxi,
		"$prefix Own process should be running Perl.";
	}


	SKIP: {

	    defined $my_user
		or skip "Can not determine username under $^O", 1;

	    defined $me
		and defined $me->{Owner}
		or skip "$prefix Could not get process owner", 1;

	    TODO: {
		local $TODO;
		$reactos
		    and $TODO = 'Process ownership broken under ReactOS';

		my ( $domain, $user ) = split qr{ \\ }smx, $me->{Owner};
		is $user, $my_user,
		    "$prefix Our own process should be under our username";
	    }
	}

	SKIP: {

	    my $skip_sub = 2;

	    my $dad;
	    eval {
		$dad = getppid;
		$^O eq 'cygwin'
		    and $variant ne 'PT'
		    and $dad = Cygwin::pid_to_winpid( $dad );
		1;
	    } or skip 'getppid not implemented or broken', $skip_sub;

	    $variant eq 'NT'
		and skip 'Subprocesses not supported by NT variant',
		    $skip_sub;

	    my %subs = $pi->Subprocesses( $dad );
	    ok $subs{$my_pid},
		"$prefix Call Subprocesses() and see if $my_pid is a subprocess of $dad";

	    my ( $pop ) = $pi->SubProcInfo( $dad );
	    my @subs = @{ $pop->{subProcesses} || [] };
	    my $bingo;
	    while ( @subs ) {
		my $proc = shift @subs;
		if ( $proc->{ProcessId} eq $my_pid ) {
		    $bingo++;
		    last;
		} else {
		    push @subs, @{ $proc->{subProcesses} };
		}
	    }
	    ok $subs{$my_pid},
		"$prefix Call SubProcInfo() and see if $my_pid is a subprocess of $dad";

	}

    }

}

done_testing;

1;