#!/usr/bin/perl
use warnings;
use strict;
use Tk;

my $tl;
my $mw = MainWindow->new;
$mw->title( "MainWindow" );
$mw->Button( -text => "Toplevel", -command => \&do_Toplevel )->pack();

$mw->Button( -text => "Check Mapping", -command => \&check_mapping )->
+pack();

&do_Toplevel;

MainLoop;

sub check_mapping{

if ($tl->ismapped){
               print "toplevel is mapped\n"
       } else {
          print "toplevel is unmapped\n"
    }
}


sub do_Toplevel {
    if ( !Exists( $tl ) ) {
        $tl = $mw->Toplevel();
        $tl->geometry('300x100+100+100');
        $tl->title( "Toplevel" );
        $tl->Button(
            -text    => "Close",
            -command => sub { $tl->withdraw }
        )->pack;
    }
    else {
        $tl->deiconify();
        $tl->raise();
    }
}
[download]