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

I'm tring to write a script that finds orphaned home directories on the servers. Originally, I was just comparing the directories found on the servers to the user accounts (see below). If there was no match the share was an orphan.

The problem is marriage. When women marry, sometimes their user account will change, but the home directory will remain the same. It shouldn't be this way, but it happens. It's not like me to penalize people for getting married (I'm not the US Federal government after all), so I decided to compare the directories on the servers to the $homeDir variable to see if anyone uses the directory as their home regardless of their user name.

And that's where I have sat staring for a day or two. Thanks. Game on...

  1. It pulls in all the users from the domain
  2. It reads all of the home directories from all those user accounts and drops it into %is_acct
  3. Then I am trying to compare all of the values in @dirs against the values in %is_acct for a partial match.
  4. If there is a partial match, I want the value and the key
It reads in the user shares into @dirs and then 
use strict;
use Win32::NetAdmin qw(GetUsers UserGetAttributes);

my (@accounts,%is_acct,$x,$key,$homeDir,$account);
my $PDC='thePDC';
my $filter='FILTER_NORMAL_ACCOUNT';
my $out='//ws/share/orphan.txt';
my ($server,$usershare);
my @servers=('server1','server2');

# Slurp all accounts into @accounts...
GetUsers($PDC,$filter, \@accounts) or die "Can't get users $!";

undef %is_acct;

# Create a hash with user accounts and home directory paths
foreach $account(@accounts){
    UserGetAttributes($PDC,$account,$x,$x,$x,$homeDir,$x,$x,$x) or die
+ "UserGetAttributes() failed: $^E";
    $is_acct{$account}=$homeDir;
}

open OUT,">$out";

# Check for user shares on D$ and E$ and exit if not there...
foreach $server (@servers){
    my $dir1="//$server/e\$/usershare";
    if (!(-e "$dir1")){#if directory doesn't exist try d$
        $dir1="//$server/d\$/usershare";
    if (!(-e "$dir1")){
        next;
    }
    }
# Read in the user shares from the servers 
    opendir(DIR, $dir1) or die "can't opendir $dir1: $!";
    my @dirs = grep { !/^\./ && -d "$dir1/$_" } readdir(DIR) or warn "
+can't grep"; #weed out dots and get only dirs
    closedir DIR;

    foreach $usershare(@dirs){
    my $userdir="$dir1/$usershare";
# PLACE WHERE PARTIAL EXTRACTION GOES...
# used to read if(!exists $is_acct{$usershare}){
#    print "$userdir: Orphan\n";
#        }
    }
}
close OUT;

[download]

-OzzyOsbourne

Replies are listed 'Best First'.
Re: Partial extractions on hashes
by busunsl (Vicar) on May 11, 2001 at 16:23 UTC
    For a partial match on values in a hash try this: 
    %hash = ('k1' => 'abc', 'k2' => 'def', 'k3' => '123abcdef456');

@array = map { $_->[1] } grep { $_->[1] =~ /abc/ } map { [$_, $hash{$_
+}] } keys %hash);
foreach (@array) {
  print $hash{$_}, "\n";
}

    [download]
[reply]
[d/l]

      You can shorten that quite a bit: 

      %hash = ('k1' => 'abc', 'k2' => 'def', 'k3' => '123abcdef456');

@array = map  $hash{$_} =~ /abc/ ? $_ : (),  keys %hash;
foreach (@array) {
    print "$_: $hash{$_}\n";
}

      [download]

              - tye (but my friends call me "Tye")
[reply]
[d/l]
(jeffa) Re: Partial extractions on hashes
by jeffa (Bishop) on May 11, 2001 at 16:40 UTC
    Do not ++ this node - i don't need the XP :)

    since davorg is a modest soul, i wanted point any person interested in this problem to his solution: Tie::Hash::Regex.

    Jeff 

    R-R-R--R-R-R--R-R-R--R-R-R--R-R-R--
L-L--L-L--L-L--L-L--L-L--L-L--L-L--
[reply]
[reply]

        Actually, I think you've got that slightly wrong. The original code says:

        if(!exists $is_acct{$usershare}){

        [download]

        Which is searching on key - not value.

        Tie::Hash::Regex still isn't a solution because I only implemented the FETCH method, not EXISTS. But it wouldn't be too difficult to add that.

        --
        <http://www.dave.org.uk>

        "Perl makes the fun jobs fun
        and the boring jobs bearable" - me

[reply]
[d/l]

Back to Seekers of Perl Wisdom