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

Please help me O'holly ones

If you run this code (remember to change the domain name to reflect your domain, by the way, this is a Win32 based), you will get a cool (I think so) and simple Perl/Tk based form that will display the directory tree structure on the left hand side and on the right it will get you a snap shots of the access permissions, also on the right hand side below the output frame there is a display of all global groups found in the domain.

My simple problems are as follows (in the order of importance):

1- On the Directory tree display frame, when a large drive is selected, the script looks like as if its hung, although that is not the case, therefore I need to program either a wait box or something similar (maybe a progress bar which ever is the easier) to indicate that the script is performing a task.

2- I have over 100 hundred global groups, to find a certain group by using the scroll bars is tedious and slow. How can I get the keyboard to work so that when pressing a key (for example the key 'L') then the cursor will jump to the first group starting with the letter ‘L’.

3- On the output display frame (right hand side, where permission information is display. The data consists of the account name and the access right associated with it. I would like to display this in a 2 column table so it looks neat and tidier.

If I can get the above stuff done, then my back side is safe. I have read the articles in PM about the above but I just got more confused, and I couldn’t find enough tutorials to enable me to do the above. Therefore I really do appreciate all your help guys and thanks very much 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::Dialog;
use Tk::DirTree;
use Tk::Adjuster;
use Tk::Toplevel;
use Tk::Scrollbar;
use Tk::DropSite;
use Tk::DragDrop;

use File::Find;
use Time::localtime;

use Win32;
use Win32::NetAdmin;
use Win32::AdminMisc;
use Win32::FileSecurity;
use Win32::NetResource;

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

$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 GetPerms
{
    my $path = $tk{dir_tree}->selectionGet(); 
    $dr{path} = $path;
    print "\nUser clicked to change the path to: $dr{path} \n";
    &ShowPathInfo($path);
}

sub ShowPathInfo
{
    my ($path) = @_;
    my %perms;   
    $dr{perms} = "Permisssions: $path"; 
    print "\nObtaining Path ACL $dr{perms}\n";
    $tk{output_list}-> delete('0.1','end');
    $tk{output_list}-> insert('end', -itemtype=> 'text', -text=> "****
+** PLEASE NOTE : THAT, IN THIS WINDOW, YOU CAN ONLY DRAG USERS NOT GR
+OUPS ******");
    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\tEnum Rights: " . $rights;
        if (Win32::NetAdmin::UsersExist("\\\\" . $dr{pdc}, $ACL_owner)
+)
        {
            $tk{output_list}->insert('end', -itemtype=>    'imagetext'
+, -text=> $desc, -image=> $im{usr});
        }
        else
        {
            if ($& =~ /RABOUK/i)
            {
                $tk{output_list}->insert('end', -itemtype=>    'imaget
+ext', -text=> $desc, -image=> $im{ggrp});                    
            }
            else
            {
                $tk{output_list}->insert('end', -itemtype=>    'imaget
+ext', -text=> $desc, -image=> $im{lgrp});
            }
        }        
    }
}

sub OnNewPath
{
    $tk{dir_tree}-> delete('all');
    $tk{dir_tree}->chdir( $dr{path} );
    print "\nChanged Directory to $dr{path}\n";
    &ShowPathInfo( $dr{path} );
    GetServer($dr{path});
    print "\nServer changed to : $dr{server}\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$msg\n$lngth\n";
}

$dr{path} = "C:\\";
$dr{server} = GetServer($dr{path});
print "\nScript hosting server name:  $dr{server}\n";
$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{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{per
+ms});
$tk{output_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');

my $waitbox = $tk{mw}->WaitBox(-title=>"Obtaining Drive information",
                                                    -txt1=>"Wxtrractin
+g drive information please wait.\nInformation is available when this 
+box closes.\n",
                                                    -cancelroutine=>su
+b {
                                                    print "\nCancellin
+g...\n";
                                                    $tk{mw}->unShow;
                                                    die});

$tk{dir_tree}-> bind('<ButtonRelease-1>',sub { GetPerms(); });
$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{entry_box_label}-> pack(qw/-side left -fill both/);
$tk{entry_box}-> pack(qw/-side top -fill both -expand 1/);
$tk{adjuster}-> pack(qw/-side left -fill y/);
$tk{right_frame}-> pack(qw/-side right -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/);

MainLoop;
exit 0;

[download]
Blackadder

Replies are listed 'Best First'.
(bbfu) Re: simple Perl/Tk problems
by bbfu (Curate) on Sep 10, 2002 at 15:57 UTC
    1. Check out Tk::ProgressBar. It should be pretty straight-forward (the POD has basic example code). Be sure to use Tk->DoOneEvent() to keep the window responsive and update the display.
    2. You need to bind a handler for keypresses on the list, then use some combination of DirTree->open() (see Tk::Tree), DirTree->selectionSet(), and DirTree->see() (see Tk::HList).
    3. You should be able to set up one or two container widgets and then either pack things left or right, or use a grid layout instead.

    Note: Perldoc.com doesn't seem to have any Tk documentation, and neither does search.cpan.org seem to include the documentation for Tk::bind, Tk::pack, nor Tk::grid. Just do `perldoc Tk::bind` (etc) for those docs.

    bbfu
    Black flowers blossum
    Fearless on my breath
    Teardrops on the fire
    Fearless on my breath

[reply]
[d/l]
[select]
      Well, below is the example from the k::Progress bar.
      Now, it’s NOT blatantly obvious on to how to get this code to work in conjunction with the Dirtree so that if a large drive was selected then the progress bar will indicate that the script is obtaining information and the progress bar will disappear once the data is ready to be displayed.
      Is there simpler example for a slow monk like me please? 
       


use strict;
use Tk;
use Tk::ProgressBar;
use Tk::Scale;

my $mw = MainWindow->new;

my $status_var = 0;

my($fromv,$tov) = (0,100);

foreach my $loop (0..1) 
{
    my $res = 0;
    my $blks = 10;
    my @p = qw(top bottom left right);
    foreach my $dir (qw(e)) 
    {
        $mw->ProgressBar(
        -borderwidth => 2,
        -relief => 'sunken',
        -width => 20,
        -padx => 2,
        -pady => 2,
        -variable => \$status_var,
        -colors => [0 => 'green', 50 => 'yellow' , 80 => 'red'],
        -resolution => $res,
        -blocks => $blks,
        -anchor => $dir,
        -from => $fromv,
        -to => $tov
        )->pack(
        -padx => 10,
        -pady => 10,
        -side => pop(@p),
        -fill => 'both',
        -expand => 1
    );
    $blks = abs($blks - ($res * 2));
    $res = abs(5 - $res);
    }
    ($fromv,$tov) = ($tov,$fromv);
}
$mw->Scale(-from => 0, -to => 100, -variable => \$status_var)->pack;

MainLoop;

      [download]
[reply]
[d/l]

        You're right, of course. It's not quite as straight-forward as I was thinking it would be. :)

        The problem is that you need a hook into the default handler for the dircmd callback, and it doesn't seem that you can get one. You're probably going to need to write your own. :(

        Here is the source of the default handler (taken directly from Tk/DirTree.pm): 

        sub DirCmd {
  my( $w, $dir, $showhidden ) = @_;

  my $h = DirHandle->new( $dir ) or return();
  my @names = grep( $_ ne '.' && $_ ne '..', $h->read );
  @names = grep( ! /^[.]/, @names ) unless $showhidden;
  return( @names );
}

        [download]

        Pretty simple. You just need to include a modified version of that sub in your program, and give your Tk::DirTree object a reference to it as the handler for the -dircmd callback (ie, $dirtree->configure(-dircmd => \&MyDirCmd);).

        In your copy, you need to break out that grep, probably into a for loop, or something, so that you can have your code update the Tk::ProgressBar. Of course, that's going to slow down reading of all directories. Not by much, though, hopefully.

        Anyway, regarding showing and hiding the progress bar... You could use a pop-up window to show it (there's even a Tk::ProgressBarDialog or something similar in the Snippets section of this site, I believe). I, however, would probably go with a status-bar type deal, where the progress bar is always shown, but empty, at the bottom of the window, and it just fills up while reading directories. *shrug* Up to you.

        Hope that helps!

        bbfu
        Black flowers blossum
        Fearless on my breath

[reply]
[d/l]
[select]
Re: simple Perl/Tk problems
by samurai (Monk) on Sep 10, 2002 at 15:29 UTC
    You can use the $widget->Busy() method to popup your choice of either an hourglass or... the... other one, whatever it is :) Then when your process is done, you can use the $widget->Unbusy(). Look up the docs (and the -recurse option).

    There is a Tk::ProgressBar module on CPAN as well. Check'er out.

    --
    perl: code of the samurai

[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom