File Coverage

File:local/lib/perl5/File/HomeDir/Unix.pm
Coverage:36.1%

linestmtbrancondsubtimecode
1package File::HomeDir::Unix;
2
3# See POD at the end of the file for documentation
4
5
2
2
2
14
3
use 5.00503;
6
2
2
2
2
2
2
19
use strict;
7
2
2
2
2
2
2
7
use Carp                  ();
8
2
2
2
2
310
2
17
use File::HomeDir::Driver ();
9
10
2
2
2
2
3
2
49
use vars qw{$VERSION @ISA};
11BEGIN {
12
2
2
2
        $VERSION = '1.00';
13
2
331
        @ISA     = 'File::HomeDir::Driver';
14}
15
16
17
18
19
20#####################################################################
21# Current User Methods
22
23sub my_home {
24
2
2
2
        my $class = shift;
25
2
4
        my $home  = $class->_my_home(@_);
26
27        # On Unix in general, a non-existant home means "no home"
28        # For example, "nobody"-like users might use /nonexistant
29
2
50
33
10
        if ( defined $home and ! -d $home ) {
30
0
0
                $home = undef;
31        }
32
33
2
14
        return $home;
34}
35
36sub _my_home {
37
2
2
2
        my $class = shift;
38
2
50
33
9
        if ( exists $ENV{HOME} and defined $ENV{HOME} ) {
39
2
4
                return $ENV{HOME};
40        }
41
42        # This is from the original code, but I'm guessing
43        # it means "login directory" and exists on some Unixes.
44
0
0
0
        if ( exists $ENV{LOGDIR} and $ENV{LOGDIR} ) {
45
0
                return $ENV{LOGDIR};
46        }
47
48        ### More-desperate methods
49
50        # Light desperation on any (Unixish) platform
51        SCOPE: {
52
0
0
                my $home = (getpwuid($<))[7];
53
0
0
0
                return $home if $home and -d $home;
54        }
55
56
0
        return undef;
57}
58
59# On unix by default, everything is under the same folder
60sub my_desktop {
61
0
0
        shift->my_home;
62}
63
64sub my_documents {
65
0
0
        shift->my_home;
66}
67
68sub my_data {
69
0
0
        shift->my_home;
70}
71
72sub my_music {
73
0
0
        shift->my_home;
74}
75
76sub my_pictures {
77
0
0
        shift->my_home;
78}
79
80sub my_videos {
81
0
0
        shift->my_home;
82}
83
84
85
86
87
88#####################################################################
89# General User Methods
90
91sub users_home {
92
0
0
        my ($class, $name) = @_;
93
94        # IF and only if we have getpwuid support, and the
95        # name of the user is our own, shortcut to my_home.
96        # This is needed to handle HOME environment settings.
97
0
0
        if ( $name eq getpwuid($<) ) {
98
0
                return $class->my_home;
99        }
100
101        SCOPE: {
102
0
0
                my $home = (getpwnam($name))[7];
103
0
0
0
                return $home if $home and -d $home;
104        }
105
106
0
        return undef;
107}
108
109sub users_desktop {
110
0
0
        shift->users_home(@_);
111}
112
113sub users_documents {
114
0
0
        shift->users_home(@_);
115}
116
117sub users_data {
118
0
0
        shift->users_home(@_);
119}
120
121sub users_music {
122
0
0
        shift->users_home(@_);
123}
124
125sub users_pictures {
126
0
0
        shift->users_home(@_);
127}
128
129sub users_videos {
130
0
0
        shift->users_home(@_);
131}
132
1331;
134
135 - 186
=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