Skip to content

Instantly share code, notes, and snippets.

Created October 1, 2009 00:53
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save anonymous/198615 to your computer and use it in GitHub Desktop.
Index: t/11_darwin.t
===================================================================
--- t/11_darwin.t (revision 9435)
+++ t/11_darwin.t (working copy)
@@ -48,7 +48,7 @@
unless ( defined $users_home ) {
skip( "File::HomeDir->users_home('$user') undefined", 1 );
}
- unless ( $my_home eq $users_home ) {
+ if ( $my_home eq $users_home ) {
skip( "Users '$me' and '$user' have same home", 1 );
}
my $my_data = eval { File::HomeDir->my_data() };
Index: t/12_darwin_perl.t
===================================================================
--- t/12_darwin_perl.t (revision 0)
+++ t/12_darwin_perl.t (revision 0)
@@ -0,0 +1,69 @@
+#!/usr/bin/perl
+
+use strict;
+BEGIN {
+ $| = 1;
+ $^W = 1;
+}
+
+use Test::More;
+use File::HomeDir;
+
+if ( $File::HomeDir::IMPLEMENTED_BY =~ /^File::HomeDir::Darwin/ ) {
+ # force pure perl since it should work everywhere
+ require File::HomeDir::DarwinPerl;
+ $File::HomeDir::IMPLEMENTED_BY = 'File::HomeDir::DarwinPerl';
+ plan( tests => 2 );
+} else {
+ plan( skip_all => "Not running on Darwin" );
+ exit(0);
+}
+
+SKIP: {
+ my $user;
+ foreach (0 .. 9) {
+ my $temp = sprintf 'fubar%04d', rand(10000);
+ getpwnam $temp and next;
+ $user = $temp;
+ last;
+ }
+ $user or skip("Unable to find non-existent user", 1);
+ $@ = undef;
+ my $home = eval {File::HomeDir->users_home($user)};
+ $@ and skip("Unable to execute File::HomeDir->users_home('$user')", 1);
+ ok (!defined $home, "Home of non-existent user should be undef");
+}
+
+SKIP: {
+ my $user;
+ foreach my $uid (501 .. 540) {
+ $uid == $< and next;
+ $user = getpwuid $uid or next;
+ last;
+ }
+ $user or skip("Unable to find another user", 1);
+ my $me = getpwuid $<;
+ my $my_home = eval { File::HomeDir->my_home() };
+ unless ( defined $my_home ) {
+ skip( "File::HomeDir->my_home() undefined", 1 );
+ }
+ my $users_home = eval { File::HomeDir->users_home($user) };
+ unless ( defined $users_home ) {
+ skip( "File::HomeDir->users_home('$user') undefined", 1 );
+ }
+ if ( $my_home eq $users_home ) {
+ skip( "Users '$me' and '$user' have same home", 1 );
+ }
+ my $my_data = eval { File::HomeDir->my_data() };
+ unless ( defined $my_data ) {
+ skip( "File::HomeDir->my_data() undefined", 1 );
+ }
+ my $users_data = eval { File::HomeDir->users_data($user) };
+ unless ( defined $users_data ) {
+ skip( "File::HomeDir->users_data('$user') undefined", 1 );
+ }
+ ok (
+ $my_data ne $users_data,
+ "Users '$me' and '$user' should have different data",
+ );
+}
Property changes on: t/12_darwin_perl.t
___________________________________________________________________
Name: svn:executable
+ *
Index: t/13_darwin_cocoa.t
===================================================================
--- t/13_darwin_cocoa.t (revision 0)
+++ t/13_darwin_cocoa.t (revision 0)
@@ -0,0 +1,69 @@
+#!/usr/bin/perl
+
+use strict;
+BEGIN {
+ $| = 1;
+ $^W = 1;
+}
+
+use Test::More;
+use File::HomeDir;
+
+if ( $File::HomeDir::IMPLEMENTED_BY =~ /Darwin/ && eval "require Mac::SystemDirectory; 1" ) {
+ # force Cocoa if you have Mac::SystemDirectory
+ require File::HomeDir::DarwinCocoa;
+ $File::HomeDir::IMPLEMENTED_BY = 'File::HomeDir::DarwinCocoa';
+ plan( tests => 2 );
+} else {
+ plan( skip_all => "Not running on Darwin with Cocoa API using Mac::SystemDirectory" );
+ exit(0);
+}
+
+SKIP: {
+ my $user;
+ foreach (0 .. 9) {
+ my $temp = sprintf 'fubar%04d', rand(10000);
+ getpwnam $temp and next;
+ $user = $temp;
+ last;
+ }
+ $user or skip("Unable to find non-existent user", 1);
+ $@ = undef;
+ my $home = eval {File::HomeDir->users_home($user)};
+ $@ and skip("Unable to execute File::HomeDir->users_home('$user')", 1);
+ ok (!defined $home, "Home of non-existent user should be undef");
+}
+
+SKIP: {
+ my $user;
+ foreach my $uid (501 .. 540) {
+ $uid == $< and next;
+ $user = getpwuid $uid or next;
+ last;
+ }
+ $user or skip("Unable to find another user", 1);
+ my $me = getpwuid $<;
+ my $my_home = eval { File::HomeDir->my_home() };
+ unless ( defined $my_home ) {
+ skip( "File::HomeDir->my_home() undefined", 1 );
+ }
+ my $users_home = eval { File::HomeDir->users_home($user) };
+ unless ( defined $users_home ) {
+ skip( "File::HomeDir->users_home('$user') undefined", 1 );
+ }
+ if ( $my_home eq $users_home ) {
+ skip( "Users '$me' and '$user' have same home", 1 );
+ }
+ my $my_data = eval { File::HomeDir->my_data() };
+ unless ( defined $my_data ) {
+ skip( "File::HomeDir->my_data() undefined", 1 );
+ }
+ my $users_data = eval { File::HomeDir->users_data($user) };
+ unless ( defined $users_data ) {
+ skip( "File::HomeDir->users_data('$user') undefined", 1 );
+ }
+ ok (
+ $my_data ne $users_data,
+ "Users '$me' and '$user' should have different data",
+ );
+}
Property changes on: t/13_darwin_cocoa.t
___________________________________________________________________
Name: svn:executable
+ *
Index: lib/File/HomeDir.pm
===================================================================
--- lib/File/HomeDir.pm (revision 9435)
+++ lib/File/HomeDir.pm (working copy)
@@ -54,9 +54,23 @@
} elsif ( $^O eq 'MSWin32' ) {
# All versions of Windows
$IMPLEMENTED_BY = 'File::HomeDir::Windows';
-} elsif ( $^O eq 'darwin' && $Config::Config{ptrsize} != 8 ) {
- # Modern Max OS X, but fallback to unix on 64 bit
- $IMPLEMENTED_BY = 'File::HomeDir::Darwin';
+} elsif ( $^O eq 'darwin') {
+ TRY: {
+ if ($Config::Config{ptrsize} == 8) {
+ # 64bit: try Mac::SystemDirectory by chansen
+ if (eval { require Mac::SystemDirectory; 1 }) {
+ $IMPLEMENTED_BY = 'File::HomeDir::DarwinCocoa';
+ last TRY;
+ }
+ } elsif (eval { require Mac::Files; 1 }) {
+ # 32bit and has Mac::Files: Carbon
+ $IMPLEMENTED_BY = 'File::HomeDir::Darwin';
+ last TRY;
+ }
+
+ # fallback: pure perl
+ $IMPLEMENTED_BY = 'File::HomeDir::DarwinPerl';
+ }
} elsif ( $^O eq 'MacOS' ) {
# Legacy Mac OS
$IMPLEMENTED_BY = 'File::HomeDir::MacOS9';
Index: lib/File/HomeDir/Darwin.pm
===================================================================
--- lib/File/HomeDir/Darwin.pm (revision 9435)
+++ lib/File/HomeDir/Darwin.pm (working copy)
@@ -168,14 +168,14 @@
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 fall back
-to File::HomeDir::Unix instead.
+Note -- since this module requires Mac::Carbon and Mac::Carbon does
+not work with 64-bit perls, on such systems, File::HomeDir will try
+File::HomeDir::DarwinCocoa and then fall back to File::HomeDir::DarwinPerl.
=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
@@ -189,8 +189,6 @@
=over 4
-=item * Fallback to Unix if no Mac::Carbon available
-
=item * Test with Mac OS (versions 7, 8, 9)
=item * Some better way for users_* ?
Index: lib/File/HomeDir/DarwinPerl.pm
===================================================================
--- lib/File/HomeDir/DarwinPerl.pm (revision 0)
+++ lib/File/HomeDir/DarwinPerl.pm (revision 0)
@@ -0,0 +1,143 @@
+package File::HomeDir::DarwinPerl;
+
+use 5.00503;
+use strict;
+use Cwd ();
+use Carp ();
+use File::HomeDir::Unix ();
+
+use vars qw{$VERSION @ISA};
+BEGIN {
+ $VERSION = '0.86';
+ @ISA = 'File::HomeDir::Unix';
+}
+
+#####################################################################
+# Current User Methods
+
+sub my_home {
+ my ($class) = @_;
+
+ 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 unless -l $folder;
+ my $dir = readlink $folder or return;
+ return unless -d $dir;
+ }
+
+ return Cwd::abs_path($folder);
+}
+
+sub my_desktop {
+ my ($class) = @_;
+ $class->_my_home('Desktop');
+}
+
+sub my_documents {
+ my ($class) = @_;
+ $class->_my_home('Documents');
+}
+
+sub my_data {
+ my ($class) = @_;
+ $class->_my_home('Library/Application Support');
+}
+
+sub my_music {
+ my ($class) = @_;
+ $class->_my_home('Music');
+}
+
+sub my_pictures {
+ my ($class) = @_;
+ $class->_my_home('Pictures');
+}
+
+sub my_videos {
+ my ($class) = @_;
+ $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::DarwinPerl - find your home and other directories, on Darwin (OS X) without Carbon/Cocoa
+
+=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<F
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment