#!/usr/bin/perl

package Test;

use base qw(Tk::Frame);
use Tk::widgets qw(Canvas);
Construct Tk::Widget 'Test';

use strict;
use warnings 'all';

sub Populate
{
    my($frame, $args) = @_;

    # create Frame
    $frame->SUPER::Populate($args);

    # create Canvas
    my $canvas = $frame->Canvas(-background => "black")->pack();
    $frame->Advertise('canvas' => $canvas);

    # delegates and configspecs
    $frame->Delegates  (DEFAULT => $frame);
    $frame->ConfigSpecs(DEFAULT => [$canvas]);

    return $frame;
} # Populate

package main;

use strict;
use warnings 'all';
use Tk;

my $mw   = tkinit();
my $test = $mw->Test()->pack();

MainLoop;