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

use strict;
use warnings;

use Test::More tests => 20;
use Test::NoWarnings;

BEGIN {
    use_ok ("Tk");
    use_ok ("Tk::Clock");
    }

my ($delay, $period, $m, $c) = (0, $ENV{TK_TEST_LENGTH} || 5000);
$m = eval { MainWindow->new  (-title => "clock", -background => "Black"); } or
    skip_all ("No valid Tk environment");

my %defconfig = (
    -background	=> "Black",

    useDigital	=> 1,
    autoScale	=> 1,
    useAnalog	=> 1,
    useInfo	=> 1,
    ana24hour	=> 0,
    secsColor	=> "Green",
    tickColor	=> "Blue",
    tickFreq	=> 1,
    timeFont	=> "{fixed} 11",
    timeColor	=> "lightBlue",
    timeFormat	=> "HH:MM:SS",
    dateFont	=> "{fixed} 11",
    dateColor	=> "#cfb53b",
    infoFont	=> "{Helvetica} 11 bold",
    );

ok (my $c1 = $m->Clock (%defconfig),			"Clock Local TimeZone");
like ($c1->config ((
    anaScale   => 200,
    infoFormat => "Omega",
    handColor  => "Red",
    timeZone   => $ENV{TZ} || undef,
    dateFormat => "Local",
    )), qr(^Tk::Clock=HASH), "config");
ok ($c1->grid (-column => 0, -row => 0, -sticky => "news"), "grid");

ok (my $c2 = $m->Clock (%defconfig),			"Clock GMT");
like ($c2->config (
    anaScale   => 200,
    infoFormat => "Hc:Mc:Sc",
    infoFont   => "{DejaVu Sans} 10",
    timerValue => 12345,	# 04:25:45
    handColor  => "Orange",
    timeZone   => "GMT",
    dateFormat => "London (GMT)",
    ), qr(^Tk::Clock=HASH), "config");
ok ($c2->grid (-column => 0, -row => 1, -sticky => "news", -padx => 20), "grid");

ok (my $c3 = $m->Clock (%defconfig),			"Clock MET-1METDST");
like ($c3->config (
    anaScale   => 200,
    infoFormat => "HH:MM:SS",
    handColor  => "Yellow",
    timeZone   => "MET-1METDST",
    dateFormat => "Amsterdam (MET)",
    ), qr(^Tk::Clock=HASH), "config");
ok ($c3->grid (-column => 1, -row => 0, -sticky => "news", -pady => 20), "grid");

ok (my $c4 = $m->Clock (%defconfig),			"Clock Tokyo");
like ($c4->config (
    anaScale   => 200,
    countDown  => 1,
    useLocale  => ($^O eq "MSWin32" ? "Japanese_Japan.932" : "ja_JP.utf8"),
    infoFormat => "ddd mmm",
    handColor  => "Yellow",
    timeZone   => "Asia/Tokyo",
    dateFormat => "Asia/Tokyo",
    ), qr(^Tk::Clock=HASH), "config");
ok ($c4->grid (-column => 1, -row => 1, -sticky => "news", -padx => 20, -pady => 20), "grid");

for (0..1) {
    $m->gridColumnconfigure ($_, -weight => 1);
    $m->gridRowconfigure    ($_, -weight => 1);
    }

$delay += 5 * $period;
$c3->after ($delay, sub {
    $_->destroy for $c1, $c2, $c3, $c4;
    ok (!Exists ($_), "Destroy Clock") for $c1, $c2, $c3, $c4;
    $m->destroy;
    ok (!Exists ($m), "Destroy Main");
    exit;
    });

MainLoop;