The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w
# -*- perl -*-

#
# $Id: 10-xterm.t,v 1.5 2008/10/01 21:23:14 eserte Exp $
# Author: Slaven Rezic
#

use strict;
use FindBin;

BEGIN {
    if (!eval q{
	use Test::More;
	use File::Temp qw(tempfile);
	1;
    }) {
	print "1..0 # skip: no Test::More and/or File::Temp module\n";
	exit;
    }
}

my @xterm_likes = qw(xterm rxvt urxvt);

my $tests = 2;
plan tests => $tests * @xterm_likes;

my(undef,$file) = tempfile(UNLINK => 1);

for my $xterm (@xterm_likes) {
 SKIP: {
	skip("No $xterm and/or DISPLAY on this system available", $tests)
	    if (!is_in_path("$xterm") || !$ENV{DISPLAY});

	system($xterm, "-geometry", "+10+10", "-e", $^X, "-e", q{print STDERR "# $xterm can be started\n"});
	skip("Cannot start $xterm", $tests)
	    if $? != 0;

	if ($xterm eq 'rxvt' || $xterm eq 'urxvt') {
	    my $rxvt_version;
	    if ($xterm eq 'rxvt') {
		my $help_output = `$xterm --help 2>&1`;
		for my $l (split /\n/, $help_output) {
		    next if $l eq '';
		    last if $l =~ m{^rxvt.*options.*command};
		    $rxvt_version .= $l . "\n";
		}
	    } elsif ($xterm eq 'urxvt') {
		my $help_output = `$xterm --help 2>&1`;
		for my $l (split /\n/, $help_output) {
		    next if $l eq '';
		    last if $l =~ m{^Usage.*urxvt.*options};
		    $rxvt_version .= $l . "\n";
		}
	    }
	    diag("\n$xterm\n$rxvt_version");
	} else {
	    my $xterm_version;
	    $xterm_version = `$xterm -v`;
	    diag("\n$xterm version $xterm_version");
	}

	system($xterm, "-xrm", "*allowWindowOps:true", "-T", "XTerm::Conf test suite", "-geometry", "+10+10", "-e", $^X, "$FindBin::RealBin/10-xterm.pl", $file);
	
	open FH, "< $file"
	    or die "Can't open $file: $!";
	chomp(my $success = join "", <FH>);
	is($success, "success", "live $xterm tests");

	system($xterm, "-xrm", "*allowWindowOps:false", "-T", "XTerm::Conf test suite", "-geometry", "+10+10", "-e", $^X, "$FindBin::RealBin/11-xterm.pl", $file);
	pass("No hangs if $xterm is running with allowWindowOps:false");
    }
}

# REPO BEGIN
# REPO NAME is_in_path /home/e/eserte/work/srezic-repository 
# REPO MD5 e18e6687a056e4a3cbcea4496aaaa1db

=head2 is_in_path($prog)

=for category File

Return the pathname of $prog, if the program is in the PATH, or undef
otherwise.

DEPENDENCY: file_name_is_absolute

=cut

sub is_in_path {
    my($prog) = @_;
    if (file_name_is_absolute($prog)) {
	if ($^O eq 'MSWin32') {
	    return $prog       if (-f $prog && -x $prog);
	    return "$prog.bat" if (-f "$prog.bat" && -x "$prog.bat");
	    return "$prog.com" if (-f "$prog.com" && -x "$prog.com");
	    return "$prog.exe" if (-f "$prog.exe" && -x "$prog.exe");
	    return "$prog.cmd" if (-f "$prog.cmd" && -x "$prog.cmd");
	} else {
	    return $prog if -f $prog and -x $prog;
	}
    }
    require Config;
    %Config::Config = %Config::Config if 0; # cease -w
    my $sep = $Config::Config{'path_sep'} || ':';
    foreach (split(/$sep/o, $ENV{PATH})) {
	if ($^O eq 'MSWin32') {
	    # maybe use $ENV{PATHEXT} like maybe_command in ExtUtils/MM_Win32.pm?
	    return "$_\\$prog"     if (-f "$_\\$prog" && -x "$_\\$prog");
	    return "$_\\$prog.bat" if (-f "$_\\$prog.bat" && -x "$_\\$prog.bat");
	    return "$_\\$prog.com" if (-f "$_\\$prog.com" && -x "$_\\$prog.com");
	    return "$_\\$prog.exe" if (-f "$_\\$prog.exe" && -x "$_\\$prog.exe");
	    return "$_\\$prog.cmd" if (-f "$_\\$prog.cmd" && -x "$_\\$prog.cmd");
	} else {
	    return "$_/$prog" if (-x "$_/$prog" && !-d "$_/$prog");
	}
    }
    undef;
}
# REPO END

# REPO BEGIN
# REPO NAME file_name_is_absolute /home/e/eserte/work/srezic-repository 
# REPO MD5 89d0fdf16d11771f0f6e82c7d0ebf3a8

=head2 file_name_is_absolute($file)

=for category File

Return true, if supplied file name is absolute. This is only necessary
for older perls where File::Spec is not part of the system.

=cut

BEGIN {
    if (eval { require File::Spec; defined &File::Spec::file_name_is_absolute }) {
	*file_name_is_absolute = \&File::Spec::file_name_is_absolute;
    } else {
	*file_name_is_absolute = sub {
	    my $file = shift;
	    my $r;
	    if ($^O eq 'MSWin32') {
		$r = ($file =~ m;^([a-z]:(/|\\)|\\\\|//);i);
	    } else {
		$r = ($file =~ m|^/|);
	    }
	    $r;
	};
    }
}
# REPO END


__END__