I am having problems with dragging an item and dropping it on top of another using Perl/Tk.
Let me explain:
I have a form with 2 windows, on the left, a directory tree is displayed and on the right, I have a list of local groups. I would like to drag a group and drop it on a directory, so that I can add ACE permission for that group on the directory where it dropped. The problem is in the dragging and dropping on top of the DirTree. I am not sure why it’s not working (the code is not all mine, Saint .dave. helped me with it, so I am not certain on what I need to change).
The problems occure on subs DragStart and Drop.
Please your Enlightenment is required
use strict;
use Tk 800.005;
use Tk::TList;
use Tk::Frame;
use Tk::DirTree;
use Tk::Scrollbar;
use Tk::Adjuster;
use Tk::DragDrop;
use Tk::DropSite;
use Win32::Perms;
use Win32::AdminMisc;
use Win32::NetResource;
use vars qw /%tk %dr %im @groups $dnd_token/;
$tk{mw} = MainWindow->new (-background=>'white');
$tk{mw}->geometry('500x400');
$tk{top_frame} = $tk{mw}->Frame;
$tk{left_frame} = $tk{mw}->Frame;
$tk{adjuster} = $tk{mw}-> Adjuster(-widget=>$tk{left_frame},-side=>'le
+ft');
$tk{right_frame}=$tk{mw}->Frame;
$tk{dir_tree}= $tk{left_frame}->Scrolled('DirTree', -height=>'0', -wid
+th=>'0',-scrollbars=>'e',);
$tk{group_label}=$tk{right_frame}->Label(-text=>"Group List:");
$tk{group_list}= $tk{right_frame}->Scrolled('TList', -height=>'1', -wi
+dth=>'1', -scrollbars=>'osoe',);

$im{ONE}= $tk{mw}->Photo(-file=>'c:/perl/one.gif');
$im{GROUP}=$tk{mw}->Photo(-file=>'c:/perl/group.gif');

$dr{PATH}=shift @ARGV ;
$tk{dir_tree}-> chdir($dr{PATH});

$tk{dir_tree}->bind('<ButtonRelease-1>', sub{GetPerms();});

$tk{top_frame}->pack(qw/-side top -fill x/);
$tk{left_frame}->pack(qw/-side left -fill y/);
$tk{adjuster}->pack(qw/-side left -fill y/);
$tk{right_frame}->pack(qw/-side right -fill both -expand 1/);
$tk{group_label}->pack(qw/-side top -fill both/);
$tk{group_list}->pack (qw/-side top -fill both -expand 1/);
$tk{dir_tree}->pack(qw/-side left -fill both -expand 1/);

$dnd_token = $tk{group_list}->DragDrop (-event =>'<B1-Motion>', -sitet
+ypes=>[qw/Local/], -startcommand=>\ &DragStart,);
$tk{dir_tree}->DropSite (-droptypes=>[qw/Local/], -dropcommand=>[\ &Dr
+op, $tk{dir_tree}, $dnd_token],);

@groups = @{&GetGroups()};
map {$tk{group_list}->insert('end', -itemtype=>'imagetext', -text=>"$_
+", -image=>$im{GROUP})} @groups;

MainLoop;
exit(0);

sub DragStart{
    my ($token) = @_;
    my $w = $token->parent;
    my $e = $w->XEvent;
    my $idx = $w->GetNearst($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 Drop{
    my ($lb, $dnd_source) = @_;
    my $group_item = $dnd_source->cget('-text');
    my $y = $lb->pointery - $lb->rooty;
    my $x = $lb->pointerx - $lb->rootx;
    my $nearest = $lb->nearest($x,$y);
    if (defined $nearest){
        my $dir_item = $lb->entrycget($nearest, '-text');
        &AddGroupToDir($group_item, $dir_item);
        $lb->see($nearest);}}
sub GetPerms{
    my $path = $tk{dir_tree}->selectionGet();
    &ShowPathInfo($path);}
sub ShowPathInfo{
    my ($path)=@_;
    my $perms = new Win32::Perms($path)||die"\n$^E\n";
    print "\nPath: " . $perms->Path();
    my $counter = $perms->Get(\my @list);}
sub GetGroups{
    my ($srv);
    my (@local_groups);
    if (Win32::NetResource::GetUNCName(my $unc, $dr{PATH})){
        $unc =~ s/^\\\\(\w)+//;
        $srv = $&;
        print "\n Path is $dr{PATH} and server is: $srv\n";}
    else{
        $srv = Win32::NodeName();
        print "\nPath is $dr{PATH} and server is: $srv\n";}
    if (Win32::AdminMisc::GetGroups("$srv", GROUP_TYPE_LOCAL, \ @local
+_groups)){
        print "\n\nThis is the list of groups\n";
        foreach my $item (@local_groups){
            print "$item\n";}}
    return \ @local_groups;}
sub AddGroupToDir{
    my ($group,$dir)=@_;}

[download]

In reply to A Drag and Drop (perl/Tk) question. 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.