#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use open ':utf8';
use Carp;
use English qw( -no_match_vars );
use File::Spec::Functions;
use Benchmark qw(cmpthese timethese);
use charnames ();

# use a Unicode Characters Database representation as test file
my $ucd = catfile( $ENV{TMPDIR} || $ENV{TMP} || '/tmp', 'ucd.txt' );

# terminal emulators
my %terminals = (
    ATerm         => [qw( aterm -e          )],
    ETerm         => [qw( Eterm -e          )],
    GnomeTerminal => [qw( gnome-terminal -x )],
    KDEKonsole    => [qw( konsole -e        )],
    MRXVT         => [qw( mrxvt -e          )],
    RXVT          => [qw( rxvt -e           )],
    URXVT         => [qw( urxvt -e          )],
    WTerm         => [qw( wterm -e          )],
    XFCETerminal  => [qw( Terminal -x       )],
    XTerm         => [qw( xterm -e          )],
);

# generate Unicode Characters Database file
if ( !-f $ucd ) {
    open my $fh, '>', $ucd
        or croak "Can't open '$ucd' for writing: $OS_ERROR\n";
    local $OUTPUT_FIELD_SEPARATOR  = $LIST_SEPARATOR x 2;
    local $OUTPUT_RECORD_SEPARATOR = "\n";
    for ( 0x0020 .. 0xffff ) {
        print {$fh} chr($_), $_, charnames::viacode($_)
            or croak "Can't write to '$ucd': $OS_ERROR\n";
    }
    close $fh or croak "Can't close '$ucd': $OS_ERROR\n";
}

# "system" helper (used for filtering out unavailable commands)
sub which {
    my $name = shift || return;

    # full path already provided
    return $name if $name =~ m{/} && -f $name && -x $name;

    # search through PATH
    for ( split /:/, $ENV{PATH} ) {
        my $fpath = catfile( $_, $name );
        return $fpath if -r $fpath && -x $fpath;
    }
    return;
}

# benchmarking methods "storage" ;-)
my $methods = {};

# keep only available terminal emulators
while ( my ( $name, $args ) = each %terminals ) {
    my $cmd = which( shift @{$args} );
    if ($cmd) {
        $terminals{$name} = [ $cmd, @{$args} ];
        $methods->{$name} = sub {
            system $cmd, @{$args}, 'cat', $ucd;
        };
    }
    else {
        delete $terminals{$name};
    }
}

# really ugly Benchmark.pm hack :(
# build a "cumulated time" summing "this process" and "child processes" times
#my $res = timethese(1, {test => $methods->{tk} } );
my $res = timethese( shift || 1, $methods );
for my $bm ( values %{$res} ) {
    $bm->[1] += $bm->[3];
    $bm->[2] += $bm->[4];
    $bm->[3] = $bm->[4] = 0;
}
cmpthese($res);

=head1 NAME

vtemu-benchmark - Testing X-Window VT terminal emulators speed

=head1 SYNOPSIS

./vtemu-benchmark.pl [number-of-iterations]

=head1 DESCRIPTION

This is just a late night toy, stirred by Martin Ankerl's musings:
I<Comprehensive Linux Terminal Performance Comparison>,
L<http://martin.ankerl.com/2007/09/01/comprehensive-linux-terminal-performance-comparison/>

=head1 AUTHOR

Marius Feraru C<< <altblue@n0i.net> >>.

=head1 LICENSE AND COPYRIGHT

Copyright (c) 2007, Marius Feraru C<< <altblue@n0i.net> >>.
All rights reserved.

This toy is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.

=cut