summaryrefslogtreecommitdiff
path: root/lib/File/HomeDir
diff options
context:
space:
mode:
Diffstat (limited to 'lib/File/HomeDir')
-rw-r--r--lib/File/HomeDir/Darwin.pm152
-rw-r--r--lib/File/HomeDir/Darwin/Carbon.pm210
-rw-r--r--lib/File/HomeDir/Darwin/Cocoa.pm165
-rw-r--r--lib/File/HomeDir/Driver.pm54
-rw-r--r--lib/File/HomeDir/FreeDesktop.pm136
-rw-r--r--lib/File/HomeDir/MacOS9.pm150
-rw-r--r--lib/File/HomeDir/Test.pm137
-rw-r--r--lib/File/HomeDir/Unix.pm186
-rw-r--r--lib/File/HomeDir/Windows.pm241
9 files changed, 1431 insertions, 0 deletions
diff --git a/lib/File/HomeDir/Darwin.pm b/lib/File/HomeDir/Darwin.pm
new file mode 100644
index 0000000..7990eb7
--- /dev/null
+++ b/lib/File/HomeDir/Darwin.pm
@@ -0,0 +1,152 @@
+package File::HomeDir::Darwin;
+
+use 5.00503;
+use strict;
+use Cwd ();
+use Carp ();
+use File::HomeDir::Unix ();
+
+use vars qw{$VERSION @ISA};
+BEGIN {
+ $VERSION = '1.00';
+ @ISA = 'File::HomeDir::Unix';
+}
+
+
+
+
+
+#####################################################################
+# Current User Methods
+
+sub my_home {
+ my $class = shift;
+
+ if ( exists $ENV{HOME} and defined $ENV{HOME} ) {
+ return $ENV{HOME};
+ }
+
+ my $home = (getpwuid($<))[7];
+ return $home if $home && -d $home;
+
+ return undef;
+}
+
+sub _my_home {
+ my($class, $path) = @_;
+ my $home = $class->my_home;
+ return undef unless defined $home;
+
+ my $folder = "$home/$path";
+ unless ( -d $folder ) {
+ # Make sure that symlinks resolve to directories.
+ return undef unless -l $folder;
+ my $dir = readlink $folder or return;
+ return undef unless -d $dir;
+ }
+
+ return Cwd::abs_path($folder);
+}
+
+sub my_desktop {
+ my $class = shift;
+ $class->_my_home('Desktop');
+}
+
+sub my_documents {
+ my $class = shift;
+ $class->_my_home('Documents');
+}
+
+sub my_data {
+ my $class = shift;
+ $class->_my_home('Library/Application Support');
+}
+
+sub my_music {
+ my $class = shift;
+ $class->_my_home('Music');
+}
+
+sub my_pictures {
+ my $class = shift;
+ $class->_my_home('Pictures');
+}
+
+sub my_videos {
+ my $class = shift;
+ $class->_my_home('Movies');
+}
+
+
+
+
+
+#####################################################################
+# Arbitrary User Methods
+
+sub users_home {
+ my $class = shift;
+ my $home = $class->SUPER::users_home(@_);
+ return defined $home ? Cwd::abs_path($home) : undef;
+}
+
+sub users_desktop {
+ my ($class, $name) = @_;
+ return undef if $name eq 'root';
+ $class->_to_user( $class->my_desktop, $name );
+}
+
+sub users_documents {
+ my ($class, $name) = @_;
+ return undef if $name eq 'root';
+ $class->_to_user( $class->my_documents, $name );
+}
+
+sub users_data {
+ my ($class, $name) = @_;
+ $class->_to_user( $class->my_data, $name )
+ ||
+ $class->users_home($name);
+}
+
+# cheap hack ... not entirely reliable, perhaps, but ... c'est la vie, since
+# there's really no other good way to do it at this time, that i know of -- pudge
+sub _to_user {
+ my ($class, $path, $name) = @_;
+ my $my_home = $class->my_home;
+ my $users_home = $class->users_home($name);
+ defined $users_home or return undef;
+ $path =~ s/^\Q$my_home/$users_home/;
+ return $path;
+}
+
+1;
+
+=pod
+
+=head1 NAME
+
+File::HomeDir::Darwin - Find your home and other directories on Darwin (OS X)
+
+=head1 DESCRIPTION
+
+This module provides Mac OS X specific file path for determining
+common user directories in pure perl, by just using C<$ENV{HOME}>
+without Carbon nor Cocoa API calls. In normal usage this module will
+always be used via L<File::HomeDir>.
+
+=head1 SYNOPSIS
+
+ use File::HomeDir;
+
+ # Find directories for the current user
+ $home = File::HomeDir->my_home; # /Users/mylogin
+ $desktop = File::HomeDir->my_desktop; # /Users/mylogin/Desktop
+ $docs = File::HomeDir->my_documents; # /Users/mylogin/Documents
+ $music = File::HomeDir->my_music; # /Users/mylogin/Music
+ $pics = File::HomeDir->my_pictures; # /Users/mylogin/Pictures
+ $videos = File::HomeDir->my_videos; # /Users/mylogin/Movies
+ $data = File::HomeDir->my_data; # /Users/mylogin/Library/Application Support
+
+=cut
diff --git a/lib/File/HomeDir/Darwin/Carbon.pm b/lib/File/HomeDir/Darwin/Carbon.pm
new file mode 100644
index 0000000..496a1f2
--- /dev/null
+++ b/lib/File/HomeDir/Darwin/Carbon.pm
@@ -0,0 +1,210 @@
+package File::HomeDir::Darwin::Carbon;
+
+# Basic implementation for the Dawin family of operating systems.
+# This includes (most prominently) Mac OS X.
+
+use 5.00503;
+use strict;
+use Cwd ();
+use Carp ();
+use File::HomeDir::Darwin ();
+
+use vars qw{$VERSION @ISA};
+BEGIN {
+ $VERSION = '1.00';
+
+ # This is only a child class of the pure Perl darwin
+ # class so that we can do homedir detection of all three
+ # drivers at one via ->isa.
+ @ISA = 'File::HomeDir::Darwin';
+
+ # Load early if in a forking environment and we have
+ # prefork, or at run-time if not.
+ local $@;
+ eval "use prefork 'Mac::Files'";
+}
+
+
+
+
+
+#####################################################################
+# Current User Methods
+
+sub my_home {
+ my $class = shift;
+
+ # A lot of unix people and unix-derived tools rely on
+ # the ability to overload HOME. We will support it too
+ # so that they can replace raw HOME calls with File::HomeDir.
+ if ( exists $ENV{HOME} and defined $ENV{HOME} ) {
+ return $ENV{HOME};
+ }
+
+ require Mac::Files;
+ $class->_find_folder(
+ Mac::Files::kCurrentUserFolderType(),
+ );
+}
+
+sub my_desktop {
+ my $class = shift;
+
+ require Mac::Files;
+ $class->_find_folder(
+ Mac::Files::kDesktopFolderType(),
+ );
+}
+
+sub my_documents {
+ my $class = shift;
+
+ require Mac::Files;
+ $class->_find_folder(
+ Mac::Files::kDocumentsFolderType(),
+ );
+}
+
+sub my_data {
+ my $class = shift;
+
+ require Mac::Files;
+ $class->_find_folder(
+ Mac::Files::kApplicationSupportFolderType(),
+ );
+}
+
+sub my_music {
+ my $class = shift;
+
+ require Mac::Files;
+ $class->_find_folder(
+ Mac::Files::kMusicDocumentsFolderType(),
+ );
+}
+
+sub my_pictures {
+ my $class = shift;
+
+ require Mac::Files;
+ $class->_find_folder(
+ Mac::Files::kPictureDocumentsFolderType(),
+ );
+}
+
+sub my_videos {
+ my $class = shift;
+
+ require Mac::Files;
+ $class->_find_folder(
+ Mac::Files::kMovieDocumentsFolderType(),
+ );
+}
+
+sub _find_folder {
+ my $class = shift;
+ my $name = shift;
+
+ require Mac::Files;
+ my $folder = Mac::Files::FindFolder(
+ Mac::Files::kUserDomain(),
+ $name,
+ );
+ return undef unless defined $folder;
+
+ unless ( -d $folder ) {
+ # Make sure that symlinks resolve to directories.
+ return undef unless -l $folder;
+ my $dir = readlink $folder or return;
+ return undef unless -d $dir;
+ }
+
+ return Cwd::abs_path($folder);
+}
+
+
+
+
+
+#####################################################################
+# Arbitrary User Methods
+
+sub users_home {
+ my $class = shift;
+ my $home = $class->SUPER::users_home(@_);
+ return defined $home ? Cwd::abs_path($home) : undef;
+}
+
+# in theory this can be done, but for now, let's cheat, since the
+# rest is Hard
+sub users_desktop {
+ my ($class, $name) = @_;
+ return undef if $name eq 'root';
+ $class->_to_user( $class->my_desktop, $name );
+}
+
+sub users_documents {
+ my ($class, $name) = @_;
+ return undef if $name eq 'root';
+ $class->_to_user( $class->my_documents, $name );
+}
+
+sub users_data {
+ my ($class, $name) = @_;
+ $class->_to_user( $class->my_data, $name )
+ ||
+ $class->users_home($name);
+}
+
+# cheap hack ... not entirely reliable, perhaps, but ... c'est la vie, since
+# there's really no other good way to do it at this time, that i know of -- pudge
+sub _to_user {
+ my ($class, $path, $name) = @_;
+ my $my_home = $class->my_home;
+ my $users_home = $class->users_home($name);
+ defined $users_home or return undef;
+ $path =~ s/^\Q$my_home/$users_home/;
+ return $path;
+}
+
+1;
+
+=pod
+
+=head1 NAME
+
+File::HomeDir::Darwin - Find your home and other directories on Darwin (OS X)
+
+=head1 DESCRIPTION
+
+This module provides Darwin-specific implementations for determining
+common user directories. In normal usage this module will always be
+used via L<File::HomeDir>.
+
+Note -- since this module requires Mac::Carbon and Mac::Carbon does
+not work with 64-bit perls, on such systems, File::HomeDir will try
+L<File::HomeDir::Darwin::Cocoa> and then fall back to the (pure Perl)
+L<File::HomeDir::Darwin>.
+
+=head1 SYNOPSIS
+
+ use File::HomeDir;
+
+ # Find directories for the current user
+ $home = File::HomeDir->my_home; # /Users/mylogin
+ $desktop = File::HomeDir->my_desktop; # /Users/mylogin/Desktop
+ $docs = File::HomeDir->my_documents; # /Users/mylogin/Documents
+ $music = File::HomeDir->my_music; # /Users/mylogin/Music
+ $pics = File::HomeDir->my_pictures; # /Users/mylogin/Pictures
+ $videos = File::HomeDir->my_videos; # /Users/mylogin/Movies
+ $data = File::HomeDir->my_data; # /Users/mylogin/Library/Application Support
+
+=head1 TODO
+
+=over 4
+
+=item * Test with Mac OS (versions 7, 8, 9)
+
+=item * Some better way for users_* ?
+
+=back
diff --git a/lib/File/HomeDir/Darwin/Cocoa.pm b/lib/File/HomeDir/Darwin/Cocoa.pm
new file mode 100644
index 0000000..b54ea69
--- /dev/null
+++ b/lib/File/HomeDir/Darwin/Cocoa.pm
@@ -0,0 +1,165 @@
+package File::HomeDir::Darwin::Cocoa;
+
+use 5.00503;
+use strict;
+use Cwd ();
+use Carp ();
+use File::HomeDir::Darwin ();
+
+use vars qw{$VERSION @ISA};
+BEGIN {
+ $VERSION = '1.00';
+ @ISA = 'File::HomeDir::Darwin';
+
+ # Load early if in a forking environment and we have
+ # prefork, or at run-time if not.
+ local $@;
+ eval "use prefork 'Mac::SystemDirectory'";
+}
+
+
+
+
+
+#####################################################################
+# Current User Methods
+
+sub my_home {
+ my $class = shift;
+
+ # A lot of unix people and unix-derived tools rely on
+ # the ability to overload HOME. We will support it too
+ # so that they can replace raw HOME calls with File::HomeDir.
+ if ( exists $ENV{HOME} and defined $ENV{HOME} ) {
+ return $ENV{HOME};
+ }
+
+ require Mac::SystemDirectory;
+ return Mac::SystemDirectory::HomeDirectory();
+}
+
+# from 10.4
+sub my_desktop {
+ my $class = shift;
+
+ require Mac::SystemDirectory;
+ eval {
+ $class->_find_folder(Mac::SystemDirectory::NSDesktopDirectory())
+ }
+ ||
+ $class->SUPER::my_desktop;
+}
+
+# from 10.2
+sub my_documents {
+ my $class = shift;
+
+ require Mac::SystemDirectory;
+ eval {
+ $class->_find_folder(Mac::SystemDirectory::NSDocumentDirectory())
+ }
+ ||
+ $class->SUPER::my_documents;
+}
+
+# from 10.4
+sub my_data {
+ my $class = shift;
+
+ require Mac::SystemDirectory;
+ eval {
+ $class->_find_folder(Mac::SystemDirectory::NSApplicationSupportDirectory())
+ }
+ ||
+ $class->SUPER::my_data;
+}
+
+# from 10.6
+sub my_music {
+ my $class = shift;
+
+ require Mac::SystemDirectory;
+ eval {
+ $class->_find_folder(Mac::SystemDirectory::NSMusicDirectory())
+ }
+ ||
+ $class->SUPER::my_music;
+}
+
+# from 10.6
+sub my_pictures {
+ my $class = shift;
+
+ require Mac::SystemDirectory;
+ eval {
+ $class->_find_folder(Mac::SystemDirectory::NSPicturesDirectory())
+ }
+ ||
+ $class->SUPER::my_pictures;
+}
+
+# from 10.6
+sub my_videos {
+ my $class = shift;
+
+ require Mac::SystemDirectory;
+ eval {
+ $class->_find_folder(Mac::SystemDirectory::NSMoviesDirectory())
+ }
+ ||
+ $class->SUPER::my_videos;
+}
+
+sub _find_folder {
+ my $class = shift;
+ my $name = shift;
+
+ require Mac::SystemDirectory;
+ my $folder = Mac::SystemDirectory::FindDirectory($name);
+ return undef unless defined $folder;
+
+ unless ( -d $folder ) {
+ # Make sure that symlinks resolve to directories.
+ return undef unless -l $folder;
+ my $dir = readlink $folder or return;
+ return undef unless -d $dir;
+ }
+
+ return Cwd::abs_path($folder);
+}
+
+1;
+
+=pod
+
+=head1 NAME
+
+File::HomeDir::Darwin::Cocoa - Find your home and other directories on Darwin (OS X)
+
+=head1 DESCRIPTION
+
+This module provides Darwin-specific implementations for determining
+common user directories using Cocoa API through
+L<Mac::SystemDirectory>. In normal usage this module will always be
+used via L<File::HomeDir>.
+
+Theoretically, this should return the same paths as both of the other
+Darwin drivers.
+
+Because this module requires L<Mac::SystemDirectory>, if the module
+is not installed, L<File::HomeDir> will fall back to L<File::HomeDir::Darwin>.
+
+=head1 SYNOPSIS
+
+ use File::HomeDir;
+
+ # Find directories for the current user
+ $home = File::HomeDir->my_home; # /Users/mylogin
+ $desktop = File::HomeDir->my_desktop; # /Users/mylogin/Desktop
+ $docs = File::HomeDir->my_documents; # /Users/mylogin/Documents
+ $music = File::HomeDir->my_music; # /Users/mylogin/Music
+ $pics = File::HomeDir->my_pictures; # /Users/mylogin/Pictures
+ $videos = File::HomeDir->my_videos; # /Users/mylogin/Movies
+ $data = File::HomeDir->my_data; # /Users/mylogin/Library/Application Support
+
+=cut
diff --git a/lib/File/HomeDir/Driver.pm b/lib/File/HomeDir/Driver.pm
new file mode 100644
index 0000000..348f97b
--- /dev/null
+++ b/lib/File/HomeDir/Driver.pm
@@ -0,0 +1,54 @@
+package File::HomeDir::Driver;
+
+# Abstract base class that provides no functionality,
+# but confirms the class is a File::HomeDir driver class.
+
+use 5.00503;
+use strict;
+use Carp ();
+
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = '1.00';
+}
+
+sub my_home {
+ Carp::croak("$_[0] does not implement compulsory method $_[1]");
+}
+
+1;
+
+=pod
+
+=head1 NAME
+
+File::HomeDir::Driver - Base class for all File::HomeDir drivers
+
+=head1 DESCRIPTION
+
+This module is the base class for all L<File::HomeDir> drivers, and must
+be inherited from to identify a class as a driver.
+
+It is primarily provided as a convenience for this specific identification
+purpose, as L<File::HomeDir> supports the specification of custom drivers
+and an C<-E<gt>isa> check is used during the loading of the driver.
+
+=head1 AUTHOR
+
+Adam Kennedy E<lt>adamk@cpan.orgE<gt>
+
+=head1 SEE ALSO
+
+L<File::HomeDir>
+
+=head1 COPYRIGHT
+
+Copyright 2009 - 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
diff --git a/lib/File/HomeDir/FreeDesktop.pm b/lib/File/HomeDir/FreeDesktop.pm
new file mode 100644
index 0000000..c006921
--- /dev/null
+++ b/lib/File/HomeDir/FreeDesktop.pm
@@ -0,0 +1,136 @@
+package File::HomeDir::FreeDesktop;
+
+# Specific functionality for unixes running free desktops
+# compatible with (but not using) File-BaseDir-0.03
+
+# See POD at the end of the file for more documentation.
+
+use 5.00503;
+use strict;
+use Carp ();
+use File::Spec ();
+use File::Which ();
+use File::HomeDir::Unix ();
+
+use vars qw{$VERSION @ISA};
+BEGIN {
+ $VERSION = '1.00';
+ @ISA = 'File::HomeDir::Unix';
+}
+
+# xdg uses $ENV{XDG_CONFIG_HOME}/user-dirs.dirs to know where are the
+# various "my xxx" directories. That is a shell file. The official API
+# is the xdg-user-dir executable. It has no provision for assessing
+# the directories of a user that is different than the one we are
+# running under; the standard substitute user mechanisms are needed to
+# overcome this.
+
+my $xdgprog = File::Which::which('xdg-user-dir');
+
+sub _my {
+ # No quoting because input is hard-coded and only comes from this module
+ my $thingy = qx($xdgprog $_[1]);
+ chomp $thingy;
+ return $thingy;
+}
+
+# Simple stuff
+sub my_desktop { shift->_my('DESKTOP') }
+sub my_documents { shift->_my('DOCUMENTS') }
+sub my_music { shift->_my('MUSIC') }
+sub my_pictures { shift->_my('PICTURES') }
+sub my_videos { shift->_my('VIDEOS') }
+
+sub my_data {
+ $ENV{XDG_DATA_HOME}
+ or
+ File::Spec->catdir(
+ shift->my_home,
+ qw{ .local share }
+ );
+}
+
+sub my_config {
+ $ENV{XDG_CONFIG_HOME}
+ or
+ File::Spec->catdir(
+ shift->my_home,
+ qw{ .config }
+ );
+}
+
+# Custom locations (currently undocumented)
+sub my_download { shift->_my('DOWNLOAD') }
+sub my_publicshare { shift->_my('PUBLICSHARE') }
+sub my_templates { shift->_my('TEMPLATES') }
+
+sub my_cache {
+ $ENV{XDG_CACHE_HOME}
+ ||
+ File::Spec->catdir(shift->my_home, qw{ .cache });
+}
+
+
+
+
+
+#####################################################################
+# General User Methods
+
+sub users_desktop { Carp::croak('The users_desktop method is not available on an XDG based system.'); }
+sub users_documents { Carp::croak('The users_documents method is not available on an XDG based system.'); }
+sub users_music { Carp::croak('The users_music method is not available on an XDG based system.'); }
+sub users_pictures { Carp::croak('The users_pictures method is not available on an XDG based system.'); }
+sub users_videos { Carp::croak('The users_videos method is not available on an XDG based system.'); }
+sub users_data { Carp::croak('The users_data method is not available on an XDG based system.'); }
+
+1;
+
+=pod
+
+=head1 NAME
+
+File::HomeDir::FreeDesktop - Find your home and other directories on FreeDesktop.org Unix
+
+=head1 DESCRIPTION
+
+This module provides implementations for determining common user
+directories. In normal usage this module will always be
+used via L<File::HomeDir>.
+
+=head1 SYNOPSIS
+
+ use File::HomeDir;
+
+ # Find directories for the current user
+ $home = File::HomeDir->my_home; # /home/mylogin
+ $desktop = File::HomeDir->my_desktop;
+ $docs = File::HomeDir->my_documents;
+ $music = File::HomeDir->my_music;
+ $pics = File::HomeDir->my_pictures;
+ $videos = File::HomeDir->my_videos;
+ $data = File::HomeDir->my_data;
+
+=head1 AUTHORS
+
+Jerome Quelin E<lt>jquellin@cpan.org<gt>
+
+Adam Kennedy E<lt>adamk@cpan.orgE<gt>
+
+=head1 SEE ALSO
+
+L<File::HomeDir>, L<File::HomeDir::Win32> (legacy)
+
+=head1 COPYRIGHT
+
+Copyright 2009 - 2011 Jerome Quelin.
+
+Some parts copyright 2010 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
diff --git a/lib/File/HomeDir/MacOS9.pm b/lib/File/HomeDir/MacOS9.pm
new file mode 100644
index 0000000..c88ec34
--- /dev/null
+++ b/lib/File/HomeDir/MacOS9.pm
@@ -0,0 +1,150 @@
+package File::HomeDir::MacOS9;
+
+# Half-assed implementation for the legacy Mac OS9 operating system.
+# Provided mainly to provide legacy compatibility. May be removed at
+# a later date.
+
+use 5.00503;
+use strict;
+use Carp ();
+use File::HomeDir::Driver ();
+
+use vars qw{$VERSION @ISA};
+BEGIN {
+ $VERSION = '1.00';
+ @ISA = 'File::HomeDir::Driver';
+}
+
+# Load early if in a forking environment and we have
+# prefork, or at run-time if not.
+SCOPE: {
+ local $@;
+ eval "use prefork 'Mac::Files'";
+}
+
+
+
+
+
+#####################################################################
+# Current User Methods
+
+sub my_home {
+ my $class = shift;
+
+ # Try for $ENV{HOME} if we have it
+ if ( defined $ENV{HOME} ) {
+ return $ENV{HOME};
+ }
+
+ ### DESPERATION SETS IN
+
+ # We could use the desktop
+ SCOPE: {
+ local $@;
+ eval {
+ my $home = $class->my_desktop;
+ return $home if $home and -d $home;
+ };
+ }
+
+ # Desperation on any platform
+ SCOPE: {
+ # On some platforms getpwuid dies if called at all
+ local $SIG{'__DIE__'} = '';
+ my $home = (getpwuid($<))[7];
+ return $home if $home and -d $home;
+ }
+
+ Carp::croak("Could not locate current user's home directory");
+}
+
+sub my_desktop {
+ my $class = shift;
+
+ # Find the desktop via Mac::Files
+ local $SIG{'__DIE__'} = '';
+ require Mac::Files;
+ my $home = Mac::Files::FindFolder(
+ Mac::Files::kOnSystemDisk(),
+ Mac::Files::kDesktopFolderType(),
+ );
+ return $home if $home and -d $home;
+
+ Carp::croak("Could not locate current user's desktop");
+}
+
+
+
+
+
+#####################################################################
+# General User Methods
+
+sub users_home {
+ my ($class, $name) = @_;
+
+ SCOPE: {
+ # On some platforms getpwnam dies if called at all
+ local $SIG{'__DIE__'} = '';
+ my $home = (getpwnam($name))[7];
+ return $home if defined $home and -d $home;
+ }
+
+ Carp::croak("Failed to find home directory for user '$name'");
+}
+
+1;
+
+=pod
+
+=head1 NAME
+
+File::HomeDir::MacOS9 - Find your home and other directories on legacy Macs
+
+=head1 SYNOPSIS
+
+ use File::HomeDir;
+
+ # Find directories for the current user
+ $home = File::HomeDir->my_home;
+ $desktop = File::HomeDir->my_desktop;
+
+=head1 DESCRIPTION
+
+This module provides implementations for determining common user
+directories on legacy Mac hosts. In normal usage this module will always be
+used via L<File::HomeDir>.
+
+This module is no longer actively maintained, and is included only for
+extreme back-compatibility.
+
+Only the C<my_home> and C<my_desktop> methods are supported.
+
+=head1 SUPPORT
+
+See the support section the main L<File::HomeDir> module.
+
+=head1 AUTHORS
+
+Adam Kennedy E<lt>adamk@cpan.orgE<gt>
+
+Sean M. Burke E<lt>sburke@cpan.orgE<gt>
+
+=head1 SEE ALSO
+
+L<File::HomeDir>
+
+=head1 COPYRIGHT
+
+Copyright 2005 - 2011 Adam Kennedy.
+
+Some parts copyright 2000 Sean M. Burke.
+
+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
diff --git a/lib/File/HomeDir/Test.pm b/lib/File/HomeDir/Test.pm
new file mode 100644
index 0000000..8d0e12c
--- /dev/null
+++ b/lib/File/HomeDir/Test.pm
@@ -0,0 +1,137 @@
+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.00';
+ @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
diff --git a/lib/File/HomeDir/Unix.pm b/lib/File/HomeDir/Unix.pm
new file mode 100644
index 0000000..6e3c3a1
--- /dev/null
+++ b/lib/File/HomeDir/Unix.pm
@@ -0,0 +1,186 @@
+package File::HomeDir::Unix;
+
+# See POD at the end of the file for documentation
+
+use 5.00503;
+use strict;
+use Carp ();
+use File::HomeDir::Driver ();
+
+use vars qw{$VERSION @ISA};
+BEGIN {
+ $VERSION = '1.00';
+ @ISA = 'File::HomeDir::Driver';
+}
+
+
+
+
+
+#####################################################################
+# Current User Methods
+
+sub my_home {
+ my $class = shift;
+ my $home = $class->_my_home(@_);
+
+ # On Unix in general, a non-existant home means "no home"
+ # For example, "nobody"-like users might use /nonexistant
+ if ( defined $home and ! -d $home ) {
+ $home = undef;
+ }
+
+ return $home;
+}
+
+sub _my_home {
+ my $class = shift;
+ if ( exists $ENV{HOME} and defined $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};
+ }
+
+ ### More-desperate methods
+
+ # Light desperation on any (Unixish) platform
+ SCOPE: {
+ my $home = (getpwuid($<))[7];
+ return $home if $home and -d $home;
+ }
+
+ return undef;
+}
+
+# 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;
+
+=pod
+
+=head1 NAME
+
+File::HomeDir::Unix - Find your home and other directories on legacy Unix
+
+=head1 SYNOPSIS
+
+ use File::HomeDir;
+
+ # Find directories for the current user
+ $home = File::HomeDir->my_home; # /home/mylogin
+ $desktop = File::HomeDir->my_desktop; # All of these will...
+ $docs = File::HomeDir->my_documents; # ...default to home...
+ $music = File::HomeDir->my_music; # ...directory
+ $pics = File::HomeDir->my_pictures; #
+ $videos = File::HomeDir->my_videos; #
+ $data = File::HomeDir->my_data; #
+
+=head1 DESCRIPTION
+
+This module provides implementations for determining common user
+directories. In normal usage this module will always be
+used via L<File::HomeDir>.
+
+=head1 SUPPORT
+
+See the support section the main L<File::HomeDir> module.
+
+=head1 AUTHORS
+
+Adam Kennedy E<lt>adamk@cpan.orgE<gt>
+
+Sean M. Burke E<lt>sburke@cpan.orgE<gt>
+
+=head1 SEE ALSO
+
+L<File::HomeDir>, L<File::HomeDir::Win32> (legacy)
+
+=head1 COPYRIGHT
+
+Copyright 2005 - 2011 Adam Kennedy.
+
+Some parts copyright 2000 Sean M. Burke.
+
+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
diff --git a/lib/File/HomeDir/Windows.pm b/lib/File/HomeDir/Windows.pm
new file mode 100644
index 0000000..4e1de6a
--- /dev/null
+++ b/lib/File/HomeDir/Windows.pm
@@ -0,0 +1,241 @@
+package File::HomeDir::Windows;
+
+# See POD at the end of the file for documentation
+
+use 5.00503;
+use strict;
+use Carp ();
+use File::Spec ();
+use File::HomeDir::Driver ();
+
+use vars qw{$VERSION @ISA};
+BEGIN {
+ $VERSION = '1.00';
+ @ISA = 'File::HomeDir::Driver';
+}
+
+sub CREATE () { 1 }
+
+
+
+
+
+#####################################################################
+# Current User Methods
+
+sub my_home {
+ my $class = shift;
+
+ # A lot of unix people and unix-derived tools rely on
+ # the ability to overload HOME. We will support it too
+ # so that they can replace raw HOME calls with File::HomeDir.
+ if ( exists $ENV{HOME} and $ENV{HOME} ) {
+ return $ENV{HOME};
+ }
+
+ # Do we have a user profile?
+ if ( exists $ENV{USERPROFILE} and $ENV{USERPROFILE} ) {
+ return $ENV{USERPROFILE};
+ }
+
+ # Some Windows use something like $ENV{HOME}
+ if ( exists $ENV{HOMEDRIVE} and exists $ENV{HOMEPATH} and $ENV{HOMEDRIVE} and $ENV{HOMEPATH} ) {
+ return File::Spec->catpath(
+ $ENV{HOMEDRIVE}, $ENV{HOMEPATH}, '',
+ );
+ }
+
+ return undef;
+}
+
+sub my_desktop {
+ my $class = shift;
+
+ # The most correct way to find the desktop
+ SCOPE: {
+ require Win32;
+ my $dir = Win32::GetFolderPath(Win32::CSIDL_DESKTOP(), CREATE);
+ return $dir if $dir and $class->_d($dir);
+ }
+
+ # MSWindows sets WINDIR, MS WinNT sets USERPROFILE.
+ foreach my $e ( 'USERPROFILE', 'WINDIR' ) {
+ next unless $ENV{$e};
+ my $desktop = File::Spec->catdir($ENV{$e}, 'Desktop');
+ return $desktop if $desktop and $class->_d($desktop);
+ }
+
+ # As a last resort, try some hard-wired values
+ foreach my $fixed (
+ # The reason there are both types of slash here is because
+ # this set of paths has been kept from thethe original version
+ # of File::HomeDir::Win32 (before it was rewritten).
+ # I can only assume this is Cygwin-related stuff.
+ "C:\\windows\\desktop",
+ "C:\\win95\\desktop",
+ "C:/win95/desktop",
+ "C:/windows/desktop",
+ ) {
+ return $fixed if $class->_d($fixed);
+ }
+
+ return undef;
+}
+
+sub my_documents {
+ my $class = shift;
+
+ # The most correct way to find my documents
+ SCOPE: {
+ require Win32;
+ my $dir = Win32::GetFolderPath(Win32::CSIDL_PERSONAL(), CREATE);
+ return $dir if $dir and $class->_d($dir);
+ }
+
+ return undef;
+}
+
+sub my_data {
+ my $class = shift;
+
+ # The most correct way to find my documents
+ SCOPE: {
+ require Win32;
+ my $dir = Win32::GetFolderPath(Win32::CSIDL_LOCAL_APPDATA(), CREATE);
+ return $dir if $dir and $class->_d($dir);
+ }
+
+ return undef;
+}
+
+sub my_music {
+ my $class = shift;
+
+ # The most correct way to find my music
+ SCOPE: {
+ require Win32;
+ my $dir = Win32::GetFolderPath(Win32::CSIDL_MYMUSIC(), CREATE);
+ return $dir if $dir and $class->_d($dir);
+ }
+
+ return undef;
+}
+
+sub my_pictures {
+ my $class = shift;
+
+ # The most correct way to find my pictures
+ SCOPE: {
+ require Win32;
+ my $dir = Win32::GetFolderPath(Win32::CSIDL_MYPICTURES(), CREATE);
+ return $dir if $dir and $class->_d($dir);
+ }
+
+ return undef;
+}
+
+sub my_videos {
+ my $class = shift;
+
+ # The most correct way to find my videos
+ SCOPE: {
+ require Win32;
+ my $dir = Win32::GetFolderPath(Win32::CSIDL_MYVIDEO(), CREATE);
+ return $dir if $dir and $class->_d($dir);
+ }
+
+ return undef;
+}
+
+# Special case version of -d
+sub _d {
+ my $self = shift;
+ my $path = shift;
+
+ # Window can legally return a UNC path from GetFolderPath.
+ # Not only is the meaning of -d complicated in this situation,
+ # but even on a local network calling -d "\\\\cifs\\path" can
+ # take several seconds. UNC can also do even weirder things,
+ # like launching processes and such.
+ # To avoid various crazy bugs caused by this, we do NOT attempt
+ # to validate UNC paths at all so that the code that is calling
+ # us has an opportunity to take special actions without our
+ # blundering getting in the way.
+ if ( $path =~ /\\\\/ ) {
+ return 1;
+ }
+
+ # Otherwise do a stat as normal
+ return -d $path;
+}
+
+1;
+
+=pod
+
+=head1 NAME
+
+File::HomeDir::Windows - Find your home and other directories on Windows
+
+=head1 SYNOPSIS
+
+ use File::HomeDir;
+
+ # Find directories for the current user (eg. using Windows XP Professional)
+ $home = File::HomeDir->my_home; # C:\Documents and Settings\mylogin
+ $desktop = File::HomeDir->my_desktop; # C:\Documents and Settings\mylogin\Desktop
+ $docs = File::HomeDir->my_documents; # C:\Documents and Settings\mylogin\My Documents
+ $music = File::HomeDir->my_music; # C:\Documents and Settings\mylogin\My Documents\My Music
+ $pics = File::HomeDir->my_pictures; # C:\Documents and Settings\mylogin\My Documents\My Pictures
+ $videos = File::HomeDir->my_videos; # C:\Documents and Settings\mylogin\My Documents\My Video
+ $data = File::HomeDir->my_data; # C:\Documents and Settings\mylogin\Local Settings\Application Data
+
+=head1 DESCRIPTION
+
+This module provides Windows-specific implementations for determining
+common user directories. In normal usage this module will always be
+used via L<File::HomeDir>.
+
+Internally this module will use L<Win32>::GetFolderPath to fetch the location
+of your directories. As a result of this, in certain unusual situations
+(usually found inside large organisations) the methods may return UNC paths
+such as C<\\cifs.local\home$>.
+
+If your application runs on Windows and you want to have it work comprehensively
+everywhere, you may need to implement your own handling for these paths as they
+can cause strange behaviour.
+
+For example, stat calls to UNC paths may work but block for several seconds, but
+opendir() may not be able to read any files (creating the appearance of an existing
+but empty directory).
+
+To avoid complicating the problem any further, in the rare situation that a UNC path
+is returned by C<GetFolderPath> the usual -d validation checks will B<not> be done.
+
+=head1 SUPPORT
+
+See the support section the main L<File::HomeDir> module.
+
+=head1 AUTHORS
+
+Adam Kennedy E<lt>adamk@cpan.orgE<gt>
+
+Sean M. Burke E<lt>sburke@cpan.orgE<gt>
+
+=head1 SEE ALSO
+
+L<File::HomeDir>, L<File::HomeDir::Win32> (legacy)
+
+=head1 COPYRIGHT
+
+Copyright 2005 - 2011 Adam Kennedy.
+
+Some parts copyright 2000 Sean M. Burke.
+
+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
View Lorry Controller Status