File Coverage

blib/lib/File/HomeDir/Unix.pm
Criterion Covered Total %
statement 47 60 78.3
branch 5 12 41.6
condition 8 21 38.1
subroutine 19 25 76.0
pod 0 14 0.0
total 79 132 59.8


line stmt bran cond sub pod time code
1             package File::HomeDir::Unix;
2              
3             # See POD at the end of the file for documentation
4              
5 6     6   1033 use 5.008003;
  6         21  
6 6     6   32 use strict;
  6         12  
  6         119  
7 6     6   29 use warnings;
  6         10  
  6         173  
8 6     6   35 use Carp ();
  6         10  
  6         120  
9 6     6   2045 use File::HomeDir::Driver ();
  6         11  
  6         146  
10              
11 6     6   36 use vars qw{$VERSION};
  6         12  
  6         237  
12 6     6   32 use base "File::HomeDir::Driver";
  6         12  
  6         616  
13              
14             BEGIN
15             {
16 6     6   3780 $VERSION = '1.006';
17             }
18              
19             #####################################################################
20             # Current User Methods
21              
22             sub my_home
23             {
24 18     18 0 35 my $class = shift;
25 18         42 my $home = $class->_guess_home(@_);
26              
27             # On Unix in general, a non-existent home means "no home"
28             # For example, "nobody"-like users might use /nonexistent
29 18 50 33     278 if (defined $home and not -d $home)
30             {
31 0         0 $home = undef;
32             }
33              
34 18         101 return $home;
35             }
36              
37             sub _guess_env_home
38             {
39 18     18   28 my $class = shift;
40 18 100 33     122 if (exists $ENV{HOME} and defined $ENV{HOME} and length $ENV{HOME})
      66        
41             {
42 17         50 return $ENV{HOME};
43             }
44              
45             # This is from the original code, but I'm guessing
46             # it means "login directory" and exists on some Unixes.
47 1 0 33     5 if (exists $ENV{LOGDIR} and $ENV{LOGDIR})
48             {
49 0         0 return $ENV{LOGDIR};
50             }
51              
52 1         3 return;
53             }
54              
55             sub _guess_determined_home
56             {
57 1     1   3 my $class = shift;
58              
59             # Light desperation on any (Unixish) platform
60             SCOPE:
61             {
62 1         2 my $home = (getpwuid($<))[7];
  1         81  
63 1 50 33     25 return $home if $home and -d $home;
64             }
65              
66 0         0 return;
67             }
68              
69             sub _guess_home
70             {
71 18     18   29 my $class = shift;
72 18         36 my $home = $class->_guess_env_home($@);
73 18   66     44 $home ||= $class->_guess_determined_home($@);
74 18         30 return $home;
75             }
76              
77             # On unix by default, everything is under the same folder
78             sub my_desktop
79             {
80 2     2 0 7 shift->my_home;
81             }
82              
83             sub my_documents
84             {
85 2     2 0 6 shift->my_home;
86             }
87              
88             sub my_data
89             {
90 2     2 0 7 shift->my_home;
91             }
92              
93             sub my_music
94             {
95 2     2 0 5 shift->my_home;
96             }
97              
98             sub my_pictures
99             {
100 2     2 0 6 shift->my_home;
101             }
102              
103             sub my_videos
104             {
105 2     2 0 6 shift->my_home;
106             }
107              
108             #####################################################################
109             # General User Methods
110              
111             sub users_home
112             {
113 1     1 0 4 my ($class, $name) = @_;
114              
115             # IF and only if we have getpwuid support, and the
116             # name of the user is our own, shortcut to my_home.
117             # This is needed to handle HOME environment settings.
118 1 50       55 if ($name eq getpwuid($<))
119             {
120 1         5 return $class->my_home;
121             }
122              
123             SCOPE:
124             {
125 0           my $home = (getpwnam($name))[7];
  0            
126 0 0 0       return $home if $home and -d $home;
127             }
128              
129 0           return undef;
130             }
131              
132             sub users_desktop
133             {
134 0     0 0   shift->users_home(@_);
135             }
136              
137             sub users_documents
138             {
139 0     0 0   shift->users_home(@_);
140             }
141              
142             sub users_data
143             {
144 0     0 0   shift->users_home(@_);
145             }
146              
147             sub users_music
148             {
149 0     0 0   shift->users_home(@_);
150             }
151              
152             sub users_pictures
153             {
154 0     0 0   shift->users_home(@_);
155             }
156              
157             sub users_videos
158             {
159 0     0 0   shift->users_home(@_);
160             }
161              
162             1;
163              
164             =pod
165              
166             =head1 NAME
167              
168             File::HomeDir::Unix - Find your home and other directories on legacy Unix
169              
170             =head1 SYNOPSIS
171              
172             use File::HomeDir;
173            
174             # Find directories for the current user
175             $home = File::HomeDir->my_home; # /home/mylogin
176             $desktop = File::HomeDir->my_desktop; # All of these will...
177             $docs = File::HomeDir->my_documents; # ...default to home...
178             $music = File::HomeDir->my_music; # ...directory
179             $pics = File::HomeDir->my_pictures; #
180             $videos = File::HomeDir->my_videos; #
181             $data = File::HomeDir->my_data; #
182              
183             =head1 DESCRIPTION
184              
185             This module provides implementations for determining common user
186             directories. In normal usage this module will always be
187             used via L.
188              
189             =head1 SUPPORT
190              
191             See the support section the main L module.
192              
193             =head1 AUTHORS
194              
195             Adam Kennedy Eadamk@cpan.orgE
196              
197             Sean M. Burke Esburke@cpan.orgE
198              
199             =head1 SEE ALSO
200              
201             L, L (legacy)
202              
203             =head1 COPYRIGHT
204              
205             Copyright 2005 - 2011 Adam Kennedy.
206              
207             Copyright 2017 - 2020 Jens Rehsack
208              
209             Some parts copyright 2000 Sean M. Burke.
210              
211             This program is free software; you can redistribute
212             it and/or modify it under the same terms as Perl itself.
213              
214             The full text of the license can be found in the
215             LICENSE file included with this module.
216              
217             =cut