view release on metacpan or  search on metacpan

lib/File/HomeDir/Test.pm  view on Meta::CPAN

package File::HomeDir::Test;

use 5.008003;
use strict;
use warnings;
use Carp                  ();
use File::Spec            ();
use File::Temp            ();
use File::HomeDir::Driver ();

use vars qw{$VERSION %DIR $ENABLED};
use base "File::HomeDir::Driver";

BEGIN
{
    $VERSION = '1.006';
    %DIR     = ();
    $ENABLED = 0;
}

# Special magic use in test scripts
sub import
{
    my $class = shift;
    Carp::croak "Attempted to initialise File::HomeDir::Test trice" if %DIR;

    # Fill the test directories
    my $BASE = File::Temp::tempdir(CLEANUP => 1);
    %DIR = map { $_ => File::Spec->catdir($BASE, $_) } qw{
      my_home
      my_desktop
      my_documents
      my_data
      my_music
      my_pictures
      my_videos
    };

    # Hijack HOME to the home directory
    $ENV{HOME} = $DIR{my_home};    ## no critic qw(LocalizedPunctuationVars)

    # Make File::HomeDir load us instead of the native driver
    $File::HomeDir::IMPLEMENTED_BY =    # Prevent a warning
      $File::HomeDir::IMPLEMENTED_BY = 'File::HomeDir::Test';

    # Ready to go
    $ENABLED = 1;
}

#####################################################################
# Current User Methods

sub my_home
{
    mkdir($DIR{my_home}, oct(755)) unless -d $DIR{my_home};
    return $DIR{my_home};
}

sub my_desktop
{
    mkdir($DIR{my_desktop}, oct(755)) unless -d $DIR{my_desktop};
    return $DIR{my_desktop};
}

sub my_documents
{
    mkdir($DIR{my_documents}, oct(755)) unless -f $DIR{my_documents};
    return $DIR{my_documents};
}

sub my_data
{
    mkdir($DIR{my_data}, oct(755)) unless -d $DIR{my_data};
    return $DIR{my_data};
}

sub my_music
{
    mkdir($DIR{my_music}, oct(755)) unless -d $DIR{my_music};
    return $DIR{my_music};
}

sub my_pictures
{
    mkdir($DIR{my_pictures}, oct(755)) unless -d $DIR{my_pictures};
    return $DIR{my_pictures};
}

sub my_videos
{
    mkdir($DIR{my_videos}, oct(755)) unless -d $DIR{my_videos};
    return $DIR{my_videos};
}

sub users_home
{
    return undef;
}

1;

__END__

=pod

=head1 NAME

File::HomeDir::Test - Prevent the accidental creation of user-owned files during testing

=head1 SYNOPSIS

  use Test::More test => 1;
  use File::HomeDir::Test;
  use File::HomeDir;

=head1 DESCRIPTION

B<File::HomeDir::Test> is a L<File::HomeDir> driver intended for use in the test scripts
of modules or applications that write files into user-owned directories.

It is designed to prevent the pollution of user directories with files that are not part
of the application install itself, but were created during testing. These files can leak