I can think of a few possible ways to do that... though they all require a few contortions. Easiest is probably to use addtag. The canvas addtag method has a few nice search options; (nearest, overlapping. enclosed) that should be useful. Add a tag 'current' (or whatever) to the item, use that tag to process it, then delete the 'current' tag.

Like so:

#!/usr/bin/perl

use Tk;
my $mw = MainWindow->new;
my $c  = $mw->Canvas(
    qw/-width 20c -height 15c -relief sunken
      -borderwidth 2/
);
$c->pack(qw/-expand yes -fill both/);

$c->createPolygon(
    qw/5c 4c 5c 7c 5c 1c 6c 1c 7c 4c 8c 1c 9c 1c
      9c 4c 5c 4c -smooth on -tags item1/, -fill => 'red'
);
$c->createRectangle(
    qw/1c 9.5c 4c 12.5c/,
    -outline => 'red',
    qw/-width 3m -tags item2/
);
$c->createLine(
    qw/1c 1c 3c 1c 1c 4c 3c 4c -width 2m/,
    -fill => 'blue',
    qw/-cap butt -join miter -tags item3/
);

$c->createLine(
    qw/1c 7c 1.75c 5.8c 2.5c 7c 3.25c 5.8c 4c 7c -width .5c
      -cap round -join round -tags item4/
);

$c->createLine(
    qw/1c 4c 1.5c 1c 3.5c 1c 4c 4c -smooth on/,
    -fill => $blue,
    qw/-tags item5/
);
$c->createLine(
    qw/11.5c 1c 15.5c 1.5c 11.5c 4.5c 15.5c 4c -smooth on
      -arrow both -width 3 -tags item6/
);

$c->createPolygon(
    qw/8c 8.0c 9.5c 8.75c 11c 8.0c 10.25c 9.5c 11c 11.0c
      9.5c 10.25c 8c 11.0c 8.75c 9.5c -tags item7/,
    -fill => 'green'
);

$c->createOval(
    qw/5.5c 8.5c 4.5c 6.5c/,
    -fill => 'green',
    qw/-tags item8/
);

$c->CanvasBind(
    '<1>' => sub {
        my ($c) = @_;
        print get_current( $c, $Tk::event->x, $Tk::event->y ), "\n";
    }
);

MainLoop;

sub get_current {
    my ( $c, $x, $y ) = @_;
    $c->addtag( qw/current closest/, $x, $y );
    my @tags = grep {$_ ne 'current'} $c->gettags(qw/current/);
    $c->dtag(qw/current current/);
    return @tags;
}
[download]

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

my $top = new MainWindow;

my $c=$top->Canvas->pack;

my $circle = $c->createOval(30,30,100,100,
               -fill => 'blue',  
               -tags =>['circle'],
               -stipple => 'gray12',
          );

my $rect1 = $c->createRectangle(10,10,44,44,
               -fill => 'green',  
               -stipple => 'gray12',
               -tags =>['rect1'],
              );


my $rect2 = $c->createRectangle(93,93,200,200,
               -fill => 'yellow',  
               -tags =>['rect2'],
               -stipple => 'gray12',
           );

my $poly1 = $c->createPolygon(0,0, 44,44, 55,55, 90,90, 200,200, 10,10
+0,0,0,
                    -fill => 'red',
            -smooth => 1,       
                    -splinesteps => 100,
            -stipple => 'gray12',
            -tags =>['poly1'],
            );

$c->Tk::bind("<Motion>", [ \&print_xy, Ev('x'), Ev('y') ]);

$c->CanvasBind('<B1-ButtonRelease>', [ \&add_something, Ev('x'), Ev('y
+') ]); 

&print_xy($c, 42,42);

MainLoop;

sub print_xy {
  my ($canv, $x, $y) = @_;
 print "(x,y) = ", $canv->canvasx($x), ", ", $canv->canvasy($y), "\n";
#my $x1 = $x+1;
#my $y1 = $y+1;
#it will actually use a zero size rectangle
my (@current) = $canv->find('overlapping', $x, $y, $x, $y);

foreach my $id(@current){ 
    print $canv->gettags($id),' ';
 }
print "\n";

}


sub add_something {
  my ($canv, $x, $y) = @_;
 print "(x,y) = ", $canv->canvasx($x), ", ", $canv->canvasy($y), "\n";

my $current = $canv->find(qw/withtag current/);
$canv->addtag('aTimeTag'.time, 'withtag', $current);

print join ' ', $canv->gettags($current);
print "\n";

}
[download]

This worked for me!

All of my canvas objects have an inherant unique ID because they are the physical representation of a whole bunch of stuff in a database. As a result, they all have a tag that contains their ID prefixed with "C_" (e.g., "C_38472").

As a result, the code below does it all for me. I can see what is directly under the cursor when this code runs.

    my $mainitemid
    my @CurTags = canvas->gettags('current');
    for my $tag (@CurTags)
    {
        my $itag = ($tag =~ "C_");
        print "$tag,  $itag\n";
        if ($tag =~ "C_")
        {
            $mainitemid = substr($tag, 2);
        }
    }
[download]

By reassembling C_$ID I can get a tag that I can use to act upon that object.

Thanks for your help,
Perldough