Server IP : 66.29.132.122 / Your IP : 3.137.213.94 Web Server : LiteSpeed System : Linux business142.web-hosting.com 4.18.0-553.lve.el8.x86_64 #1 SMP Mon May 27 15:27:34 UTC 2024 x86_64 User : admazpex ( 531) PHP Version : 7.2.34 Disable Function : NONE MySQL : OFF | cURL : ON | WGET : ON | Perl : ON | Python : ON | Sudo : OFF | Pkexec : OFF Directory : /usr/share/perl5/vendor_perl/File/HomeDir/ |
Upload File : |
package File::HomeDir::Test; use 5.00503; use strict; use Carp (); use File::Spec (); use File::Temp (); use File::HomeDir::Driver (); use vars qw{$VERSION @ISA %DIR $ENABLED}; BEGIN { $VERSION = '1.002'; @ISA = 'File::HomeDir::Driver'; %DIR = (); $ENABLED = 0; } # Special magic use in test scripts sub import { my $class = shift; die "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}; # 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}, 0755) unless -d $DIR{my_home}; return $DIR{my_home}; } sub my_desktop { mkdir($DIR{my_desktop}, 0755) unless -d $DIR{my_desktop}; return $DIR{my_desktop}; } sub my_documents { mkdir($DIR{my_documents}, 0755) unless -f $DIR{my_documents}; return $DIR{my_documents}; } sub my_data { mkdir($DIR{my_data}, 0755) unless -d $DIR{my_data}; return $DIR{my_data}; } sub my_music { mkdir($DIR{my_music}, 0755) unless -d $DIR{my_music}; return $DIR{my_music}; } sub my_pictures { mkdir($DIR{my_pictures}, 0755) unless -d $DIR{my_pictures}; return $DIR{my_pictures}; } sub my_videos { mkdir($DIR{my_videos}, 0755) 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 state information from the tests into the run-time usage of an application, and on Unix systems also prevents tests (which may be executed as root via sudo) from writing files which cannot later be modified or removed by the regular user. =head1 SUPPORT See the support section of the main L<File::HomeDir> documentation. =head1 AUTHOR Adam Kennedy E<lt>adamk@cpan.orgE<gt> =head1 COPYRIGHT Copyright 2005 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut