#! perl -w
# This script will create two windows, the one on
# the left is where all the directories will be
# displayed and on the right is where the users
# or groups that have access to the directory will
# be displayed.
# 1-On the right windows, displaying users and
# groups as Icons (like an icon with a drawing
# of face for a users and two faces for a group
# similar to what you get in User Manager) instead
# of displaying them in text.
# 2- Clicking on a user icon and dragging it
# then dropping it on an icon representing a
# group will move the user to that group.
# 3- On the left Window, where the directory
# structures are displayed, I would like to have
# a display similar to what you get if you had
# used Tk::DirTree -if I can. Also a single click
# on a directory will display the user permissions
# on the right window (which the script does that
# anyway) and double click will assign a variable
# to the selected path, so I can do other things
# with that path.
# 4- Instead of passing the path as @ARGV, it
# would be better if I could have an entry field
# (in the top left hand corner of the window) where
# I can pass the path in there and bind the Enter
# (or Return) key to that field.
use strict;
use Tk 800.005;
use Tk::TList;
use Tk::DirTree;
use Tk::Frame;
use Tk::Scrollbar;
use Tk::Adjuster;
# These are required for drag-n-drop operations
use Tk::DragDrop;
use Tk::DropSite;
use File::Find;
use Win32::Perms;
# $tk{widget_refs}, $dr{data_refs}, $im{image_refs}
use vars qw/%tk %dr %im @users @groups $dnd_token/;
$dr{PATH} = shift @ARGV || ".";
$dr{perms} = "Permissions: ".$dr{PATH};
$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=
+>'left');
$tk{right_frame} = $tk{mw}->Frame;
$tk{entry_box} = $tk{top_frame}->Entry(-textvariable=>\$dr{PATH});
$tk{dir_tree} = $tk{left_frame}->Scrolled('DirTree',
-height=>'0',
-width=>'0',
-scrollbars=>'e', );
$tk{output_list} = $tk{right_frame}->Scrolled('TList',
-height=>'1',
-width=>'1',
-scrollbars=>'osoe',);
$tk{user_list} = $tk{right_frame}->Scrolled('TList',
-height=>'1',
-width=>'1',
-scrollbars=>'osoe',);
$tk{group_list} = $tk{right_frame}->Scrolled('TList',
-height=>'1',
-width=>'1',
-scrollbars=>'osoe',);
$tk{user_label} = $tk{right_frame}->Label(-text => "User List:");
$tk{group_label} = $tk{right_frame}->Label(-text => "Group List:");
$tk{output_label} = $tk{right_frame}->Label(-textvariable => \$dr{perm
+s});
$im{ONE} = $tk{mw}->Photo(-file => 'one.gif');
$im{GROUP} = $tk{mw}->Photo(-file => 'group.gif');
$tk{dir_tree}->chdir( $dr{PATH} );
$tk{dir_tree}->bind('<ButtonRelease-1>',sub {get_perms();});
$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{adjuster}->pack(qw/-side left -fill y/);
$tk{right_frame}->pack(qw/-side right -fill both -expand 1/);
$tk{entry_box} ->pack(qw/-side top -fill both -expand 1/);
$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{user_label} ->pack(qw/-side top -fill both/);
$tk{user_list} ->pack(qw/-side top -fill both -expand 1/);
$tk{group_label} ->pack(qw/-side top -fill both/);
$tk{group_list} ->pack(qw/-side top -fill both -expand 1/);
# Define the source for drags.
# Drags are started while pressing the left mouse button and moving th
+e
# mouse. Then the StartDrag callback is executed.
#
# The DragDrop method returns a "token", which is a Label widget for
# the text or image displayed during the drag action.
$dnd_token = $tk{user_list}->DragDrop
(-event => '<B1-Motion>',
-sitetypes => [qw/Local/],
-startcommand => \&DragStart,
);
# Define the target for drops.
$tk{group_list}->DropSite
(-droptypes => [qw/Local/],
-dropcommand => [\&Drop, $tk{group_list}, $dnd_token ],
);
# Add the users to the user list and the groups to the group list
@users = @{&GetUsers()};
map { $tk{user_list}->insert('end',
-itemtype=>'imagetext',
-text=>"$_",
-image=>$im{ONE}) }
@users;
@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; # $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);
}
}
# Accept a drop and insert a new item in the destination
sub Drop {
my($lb, $dnd_source) = @_;
my $user_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 $group_item = $lb->entrycget($nearest, '-text');
&AddUserToGroup($user_item, $group_item);
$lb->see($nearest);
}
}
sub get_perms
{
# my ($indx) = $tk{dir_tree}->curselection();
my $path = $tk{dir_tree}->selectionGet();
&ShowPathInfo($path);
}
# 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}->chdir( $dr{PATH} );
&ShowPathInfo( $dr{PATH} );
}
sub ShowPathInfo
{
my ($path) = @_;
my $perms = new Win32::Perms($path) || die "\n$^E\n";
print "Path: " . $perms->Path();
my $counter = $perms->Get(\ my @list);
$dr{perms} = "Permisssions: $path";
$tk{output_list}->delete('0.1','end');
$tk{output_list}->insert('end',
-itemtype=>'text',
-text=>"$path");
foreach my $item (@list)
{
while (@_ = each %$item)
{
next unless $_[0] =~ /account|access/i;
$tk{output_list}->insert('end',
-itemtype=>'imagetext',
-text=> $_[0].":". $_[1],
-image=>$im{ONE});
}
}
}
sub GetUsers
{
return [qw/One Two Three/];
}
sub GetGroups
{
return [qw/Blue Green Red/];
}
sub AddUserToGroup
{
my ($user, $group) = @_;
#
# Do something with $user_item and with $group_item
#
$dr{perms} = "User $user added to $group";
}
|