view release on metacpan or  search on metacpan

lib/Module/Build/Platform/Unix.pm  view on Meta::CPAN

# Open group says username should be portable filename characters,
# but some Unix OS working with ActiveDirectory wind up with user-names
# with back-slashes in the name.  The new code below is very liberal
# in what it accepts.
sub _detildefy {
  my ($self, $value) = @_;
  $value =~ s[^~([^/]+)?(?=/|$)]   # tilde with optional username
    [$1 ?
     (eval{(getpwnam $1)[7]} || "~$1") :
     ($ENV{HOME} || eval{(getpwuid $>)[7]} || glob("~"))
    ]ex;
  return $value;
}

1;
__END__


=head1 NAME

t/tilde.t  view on Meta::CPAN

SKIP: {
    my $home = $ENV{HOME} ? $ENV{HOME} : undef;

    if ($^O eq 'VMS') {
        # Convert the path to UNIX format, trim off the trailing slash
        $home = VMS::Filespec::unixify($home);
        $home =~ s#/$##;
    }

    unless (defined $home) {
      my @info = eval { getpwuid $> };
      skip "No home directory for tilde-expansion tests", 15 if $@
        or !defined $info[7];
      $home = $info[7];
    }

    is( run_sample( $p => '~'     )->$p(),  $home );

    is( run_sample( $p => '~/fooxzy' )->$p(),  "$home/fooxzy" );

    is( run_sample( $p => '~/ fooxzy')->$p(),  "$home/ fooxzy" );

    is( run_sample( $p => '~/fo o')->$p(),  "$home/fo o" );

    is( run_sample( $p => 'fooxzy~'  )->$p(),  'fooxzy~' );

    is( run_sample( prefix => '~' )->prefix,
	$home );

    # Test when HOME is different from getpwuid(), as in sudo.
    {
        local $ENV{HOME} = '/wibble/whomp';

        is( run_sample( $p => '~' )->$p(),    "/wibble/whomp" );
    }

    my $mb = run_sample( install_path => { html => '~/html',
					   lib  => '~/lib'   }
		       );
    is( $mb->install_destination('lib'),  "$home/lib" );

t/tilde.t  view on Meta::CPAN

    $mb->$p('~');
    is( $mb->$p(),      '~', 'API does not expand tildes' );

    skip "On OS/2 EMX all users are equal", 2 if $^O eq 'os2';
    is( run_sample( $p => '~~'    )->$p(),  '~~' );
    is( run_sample( $p => '~ fooxzy' )->$p(),  '~ fooxzy' );
}

# Again, with named users
SKIP: {
    my @info = eval { getpwuid $> };
    skip "No home directory for tilde-expansion tests", 1 if $@
        or !defined $info[7] or !defined $info[0];
    my ($me, $home) = @info[0,7];

    if ($^O eq 'VMS') {
        # Convert the path to UNIX format and trim off the trailing slash.
        # Also, the fake module we're in has mangled $ENV{HOME} for its own
        # purposes; getpwuid doesn't know about that but _detildefy does.
        $home = VMS::Filespec::unixify($ENV{HOME});
        $home =~ s#/$##;
    }
    my $expected = "$home/fooxzy";

    like( run_sample( $p => "~$me/fooxzy")->$p(),  qr(\Q$expected\E)i );
}