File Coverage

blib/lib/Win32/NetName.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

package Win32::NetName;

use File::Spec;
use Win32::API;
use Win32::Lanman;

use Win32::VolumeInformation qw( GetVolumeInformation );

use Exporter ();
our @ISA = qw( Exporter );
our @EXPORT_OK = qw( GetUniversalName GetLocalName );

our $VERSION = 0.3;

Win32::API->Import('kernel32', 'GetDriveType', ['P'], 'N')
			or die "Win32::API->Import GetDriveType: $!";

sub GetLocalName{
	my $infile = $_[1];
	$infile = File::Spec->rel2abs($infile);
	$infile = File::Spec->canonpath($infile);
	return 0 if $infile =~ /^\w/;
	my($vol,$path,$file) = File::Spec->splitpath($infile);
	$vol =~ s/(\w+)/\U$1/; # uc machine name - should File::Spec do this?
	if( uc $1 eq Win32::NodeName() ){
		if( GetLocalPath(my $p, $infile) ){
    		$_[0] = $p;
    		return 1;
    	}else{
    		return 0;
    	}
	}
    for my $disk ('A'..'Z'){
    	$disk .= ':';
  		my $share;
   		Win32::Lanman::WNetGetConnection($disk,\$share);
  		if( uc $vol eq uc $share ){
  			my $outfile = File::Spec->catdir($disk,$path,$file);
  			$_[0] = $outfile;
  			return 1;
  		}
    }
    return 0;
}

sub GetLocalPath{
	my $infile = $_[1];
	$infile = File::Spec->rel2abs($infile);
	$infile = File::Spec->canonpath($infile);
	return 0 if $infile =~ /^\w/;
	my($vol,$path,$file) = File::Spec->splitpath($infile);
	$vol =~ s/(\w+)/\U$1/; # uc machine name - should File::Spec do this?
	my $node = $_[2] || Win32::NodeName();;
	return 0 unless GetDiskShares(my $n, $node);
	for my $s (@$n){
		if( uc "\\\\$node\\$s->{netname}" eq uc $vol ){
			my $outfile = File::Spec->catdir($s->{path}, $path, $file );
			$_[0] = $outfile;
			return 1;
		}
	}
	return 0;
}

sub GetUniversalName{
	my $infile = $_[1];
	$infile = File::Spec->rel2abs($infile);
	$infile = File::Spec->canonpath($infile);
	return 0 unless $infile =~ /^\w/;
	my($vol,$path,$file) = File::Spec->splitpath($infile);
	if( GetDriveType($vol) == 4 ){ # remote share
		my %info;
		if( Win32::Lanman::WNetGetUniversalName($infile, \%info)){
			$_[0] = $info{universalname};
			return 1;
		}else{
			return 0;
		}
    }else{ # local share
    	if( GetUniversalPaths(my $p, $infile ) ){
    		if( @$p ){
    			$_[0] = $p->[0];
    			return 1;
    		}
    	}
    }
    return 0;
}

sub GetUniversalPaths{
	my $infile = $_[1];
	my $node = $_[2] || Win32::NodeName();
	my @names;
	return 0 unless GetDiskShares(my $n, $node);


	my $compare = sub{ $_[0] eq $_[1] };
	my($vol,$path,$file) = File::Spec->splitpath($infile);
	my %info;
	if( GetVolumeInformation($vol,\%info) ){
		unless( $info{FS_CASE_SENSITIVE} ){
        	$compare = sub{ uc $_[0] eq uc $_[1] };
		}
	}else{
		return 0;
	}


	for my $s (@$n){
		my $path = $s->{path};
		if( $compare->($path,$infile) ){
			push @names, "\\\\$node\\$s->{netname}";
		}elsif( length $infile > length $path ){
			my $test = substr($infile,0,length $path);
			if( $compare->($test,$path) && substr($infile,length $path, 1) eq "\\" ){
				my @infile = File::Spec->splitdir($infile);
				my @test = File::Spec->splitdir($test);
				splice @infile, 0, scalar @test;
				my $dir = File::Spec->catdir("\\\\$node\\$s->{netname}",@infile);
				push @names, $dir;
			}
		}
	}
	if(@names){
		$_[0] = \@names;
		return 1;
	}
	return 0;
}

sub GetDiskShares{
	my $node = $_[1] || Win32::NodeName();
	my @stuff;
	my @info;
	if (Win32::Lanman::NetShareEnum("\\\\$node",\@stuff)) {
		for my $share (@stuff){
			if( $share->{type} == 0 ){
				push @info, $share;
			}
		}
		if(@info){
			$_[0] = \@info;
			return 1;
		}
	}
	return 0;
}

1;

__END__