File Coverage

blib/lib/File/HomeDir/Windows.pm
Criterion Covered Total %
statement 24 79 30.3
branch 0 26 0.0
condition 0 39 0.0
subroutine 9 17 52.9
pod 0 7 0.0
total 33 168 19.6


line stmt bran cond sub pod time code
1             package File::HomeDir::Windows;
2              
3             # See POD at the end of the file for documentation
4              
5 1     1   938 use 5.008003;
  1         3  
6 1     1   5 use strict;
  1         2  
  1         20  
7 1     1   4 use warnings;
  1         2  
  1         22  
8 1     1   5 use Carp ();
  1         1  
  1         12  
9 1     1   4 use File::Spec ();
  1         2  
  1         27  
10 1     1   6 use File::HomeDir::Driver ();
  1         1  
  1         29  
11              
12 1     1   6 use vars qw{$VERSION};
  1         1  
  1         101  
13 1     1   9 use base "File::HomeDir::Driver";
  1         2  
  1         114  
14              
15             BEGIN
16             {
17 1     1   786 $VERSION = '1.006';
18             }
19              
20             sub CREATE () { 1 }
21              
22             #####################################################################
23             # Current User Methods
24              
25             sub my_home
26             {
27 0     0 0   my $class = shift;
28              
29             # A lot of unix people and unix-derived tools rely on
30             # the ability to overload HOME. We will support it too
31             # so that they can replace raw HOME calls with File::HomeDir.
32 0 0 0       if (exists $ENV{HOME} and defined $ENV{HOME} and length $ENV{HOME})
      0        
33             {
34 0           return $ENV{HOME};
35             }
36              
37             # Do we have a user profile?
38 0 0 0       if (exists $ENV{USERPROFILE} and $ENV{USERPROFILE})
39             {
40 0           return $ENV{USERPROFILE};
41             }
42              
43             # Some Windows use something like $ENV{HOME}
44 0 0 0       if (exists $ENV{HOMEDRIVE} and exists $ENV{HOMEPATH} and $ENV{HOMEDRIVE} and $ENV{HOMEPATH})
      0        
      0        
45             {
46 0           return File::Spec->catpath($ENV{HOMEDRIVE}, $ENV{HOMEPATH}, '',);
47             }
48              
49 0           return undef;
50             }
51              
52             sub my_desktop
53             {
54 0     0 0   my $class = shift;
55              
56             # The most correct way to find the desktop
57             SCOPE:
58             {
59 0           require Win32;
  0            
60 0           my $dir = Win32::GetFolderPath(Win32::CSIDL_DESKTOP(), CREATE);
61 0 0 0       return $dir if $dir and $class->_d($dir);
62             }
63              
64             # MSWindows sets WINDIR, MS WinNT sets USERPROFILE.
65 0           foreach my $e ('USERPROFILE', 'WINDIR')
66             {
67 0 0         next unless $ENV{$e};
68 0           my $desktop = File::Spec->catdir($ENV{$e}, 'Desktop');
69 0 0 0       return $desktop if $desktop and $class->_d($desktop);
70             }
71              
72             # As a last resort, try some hard-wired values
73 0           foreach my $fixed (
74             # The reason there are both types of slash here is because
75             # this set of paths has been kept from the original version
76             # of File::HomeDir::Win32 (before it was rewritten).
77             # I can only assume this is Cygwin-related stuff.
78             "C:\\windows\\desktop",
79             "C:\\win95\\desktop",
80             "C:/win95/desktop",
81             "C:/windows/desktop",
82             )
83             {
84 0 0         return $fixed if $class->_d($fixed);
85             }
86              
87 0           return undef;
88             }
89              
90             sub my_documents
91             {
92 0     0 0   my $class = shift;
93              
94             # The most correct way to find my documents
95             SCOPE:
96             {
97 0           require Win32;
  0            
98 0           my $dir = Win32::GetFolderPath(Win32::CSIDL_PERSONAL(), CREATE);
99 0 0 0       return $dir if $dir and $class->_d($dir);
100             }
101              
102 0           return undef;
103             }
104              
105             sub my_data
106             {
107 0     0 0   my $class = shift;
108              
109             # The most correct way to find my documents
110             SCOPE:
111             {
112 0           require Win32;
  0            
113 0           my $dir = Win32::GetFolderPath(Win32::CSIDL_LOCAL_APPDATA(), CREATE);
114 0 0 0       return $dir if $dir and $class->_d($dir);
115             }
116              
117 0           return undef;
118             }
119              
120             sub my_music
121             {
122 0     0 0   my $class = shift;
123              
124             # The most correct way to find my music
125             SCOPE:
126             {
127 0           require Win32;
  0            
128 0           my $dir = Win32::GetFolderPath(Win32::CSIDL_MYMUSIC(), CREATE);
129 0 0 0       return $dir if $dir and $class->_d($dir);
130             }
131              
132 0           return undef;
133             }
134              
135             sub my_pictures
136             {
137 0     0 0   my $class = shift;
138              
139             # The most correct way to find my pictures
140             SCOPE:
141             {
142 0           require Win32;
  0            
143 0           my $dir = Win32::GetFolderPath(Win32::CSIDL_MYPICTURES(), CREATE);
144 0 0 0       return $dir if $dir and $class->_d($dir);
145             }
146              
147 0           return undef;
148             }
149              
150             sub my_videos
151             {
152 0     0 0   my $class = shift;
153              
154             # The most correct way to find my videos
155             SCOPE:
156             {
157 0           require Win32;
  0            
158 0           my $dir = Win32::GetFolderPath(Win32::CSIDL_MYVIDEO(), CREATE);
159 0 0 0       return $dir if $dir and $class->_d($dir);
160             }
161              
162 0           return undef;
163             }
164              
165             # Special case version of -d
166             sub _d
167             {
168 0     0     my $self = shift;
169 0           my $path = shift;
170              
171             # Window can legally return a UNC path from GetFolderPath.
172             # Not only is the meaning of -d complicated in this situation,
173             # but even on a local network calling -d "\\\\cifs\\path" can
174             # take several seconds. UNC can also do even weirder things,
175             # like launching processes and such.
176             # To avoid various crazy bugs caused by this, we do NOT attempt
177             # to validate UNC paths at all so that the code that is calling
178             # us has an opportunity to take special actions without our
179             # blundering getting in the way.
180 0 0         if ($path =~ /\\\\/)
181             {
182 0           return 1;
183             }
184              
185             # Otherwise do a stat as normal
186 0           return -d $path;
187             }
188              
189             1;
190              
191             =pod
192              
193             =head1 NAME
194              
195             File::HomeDir::Windows - Find your home and other directories on Windows
196              
197             =head1 SYNOPSIS
198              
199             use File::HomeDir;
200            
201             # Find directories for the current user (eg. using Windows XP Professional)
202             $home = File::HomeDir->my_home; # C:\Documents and Settings\mylogin
203             $desktop = File::HomeDir->my_desktop; # C:\Documents and Settings\mylogin\Desktop
204             $docs = File::HomeDir->my_documents; # C:\Documents and Settings\mylogin\My Documents
205             $music = File::HomeDir->my_music; # C:\Documents and Settings\mylogin\My Documents\My Music
206             $pics = File::HomeDir->my_pictures; # C:\Documents and Settings\mylogin\My Documents\My Pictures
207             $videos = File::HomeDir->my_videos; # C:\Documents and Settings\mylogin\My Documents\My Video
208             $data = File::HomeDir->my_data; # C:\Documents and Settings\mylogin\Local Settings\Application Data
209              
210             =head1 DESCRIPTION
211              
212             This module provides Windows-specific implementations for determining
213             common user directories. In normal usage this module will always be
214             used via L.
215              
216             Internally this module will use L::GetFolderPath to fetch the location
217             of your directories. As a result of this, in certain unusual situations
218             (usually found inside large organizations) the methods may return UNC paths
219             such as C<\\cifs.local\home$>.
220              
221             If your application runs on Windows and you want to have it work comprehensively
222             everywhere, you may need to implement your own handling for these paths as they
223             can cause strange behaviour.
224              
225             For example, stat calls to UNC paths may work but block for several seconds, but
226             opendir() may not be able to read any files (creating the appearance of an existing
227             but empty directory).
228              
229             To avoid complicating the problem any further, in the rare situation that a UNC path
230             is returned by C the usual -d validation checks will B be done.
231              
232             =head1 SUPPORT
233              
234             See the support section the main L module.
235              
236             =head1 AUTHORS
237              
238             Adam Kennedy Eadamk@cpan.orgE
239              
240             Sean M. Burke Esburke@cpan.orgE
241              
242             =head1 SEE ALSO
243              
244             L, L (legacy)
245              
246             =head1 COPYRIGHT
247              
248             Copyright 2005 - 2011 Adam Kennedy.
249              
250             Copyright 2017 - 2020 Jens Rehsack
251              
252             Some parts copyright 2000 Sean M. Burke.
253              
254             This program is free software; you can redistribute
255             it and/or modify it under the same terms as Perl itself.
256              
257             The full text of the license can be found in the
258             LICENSE file included with this module.
259              
260             =cut