Get document root

docroot.pl

#!/usr/bin/perl


my $input = $ARGV[0];
if ($input !~ /.*@.*/) {
print "Please enter a valid email address.\n";
die("\n");
}
else{

($user, $domain) = $ARGV[0] =~ /(.*)@(.*)/;
my %used;
my $string = 'grep -3';
my $domainstring = "www.$domain";
my $lookupfile = '/usr/local/apache/conf/httpd.conf';
@lines = qx/$string $domainstring $lookupfile/;
@stuff = grep( /.*$domianstring.*/, @lines);
@stuff = grep(/^.+?(\/.+\/.+$)/, @stuff);
$numlines = scalar(grep {defined $_} @stuff);
if ( $numlines != 1 ) {
pop @stuff;
foreach $stuff (@stuff) {
print $1 if $stuff =~ m/(\/.*$)/;
print "\n";
}
}
else {
foreach (@stuff) {
print $_;
}
}
}