view release on metacpan or  search on metacpan

t/02_main.t  view on Meta::CPAN

use Test::More;
use File::HomeDir;

# This module is destined for the core.
# Please do NOT use convenience modules
# use English; <-- don't do this

sub is_dir($)
{
    my $dir = shift or return;
    return 1 if -d $dir;
    return unless -l $dir;
    $dir = readlink $dir or return;
    return -d $dir;
}

#####################################################################
# Environment Detection and Plan

# For what scenarios can we be sure that we have desktop/documents
my $NO_GETPWUID   = 0;
my $HAVEHOME      = 0;
my $HAVEDESKTOP   = 0;
my $HAVEMUSIC     = 0;
my $HAVEPICTURES  = 0;
my $HAVEVIDEOS    = 0;
my $HAVEDOCUMENTS = 0;
my $HAVEOTHERS    = 0;

# Various cases of things we should try to test for
# Top level is entire classes of operating system.
# Below that are more general things.
if ($^O eq 'MSWin32')
{
    $NO_GETPWUID   = 1;
    $HAVEHOME      = 1;
    $HAVEDESKTOP   = 1;
    $HAVEPICTURES  = 1;
    $HAVEDOCUMENTS = 1;
    $HAVEOTHERS    = 1;

    # My Music does not exist on Win2000
    require Win32;
    my @version = Win32::GetOSVersion();
    my $v = ($version[4] || 0) + ($version[1] || 0) * 0.001 + ($version[2] || 0) * 0.000001;
    if ($v <= 2.005000)
    {
        $HAVEMUSIC  = 0;
        $HAVEVIDEOS = 0;
    }
    else
    {
        $HAVEMUSIC  = 1;
        $HAVEVIDEOS = 0;    # If we ever support "maybe" this is a maybe
    }

    # System is unix-like

    # Nobody users on all unix systems generally don't have home directories
}
elsif (getpwuid($<) eq 'nobody')
{
    $HAVEHOME     = 0;
    $HAVEDESKTOP  = 0;
    $HAVEMUSIC    = 0;
    $HAVEPICTURES = 0;
    $HAVEVIDEOS   = 0;
    $HAVEOTHERS   = 0;

}
elsif ($^O eq 'darwin')
{
    # "Unixes with proper desktops" special cases
    diag("\$<: $< -- \$(: $(");
    if ($ENV{AUTOMATED_TESTING})
    {
        # Automated testers on Mac (notably BINGOS) will often have
        # super stripped down testing users.
        $HAVEHOME      = 1;
        $HAVEDESKTOP   = 1;
        $HAVEMUSIC     = 0;
        $HAVEPICTURES  = 0;
        $HAVEVIDEOS    = 0;
        $HAVEDOCUMENTS = 0;
        $HAVEOTHERS    = 1;
    }
    elsif ($< > 500)
    {
        # Normal user
        $HAVEHOME      = 1;
        $HAVEDESKTOP   = 1;
        $HAVEMUSIC     = 1;
        $HAVEPICTURES  = 1;
        $HAVEVIDEOS    = 1;
        $HAVEDOCUMENTS = 1;
        $HAVEOTHERS    = 1;
    }
    else
    {
        # Root can only be relied on to have a home
        $HAVEHOME      = 1;
        $HAVEDESKTOP   = 0;
        $HAVEMUSIC     = 0;
        $HAVEPICTURES  = 0;
        $HAVEVIDEOS    = 0;
        $HAVEDOCUMENTS = 0;
        $HAVEOTHERS    = 0;
    }

}
elsif ($File::HomeDir::IMPLEMENTED_BY eq 'File::HomeDir::FreeDesktop')
{
    # On FreeDesktop we can't trust people to have a desktop (annoyingly)
    $HAVEHOME      = 1;
    $HAVEDESKTOP   = 0;
    $HAVEMUSIC     = 0;
    $HAVEVIDEOS    = 0;
    $HAVEPICTURES  = 0;
    $HAVEDOCUMENTS = 0;
    $HAVEOTHERS    = 0;

t/02_main.t  view on Meta::CPAN

}

# Find this user's music directory
SKIP:
{
    skip("Cannot assume existence of music", 3) unless $HAVEMUSIC;
    my $my_music  = File::HomeDir->my_music;
    my $my_music2 = File::HomeDir::my_music();
    is($my_music, $my_music2, 'Different APIs give the same results');
    ok(!!($my_music  and is_dir $my_music),  'Our music directory exists');
    ok(!!($my_music2 and is_dir $my_music2), 'Our music directory exists');
}

# Find this user's video directory
SKIP:
{
    skip("Cannot assume existence of videos", 3) unless $HAVEVIDEOS;
    my $my_videos  = File::HomeDir->my_videos;
    my $my_videos2 = File::HomeDir::my_videos();
    is($my_videos, $my_videos2, 'Different APIs give the same results');
    ok(!!($my_videos  and is_dir $my_videos),  'Our videos directory exists');
    ok(!!($my_videos2 and is_dir $my_videos2), 'Our videos directory exists');
}

# Desktop cannot be assumed in all environments
SKIP:
{
    skip("Cannot assume existence of desktop", 3) unless $HAVEDESKTOP;

    # Find this user's desktop data
    my $my_desktop  = File::HomeDir->my_desktop;
    my $my_desktop2 = File::HomeDir::my_desktop();
    is($my_desktop, $my_desktop2, 'Different APIs give the same results');
    ok(!!($my_desktop  and is_dir $my_desktop),  'Our desktop directory exists');
    ok(!!($my_desktop2 and is_dir $my_desktop2), 'Our desktop directory exists');
}

# Find this user's local data
SKIP:
{
    skip("Cannot assume existence of application data", 3) unless $HAVEOTHERS;
    my $my_data  = File::HomeDir->my_data;
    my $my_data2 = File::HomeDir::my_data();
    is($my_data, $my_data2, 'Different APIs give the same results');
    ok(!!($my_data  and is_dir $my_data),  'Found our local data directory');
    ok(!!($my_data2 and is_dir $my_data2), 'Found our local data directory');
}

# Shall we check name space pollution by testing functions in main before
# and after calling use ?

# On platforms other than windows, find root's homedir
SKIP:
{
    if ($^O eq 'MSWin32' or $^O eq 'cygwin' or $^O eq 'darwin')
    {
        skip("Skipping root test on $^O", 1);
    }

    # Determine root
    my $root = getpwuid(0);
    unless ($root)
    {
        skip("Skipping, can't determine root", 1);
    }

    # Get root's homedir
    my $root_home1 = home($root);
    ok(!!($root_home1 and is_dir $root_home1), "Found root's home directory");
}