blackadder has asked for the wisdom of the Perl Monks concerning the following question:

Greetings fellow Monks

The following Tk based form will create three frames (well 4 frames but the one at the top is not significant), the frame on the left will display a directory tree structure and the frame on the right will display snap shot of permissions and the frame underneath this one will contain all global groups. So when a directory is selected, by pointing the mouse and clicking once on the target object, a display of the permissions on that selected directory will be displayed on the right frame….Simple eh?

However, I have the following issued:

1- How can bind the double click actions? So if I double click on an account icon on the right frame, this will invoke a certain procedure (like removing the permission recursively –I have no problem with the recursive permission removal, however I can’t get the double click action to work (return the selection i.e. the account name).


2- How can I get the frame on the right to display the data in a table form? At the moment the script will only get the account name that is permissioned to access the selected directory and it will stick an icon next to it depending if the account is a use or local/global groups. I would like to enumerate the access rights and some other information and have them displayed diagonally.

3- Because the permissions displayed on the right frame can contain users, local and global groups. How can I restrict the script to only pick the user type account and not be able to pick any other account apart from the users?

4- The extra frame will contain a listing of all global groups available. How can I restrict the drop and drag action so that it will only drag from the first frame on the right and only be able to drop in the extra frame on the right also.

Many Thanks for your help and “perls of wisdom” in advance.

Yours Blackadder

PS : if you cut and paste this script don’t forget to change the domain name 
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::FileSecurity;
use Win32::NetResource;
use Win32API::File;

# $tk{widget_refs}, $dr{data_refs}, $im{image_refs}
use vars qw/%tk %dr %im @global_groups @local_groups $counter $dnd_tok
+en1 $dnd_token2 $dnd_token3/;
$counter = 0;
$dr{domain} = 'MyDomain';

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; # $w is the source listbox
    my $e = $w->XEvent;
    my $idx = $w->GetNearest($e->x, $e->y); # get the listbox entry un
+der cursor
    if (defined $idx)  {
            # Configure the dnd token to show the listbox entry
            $token->configure(-text => $w->entrycget($idx, '-text') );
            # Show the token
            my($X, $Y) = ($e->X, $e->Y);
            $token->MoveToplevelWindow($X, $Y);
            $token->raise;
            $token->deiconify;
            $token->FindSite($X, $Y, $e);  }}

sub DropUserOnGroup{
    my ($lb, $dnd_source) = @_;
    my $usr_item = $dnd_source->cget('-text');
    # figure out where in the group listbox the drop occurred
    my $y = $lb->pointery - $lb->rooty;
    my $x = $lb->pointerx - $lb->rootx;
    my $nearest = $lb->nearest($x,$y);
    if (defined $nearest) {
            my $ggrp_item = $lb->entrycget($nearest, '-text');
            my $rsp =Win32::MsgBox("Adding User to Global Group,\n\n\n
+User: '$usr_item'\n\nTo\n\nGlobal Group: '$ggrp_item'\n", 0x00000004|
+0x00000020|0x00001000,    "Group ACE permission");
            &AddUserToGroup($usr_item, $ggrp_item)  if (0x06==$rsp);
            $lb->see($nearest);}
        else{
            Win32::MsgBox("Try again",0x00000000|0x00000040|0x00000000
+,"Drop failure");}}

sub GetPerms{
    my $path = $tk{dir_tree}->selectionGet();    
    &ShowPathInfo($path);}

#sub GetUser{
    #my $usr = $tk{output_list}-> curselection();
    #print "\nSelected user '$usr'\n";}

# This method is bound to the 'enter' key so that we can update
# the path information from the entry widget.
sub OnNewPath
{
    $tk{dir_tree}-> delete('all');
    $tk{dir_tree}->chdir( $dr{path} );
    &ShowPathInfo( $dr{path} );
    GetServer($dr{path});
    $tk{localgroup_list}-> delete('0',"$counter");    
    @local_groups = ();
    Win32::AdminMisc::GetGroups("\\\\" . "$dr{server}", GROUP_TYPE_LOC
+AL, \ @local_groups) || die "\n$^E\n";
    $counter = $#local_groups;
    $tk{localgroup_list}-> delete('0.1',"$counter");    
    map {$tk{localgroup_list}->insert('end', -itemtype=>'imagetext', -
+text=>"$_", -image=>$im{lgrp}) } @local_groups;}

sub ShowPathInfo{
    my ($path) = @_;
    my %perms;   
    print "Path: $path \n";
    $dr{perms} = "Permisssions: $path";
    $tk{output_list}-> delete('0.1','end');
    $tk{output_list}-> insert('end', -itemtype=> 'text', -text=> "***Y
+OU CAN ONLY DRAG USER NOT GROUPS***\tPath [$path]");
    Win32::FileSecurity::Get($path, \ %perms) || warn "\n$^E : $!\n";
    while (my ($ACL_owner, $mask)= each %perms)    {
        print "\n$ACL_owner $dr{pdc}\n";
        $ACL_owner =~ s{.+\\}{};
        Win32::FileSecurity::EnumerateRights($mask, \ my @perms) || wa
+rn "\n$^E : $!\n";
        #my $rights = $perms[$#perms];
        #my $desc = "$&" . $ACL_owner ."\t\t\tEnum Rights: " . $rights
+;
        if (Win32::NetAdmin::UsersExist("\\\\" . $dr{pdc}, $ACL_owner)
+)    {
            $tk{output_list}->insert('end', -itemtype=>    'imagetext'
+, -text=> $ACL_owner, -image=> $im{usr});}
        else{
            if ($& =~ /RABOUK/i){
                $tk{output_list}->insert('end', -itemtype=>    'imaget
+ext', -text=> $ACL_owner, -image=> $im{ggrp});}
            else{
                $tk{output_list}->insert('end', -itemtype=>    'imaget
+ext', -text=> $ACL_owner, -image=> $im{lgrp});}}}}

sub AddUserToGroup {
    my ($usr, $grp) = @_;
    my $result = Win32::NetAdmin::GroupAddUsers("\\\\"."londcn0001", $
+grp, $usr);
    if ($result){
        my $msg = ("Account: '$usr' was added to: '$grp'");
        Win32::MsgBox($msg,0x00000000|0x00000040|0x00000000,"Operation
+ Successful");}
else{        
    my $error = ("Failed to add '$usr' to '$grp'\n\n***PLEASE CONTACT 
+THE ADMINISTRATOR***\n");
    Win32::MsgBox($error,0x00000000|0x00000040|0x00000000,"Operation F
+ailed");}    
    print "\n$usr, $grp\n";}

if (Win32::NetAdmin::GetDomainController('', $dr{domain}, my $pdc)){
    $pdc =~ m/^\\\\([^\\]+)/;
    $dr{pdc} = uc $1;
    my $msg = "Accessing Domain Controller $dr{pdc} for domain $dr{dom
+ain}";
    my $lngth =  "*" x length $msg;
    print "\n\n\t$msg\n\t$lngth\n";}

$dr{path} = "C:\\";
$dr{server} = GetServer($dr{path});
$dr{perms} = "Permissions " . $dr{path};

$tk{mw} = MainWindow->new(-background => 'white');
$tk{mw}->geometry('950x800');

$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{entry_box_label} = $tk{top_frame}-> Label(-text=> "Path: ");
$tk{entry_box} = $tk{top_frame}-> Entry(-textvariable=> \ $dr{path});

$tk{dir_tree_label} = $tk{left_frame}-> Label(-textvariable=> \ $dr{se
+rver});
$tk{dir_tree} = $tk{left_frame}-> Scrolled('DirTree', -height=> '0', -
+width=> '0', -scrollbars=>'e',);

$tk{output_label} = $tk{right_frame}->Label(-textvariable => \$dr{perm
+s});
$tk{output_list} = $tk{right_frame}->Scrolled('TList', -height=>'1', -
+width=>'1',  -scrollbars=>'osoe',);

$tk{globalgroup_label} = $tk{right_frame}-> Label(-text=> "Global Grou
+ps List [ Domain: " . $dr{domain} . ", PDC: " . $dr{pdc} . " ]");
$tk{globalgroup_list} = $tk{right_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{dir_tree}->bind('<ButtonRelease-1>',sub {GetPerms();});

#I am having problem with the folowing line
#$tk{output_list}->bind('<Double-Button-1>',sub { my $tk{output_list}-
+>selectionSet(); 
#                                                                     
+   my $selected_object = $tk{output_list}->get($indx);});
$tk{entry_box}->bind('<Key-Return>',sub {OnNewPath();});

$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{entry_box_label}-> pack(qw/-side left -fill both/);
$tk{entry_box}-> pack(qw/-side top -fill both -expand 1/);

$tk{dir_tree_label}-> pack(qw/-side top -fill both/);
$tk{dir_tree}-> pack(qw/-side left -fill both -expand 1/);

$tk{output_label}->pack(qw/-side top -fill both/);
$tk{output_list} ->pack(qw/-side top -fill both -expand 1/);

$tk{globalgroup_label}-> pack(qw/-side top -fill both/);
$tk{globalgroup_list}-> pack(qw/-side top -fill both -expand 1/);

$dnd_token1 = $tk{output_list}->DragDrop
    (-event=> '<B1-Motion>', -sitetypes=> [qw/Local/], -startcommand=>
+ \&DragStart,);
$tk{globalgroup_list}->DropSite (-droptypes     => [qw/Local/],
     -dropcommand   => [\&DropUserOnGroup, $tk{globalgroup_list}, $dnd
+_token1 ], ); 
if (Win32::AdminMisc::GetGroups("\\\\" . "$dr{pdc}", GROUP_TYPE_GLOBAL
+, \ @global_groups)){
    map {$tk{globalgroup_list}->insert('end', -itemtype=>'imagetext', 
+-text=>"$_", -image=>$im{ggrp}) } @global_groups;}
else{
    die "\n$^E\n";}

MainLoop;
exit 0;

[download]

Replies are listed 'Best First'.
Re: Tweaking Perl/Tk
by metlhed_ (Beadle) on Aug 15, 2002 at 17:54 UTC

    You can take care of the double click action using bind like so:

    $button->bind('<Double-1>' => sub{ whatever });

    [download]

    I don't have enough time to install all the modules you are using but I think you want to use grid instead of pack to get the info on the right frame "to diplay like a table".

    If you are going to be doing alot of work with Perl/Tk I would suggest getting a copy of Mastering Perl/Tk from Oreilly.

[reply]
[d/l]

Back to Seekers of Perl Wisdom