1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
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
|
