165 lines
2.5 KiB
Perl
165 lines
2.5 KiB
Perl
package File::HomeDir::Unix;
|
|
|
|
# See POD at the end of the file for documentation
|
|
|
|
use 5.008003;
|
|
use strict;
|
|
use warnings;
|
|
use Carp ();
|
|
use File::HomeDir::Driver ();
|
|
|
|
use vars qw{$VERSION};
|
|
use base "File::HomeDir::Driver";
|
|
|
|
BEGIN
|
|
{
|
|
$VERSION = '1.006';
|
|
}
|
|
|
|
#####################################################################
|
|
# Current User Methods
|
|
|
|
sub my_home
|
|
{
|
|
my $class = shift;
|
|
my $home = $class->_guess_home(@_);
|
|
|
|
# On Unix in general, a non-existent home means "no home"
|
|
# For example, "nobody"-like users might use /nonexistent
|
|
if (defined $home and not -d $home)
|
|
{
|
|
$home = undef;
|
|
}
|
|
|
|
return $home;
|
|
}
|
|
|
|
sub _guess_env_home
|
|
{
|
|
my $class = shift;
|
|
if (exists $ENV{HOME} and defined $ENV{HOME} and length $ENV{HOME})
|
|
{
|
|
return $ENV{HOME};
|
|
}
|
|
|
|
# This is from the original code, but I'm guessing
|
|
# it means "login directory" and exists on some Unixes.
|
|
if (exists $ENV{LOGDIR} and $ENV{LOGDIR})
|
|
{
|
|
return $ENV{LOGDIR};
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
sub _guess_determined_home
|
|
{
|
|
my $class = shift;
|
|
|
|
# Light desperation on any (Unixish) platform
|
|
SCOPE:
|
|
{
|
|
my $home = (getpwuid($<))[7];
|
|
return $home if $home and -d $home;
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
sub _guess_home
|
|
{
|
|
my $class = shift;
|
|
my $home = $class->_guess_env_home($@);
|
|
$home ||= $class->_guess_determined_home($@);
|
|
return $home;
|
|
}
|
|
|
|
# On unix by default, everything is under the same folder
|
|
sub my_desktop
|
|
{
|
|
shift->my_home;
|
|
}
|
|
|
|
sub my_documents
|
|
{
|
|
shift->my_home;
|
|
}
|
|
|
|
sub my_data
|
|
{
|
|
shift->my_home;
|
|
}
|
|
|
|
sub my_music
|
|
{
|
|
shift->my_home;
|
|
}
|
|
|
|
sub my_pictures
|
|
{
|
|
shift->my_home;
|
|
}
|
|
|
|
sub my_videos
|
|
{
|
|
shift->my_home;
|
|
}
|
|
|
|
#####################################################################
|
|
# General User Methods
|
|
|
|
sub users_home
|
|
{
|
|
my ($class, $name) = @_;
|
|
|
|
# IF and only if we have getpwuid support, and the
|
|
# name of the user is our own, shortcut to my_home.
|
|
# This is needed to handle HOME environment settings.
|
|
if ($name eq getpwuid($<))
|
|
{
|
|
return $class->my_home;
|
|
}
|
|
|
|
SCOPE:
|
|
{
|
|
my $home = (getpwnam($name))[7];
|
|
return $home if $home and -d $home;
|
|
}
|
|
|
|
return undef;
|
|
}
|
|
|
|
sub users_desktop
|
|
{
|
|
shift->users_home(@_);
|
|
}
|
|
|
|
sub users_documents
|
|
{
|
|
shift->users_home(@_);
|
|
}
|
|
|
|
sub users_data
|
|
{
|
|
shift->users_home(@_);
|
|
}
|
|
|
|
sub users_music
|
|
{
|
|
shift->users_home(@_);
|
|
}
|
|
|
|
sub users_pictures
|
|
{
|
|
shift->users_home(@_);
|
|
}
|
|
|
|
sub users_videos
|
|
{
|
|
shift->users_home(@_);
|
|
}
|
|
|
|
1;
|
|
|
|
#line 218
|