File Coverage

blib/lib/File/HomeDir/Darwin.pm
Criterion Covered Total %
statement 24 62 38.7
branch 0 20 0.0
condition n/a
subroutine 9 21 42.8
pod 0 10 0.0
total 33 113 29.2


line stmt bran cond sub pod time code
1             package File::HomeDir::Darwin;
2              
3 1     1   1111 use 5.008003;
  1         5  
4 1     1   6 use strict;
  1         1  
  1         23  
5 1     1   5 use warnings;
  1         3  
  1         26  
6 1     1   6 use Cwd ();
  1         2  
  1         26  
7 1     1   6 use Carp ();
  1         3  
  1         26  
8 1     1   21 use File::HomeDir::Unix ();
  1         3  
  1         283  
9              
10 1     1   9 use vars qw{$VERSION};
  1         2  
  1         56  
11 1     1   7 use base "File::HomeDir::Unix";
  1         2  
  1         107  
12              
13             BEGIN
14             {
15 1     1   665 $VERSION = '1.004';
16             }
17              
18             #####################################################################
19             # Current User Methods
20              
21             sub _my_home
22             {
23 0     0     my ($class, $path) = @_;
24 0           my $home = $class->my_home;
25 0 0         return undef unless defined $home;
26              
27 0           my $folder = "$home/$path";
28 0 0         unless (-d $folder)
29             {
30             # Make sure that symlinks resolve to directories.
31 0 0         return undef unless -l $folder;
32 0 0         my $dir = readlink $folder or return;
33 0 0         return undef unless -d $dir;
34             }
35              
36 0           return Cwd::abs_path($folder);
37             }
38              
39             sub my_desktop
40             {
41 0     0 0   my $class = shift;
42 0           $class->_my_home('Desktop');
43             }
44              
45             sub my_documents
46             {
47 0     0 0   my $class = shift;
48 0           $class->_my_home('Documents');
49             }
50              
51             sub my_data
52             {
53 0     0 0   my $class = shift;
54 0           $class->_my_home('Library/Application Support');
55             }
56              
57             sub my_music
58             {
59 0     0 0   my $class = shift;
60 0           $class->_my_home('Music');
61             }
62              
63             sub my_pictures
64             {
65 0     0 0   my $class = shift;
66 0           $class->_my_home('Pictures');
67             }
68              
69             sub my_videos
70             {
71 0     0 0   my $class = shift;
72 0           $class->_my_home('Movies');
73             }
74              
75             #####################################################################
76             # Arbitrary User Methods
77              
78             sub users_home
79             {
80 0     0 0   my $class = shift;
81 0           my $home = $class->SUPER::users_home(@_);
82 0 0         return defined $home ? Cwd::abs_path($home) : undef;
83             }
84              
85             sub users_desktop
86             {
87 0     0 0   my ($class, $name) = @_;
88 0 0         return undef if $name eq 'root';
89 0           $class->_to_user($class->my_desktop, $name);
90             }
91              
92             sub users_documents
93             {
94 0     0 0   my ($class, $name) = @_;
95 0 0         return undef if $name eq 'root';
96 0           $class->_to_user($class->my_documents, $name);
97             }
98              
99             sub users_data
100             {
101 0     0 0   my ($class, $name) = @_;
102 0 0         $class->_to_user($class->my_data, $name)
103             || $class->users_home($name);
104             }
105              
106             # cheap hack ... not entirely reliable, perhaps, but ... c'est la vie, since
107             # there's really no other good way to do it at this time, that i know of -- pudge
108             sub _to_user
109             {
110 0     0     my ($class, $path, $name) = @_;
111 0           my $my_home = $class->my_home;
112 0           my $users_home = $class->users_home($name);
113 0 0         defined $users_home or return undef;
114 0           $path =~ s/^\Q$my_home/$users_home/;
115 0           return $path;
116             }
117              
118             1;
119              
120             =pod
121              
122             =head1 NAME
123              
124             File::HomeDir::Darwin - Find your home and other directories on Darwin (OS X)
125              
126             =head1 DESCRIPTION
127              
128             This module provides Mac OS X specific file path for determining
129             common user directories in pure perl, by just using C<$ENV{HOME}>
130             without Carbon nor Cocoa API calls. In normal usage this module will
131             always be used via L.
132              
133             =head1 SYNOPSIS
134              
135             use File::HomeDir;
136            
137             # Find directories for the current user
138             $home = File::HomeDir->my_home; # /Users/mylogin
139             $desktop = File::HomeDir->my_desktop; # /Users/mylogin/Desktop
140             $docs = File::HomeDir->my_documents; # /Users/mylogin/Documents
141             $music = File::HomeDir->my_music; # /Users/mylogin/Music
142             $pics = File::HomeDir->my_pictures; # /Users/mylogin/Pictures
143             $videos = File::HomeDir->my_videos; # /Users/mylogin/Movies
144             $data = File::HomeDir->my_data; # /Users/mylogin/Library/Application Support
145              
146             =cut