File Coverage

lib/Test2/Plugin/FauxHomeDir.pm

Criterion	Covered	Total	%
statement	55	73	75.3
branch	11	26	42.3
condition	4	12	33.3
subroutine	12	13	92.3
pod	1	1	100.0
total	83	125	66.4

package Test2::Plugin::FauxHomeDir;

use strict;
use warnings;
use 5.008001;
use File::Temp qw( tempdir );
use File::Spec;
use File::Path qw( mkpath );
use if $^O eq 'cygwin', 'File::Spec::Win32';
use Test2::API qw( test2_add_callback_post_load test2_stack test2_add_callback_exit );

# ABSTRACT: Setup a faux home directory for tests
our $VERSION = '0.05'; # VERSION


my $real;
my $faux;
my $user;
my @mocks;

sub real_home_dir
{
  $real;
}

sub import
{
  my @notes;

  unless(defined $faux)
  {
    if($^O eq 'MSWin32')
    {
      $real = $ENV{USERPROFILE};
      $real = File::Spec->catdir($ENV{HOMEDRIVE}, $ENV{HOMEPATH})
        unless defined $real;
      $user = $ENV{USERNAME};
    }
    else
    {
      $real = $ENV{HOME};
      $user = $ENV{USER};
    }

    $user = eval { getlogin } unless defined $user;
    $user = eval { scalar getpwuid($>) } unless defined $user;
    die "unable to determine username" unless defined $user;

    die "unable to determine 'real' home directory"
      unless defined $real && -d $real;

    delete $ENV{USERPROFILE};
    delete $ENV{HOME};
    delete $ENV{HOMEDRIVE};
    delete $ENV{HOMEPATH};

    $faux = File::Spec->catdir(tempdir( CLEANUP => 1 ), 'home', $user);
    mkpath $faux, 0, 0700;

    if($^O eq 'MSWin32')
    {
      $ENV{USERPROFILE} = $faux;
      ($ENV{HOMEDRIVE}, $ENV{HOMEPATH}) = File::Spec->splitpath($faux,1);
      if(eval { require Portable })
      {
        push @notes, "Portable strawberry detected";
        if(eval { require File::HomeDir })
        {
          # annoyingly, Strawberry Portable Perl patches
          # File::HomeDir, but not things like File::Glob
          # so since there isn't a good interface to override
          # this behavior, we need to patch the patch :(
          push @notes, "Patching File::HomeDir";
          require Test2::Mock;
          push @mocks, Test2::Mock->new(
            class => 'File::HomeDir',
            override => [
              my_home => sub { $faux },
            ],
          );
        }
      }
    }
    elsif($^O eq 'cygwin')
    {
      $ENV{USERPROFILE} = Cygwin::posix_to_win_path($faux);
      ($ENV{HOMEDRIVE}, $ENV{HOMEPATH}) = File::Spec::Win32->splitpath($ENV{USERPROFILE},1);
      $ENV{HOME} = $faux;
    }
    else
    {
      $ENV{HOME} = $faux;
    }

    push @notes, "Test2::Plugin::FauxHomeDir using faux home dir $faux";
    push @notes, "Test2::Plugin::FauxHomeDir real home dir is    $real";

    test2_add_callback_post_load(sub {
      test2_stack()->top;
      my($hub) = test2_stack->all;
      $hub->send(
        Test2::Event::Note->new(
          message => $_
        ),
      ) for @notes;
    });

    test2_add_callback_exit(sub {
      my ($ctx, $real, $new) = @_;
      if($INC{'File/HomeDir/Test.pm'})
      {
        my @message = (
          'File::HomeDir::Test was loaded.',
          'You probably do not want to load both File::HomeDir::Test and Test2::Plugin::FauxHomeDir',
        );
        if($real || ($new && $$new) || !$ctx->hub->is_passing)
        {
          $ctx->diag($_) for @message;
        }
        else
        {
          $ctx->note($_) for @message;
        }
      }
    });
  }
}

1;

__END__