Greetings

I am having “Kittens” with this drag and drop functions on this Perl/Tk sub routine.

The error I get is this:
Tk::Error: Can't call method "GetNearest" on an undefined value at C:\
+Perl\hd16.pl line 66.
 main::DropGlobalGroup at C:\Perl\hd16.pl line 66
 Tk::DropSite::Apply at C:/Perl/site/lib/Tk/DropSite.pm line 66
 Tk::DropSite::Drop at C:/Perl/site/lib/Tk/DropSite.pm line 75
 Tk::DragDrop::Drop at C:/Perl/site/lib/Tk/DragDrop.pm line 285
 (command bound to event)

[download]
Basically I have a list of global groups on the right frame and on the left is a list of local groups, the drag&drop fuctions should allow me to drag a global group and drop it on to a local group. I have no problems with the mechanism for adding Global groups to local groups, however before I actually incorporate this mechanism into my script I need to get the drag and drop factions to work properly.
I have included the full script so that if you do decide to help me with this then you should be able to run the script and see the error.

Also, if the drop occurs anywhere else apart from where it was meant to, how can I get the script to issue an error?

Thanks for your help (in advance). 

require 5.006;

use strict;
use warnings 'all';

use Tk 800.005;
use Tk::TList;
use Tk::Table;
use Tk::Frame;
use Tk::DirTree;
use Tk::Adjuster;
use Tk::Scrollbar;
use Tk::DropSite;
use Tk::DragDrop;

use File::Find;

use OLE;
use Win32;
use Win32::ODBC;
use Win32::Perms;
use Win32::NetAdmin;
use Win32::AdminMisc;
use Win32::NetResource;

use vars  qw/%tk %dr %im $counter $dnd_token2/;

$counter = 0;
$dr{domain} = 'RABOUK';
sub GetServer{
    if (Win32::NetResource::GetUNCName(my $unc, $dr{path})){
        $unc =~ m/^\\\\([^\\]+)\\/;
        $dr{server} = uc $1;    }
    else{
        $dr{server} = Win32::NodeName();    }}
sub DragStart{
    my ($token) = @_;
    my $w = $token-> parent;
    my $e = $w-> XEvent;
    my $idx = $w-> GetNearest($e->x, $e->y);
    if (defined $idx){
        $token-> configure(-text=> $w-> entrycget($idx,'-text'));
        my ($X, $Y) = ($e-> X, $e-> Y);
        $token-> MoveToplevelWindow($X, $Y);
            $token-> raise;
            $token-> deiconify;
            $token-> FindSite($X, $Y, $e);}}
sub DropGlobalGroup{
    my ($lb, $dnd_source, $c_dest, $sel, $dest_x, $dest_y) = @_;
    my $globalgroup_item = $dnd_source->cget('-text');
    my $nearest = $lb->GetNearest($dest_x, $dest_y);
    if (defined $nearest){
        my $localgroup_item = $lb->entrycget($nearest, '-text');
        print "\n****** $globalgroup_item : $localgroup_item ******\n"
+;    ### DEBUG: Show target value
        $lb->see($nearest); }
    else{
Win32::MsgBox("Try Again",0x00000000|0x00000040|0x00000000,"Drop failu
+re"); }}
if (Win32::NetAdmin::GetDomainController('', $dr{domain}, my $pdc)){
    $pdc =~ m/^\\\\([^\\]+)/;
    $dr{pdc} = uc $1;
    print "\nAccessing Domain Controller '$dr{pdc}' for domain '$dr{do
+main}'\n";}
$tk{mw} = MainWindow -> new(-background=> 'white');
$tk{mw}-> geometry('950x700');
$tk{top_frame} = $tk{mw}-> Frame;
$tk{left_frame} = $tk{mw}-> Frame;
$tk{adjuster} = $tk{mw}-> Adjuster(-widget=> $tk{left_frame}, -side=> 
+'left');
$tk{right_frame} = $tk{mw}-> Frame;
$tk{bottom_frame} = $tk{mw}-> Frame;
$tk{globalgroup_list} = $tk{right_frame}-> Scrolled('TList', -height=>
+ '1', -width=> '1', -scrollbars=> 'osoe',);
$tk{localgroup_list}= $tk{left_frame}->Scrolled('TList',     -height=>
+'1',     -width=>'1', -scrollbars=>'osoe',);

$im{usr} = $tk{mw}-> Photo(-file=> 'c:/perl/usr.gif');
$im{lgrp} = $tk{mw}-> Photo(-file=> 'c:/perl/lgrp.gif');
$im{ggrp} = $tk{mw}-> Photo(-file=> 'c:/perl/ggrp.gif');
#$tk{top_frame}-> pack(qw/-side top -fill x/);
$tk{left_frame}-> pack(qw/-side left -fill y/);
#$tk{bottom_frame}-> pack(qw/-side bottom -fill x/);
$tk{adjuster}-> pack(qw/-side left -fill y/);
$tk{right_frame}-> pack(qw/-side right -fill both -expand 1/);
$tk{localgroup_list}-> pack(qw/-side left -fill both -expand 1/);
$tk{globalgroup_list}-> pack(qw/-side right -fill both -expand 1/);
$dr{path} = "C:\\";
$dr{server} = GetServer($dr{path});
$dr{perms} = "Permissions " . $dr{path};
if (Win32::AdminMisc::GetGroups("\\\\" . "$dr{pdc}", GROUP_TYPE_GLOBAL
+, \ my @global_groups)){
    map {$tk{globalgroup_list}->insert('end', -itemtype=>'imagetext', 
+-text=>"$_", -image=>$im{ggrp}) } @global_groups;}
else{
    die "\n$^E\n";}
if (Win32::AdminMisc::GetGroups("\\\\" . "$dr{server}", GROUP_TYPE_LOC
+AL, \ my @local_groups)){
    map {$tk{localgroup_list}-> insert('end', -itemtype=> 'imagetext',
+ -text=> "$_", -image=> $im{lgrp}) } @local_groups;
    $counter = $#local_groups;}
else{
    die "\n$^E\n";}
$dnd_token2 = $tk{globalgroup_list}->DragDrop(-event=> '<B1-Motion>', 
-sitetypes=> [qw/Local/], -startcommand=> \ &DragStart,);
$tk{localgroup_list}-> DropSite(-droptypes=> [qw/Local/], -dropcommand
+=> [\ &DropGlobalGroup, $tk{Localgroup_list}, $dnd_token2],);
MainLoop;
exit(0);

[download]

In reply to Tk Drag&Drop Problem. by blackadder

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.