���ѧۧݧ�ӧ�� �ާ֧ߧ֧էا֧� - ���֧էѧܧ�ڧ��ӧѧ�� - /home/ukubnwwtacc0unt/chapelbellstudios.com/uploads/cover/HomeDir.tar
���ѧ٧ѧ�
Unix.pm 0000644 00000006526 15204355713 0006043 0 ustar 00 package File::HomeDir::Unix; # See POD at the end of the file for documentation use 5.00503; use strict; use Carp (); use File::HomeDir::Driver (); use vars qw{$VERSION @ISA}; BEGIN { $VERSION = '1.002'; @ISA = 'File::HomeDir::Driver'; } ##################################################################### # Current User Methods sub my_home { my $class = shift; my $home = $class->_my_home(@_); # On Unix in general, a non-existant home means "no home" # For example, "nobody"-like users might use /nonexistant if ( defined $home and ! -d $home ) { $home = undef; } return $home; } sub _my_home { my $class = shift; if ( exists $ENV{HOME} and defined $ENV{HOME} ) { return $ENV{HOME}; } # This is from the original code, but I'm guessing # it means "login directory" and exists on some Unixes. if ( exists $ENV{LOGDIR} and $ENV{LOGDIR} ) { return $ENV{LOGDIR}; } ### More-desperate methods # Light desperation on any (Unixish) platform SCOPE: { my $home = (getpwuid($<))[7]; return $home if $home and -d $home; } return undef; } # On unix by default, everything is under the same folder sub my_desktop { shift->my_home; } sub my_documents { shift->my_home; } sub my_data { shift->my_home; } sub my_music { shift->my_home; } sub my_pictures { shift->my_home; } sub my_videos { shift->my_home; } ##################################################################### # General User Methods sub users_home { my ($class, $name) = @_; # IF and only if we have getpwuid support, and the # name of the user is our own, shortcut to my_home. # This is needed to handle HOME environment settings. if ( $name eq getpwuid($<) ) { return $class->my_home; } SCOPE: { my $home = (getpwnam($name))[7]; return $home if $home and -d $home; } return undef; } sub users_desktop { shift->users_home(@_); } sub users_documents { shift->users_home(@_); } sub users_data { shift->users_home(@_); } sub users_music { shift->users_home(@_); } sub users_pictures { shift->users_home(@_); } sub users_videos { shift->users_home(@_); } 1; =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 MacOS9.pm 0000644 00000005675 15204355713 0006157 0 ustar 00 package File::HomeDir::MacOS9; # Half-assed implementation for the legacy Mac OS9 operating system. # Provided mainly to provide legacy compatibility. May be removed at # a later date. use 5.00503; use strict; use Carp (); use File::HomeDir::Driver (); use vars qw{$VERSION @ISA}; BEGIN { $VERSION = '1.002'; @ISA = 'File::HomeDir::Driver'; } # Load early if in a forking environment and we have # prefork, or at run-time if not. SCOPE: { local $@; eval "use prefork 'Mac::Files'"; } ##################################################################### # Current User Methods sub my_home { my $class = shift; # Try for $ENV{HOME} if we have it if ( defined $ENV{HOME} ) { return $ENV{HOME}; } ### DESPERATION SETS IN # We could use the desktop SCOPE: { local $@; eval { my $home = $class->my_desktop; return $home if $home and -d $home; }; } # Desperation on any platform SCOPE: { # On some platforms getpwuid dies if called at all local $SIG{'__DIE__'} = ''; my $home = (getpwuid($<))[7]; return $home if $home and -d $home; } Carp::croak("Could not locate current user's home directory"); } sub my_desktop { my $class = shift; # Find the desktop via Mac::Files local $SIG{'__DIE__'} = ''; require Mac::Files; my $home = Mac::Files::FindFolder( Mac::Files::kOnSystemDisk(), Mac::Files::kDesktopFolderType(), ); return $home if $home and -d $home; Carp::croak("Could not locate current user's desktop"); } ##################################################################### # General User Methods sub users_home { my ($class, $name) = @_; SCOPE: { # On some platforms getpwnam dies if called at all local $SIG{'__DIE__'} = ''; my $home = (getpwnam($name))[7]; return $home if defined $home and -d $home; } Carp::croak("Failed to find home directory for user '$name'"); } 1; =pod =head1 NAME File::HomeDir::MacOS9 - Find your home and other directories on legacy Macs =head1 SYNOPSIS use File::HomeDir; # Find directories for the current user $home = File::HomeDir->my_home; $desktop = File::HomeDir->my_desktop; =head1 DESCRIPTION This module provides implementations for determining common user directories on legacy Mac hosts. In normal usage this module will always be used via L<File::HomeDir>. This module is no longer actively maintained, and is included only for extreme back-compatibility. Only the C<my_home> and C<my_desktop> methods are supported. =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> =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 Windows.pm 0000644 00000014246 15204355713 0006550 0 ustar 00 package File::HomeDir::Windows; # See POD at the end of the file for documentation use 5.00503; use strict; use Carp (); use File::Spec (); use File::HomeDir::Driver (); use vars qw{$VERSION @ISA}; BEGIN { $VERSION = '1.002'; @ISA = 'File::HomeDir::Driver'; } sub CREATE () { 1 } ##################################################################### # Current User Methods sub my_home { my $class = shift; # A lot of unix people and unix-derived tools rely on # the ability to overload HOME. We will support it too # so that they can replace raw HOME calls with File::HomeDir. if ( exists $ENV{HOME} and $ENV{HOME} ) { return $ENV{HOME}; } # Do we have a user profile? if ( exists $ENV{USERPROFILE} and $ENV{USERPROFILE} ) { return $ENV{USERPROFILE}; } # Some Windows use something like $ENV{HOME} if ( exists $ENV{HOMEDRIVE} and exists $ENV{HOMEPATH} and $ENV{HOMEDRIVE} and $ENV{HOMEPATH} ) { return File::Spec->catpath( $ENV{HOMEDRIVE}, $ENV{HOMEPATH}, '', ); } return undef; } sub my_desktop { my $class = shift; # The most correct way to find the desktop SCOPE: { require Win32; my $dir = Win32::GetFolderPath(Win32::CSIDL_DESKTOP(), CREATE); return $dir if $dir and $class->_d($dir); } # MSWindows sets WINDIR, MS WinNT sets USERPROFILE. foreach my $e ( 'USERPROFILE', 'WINDIR' ) { next unless $ENV{$e}; my $desktop = File::Spec->catdir($ENV{$e}, 'Desktop'); return $desktop if $desktop and $class->_d($desktop); } # As a last resort, try some hard-wired values foreach my $fixed ( # The reason there are both types of slash here is because # this set of paths has been kept from thethe original version # of File::HomeDir::Win32 (before it was rewritten). # I can only assume this is Cygwin-related stuff. "C:\\windows\\desktop", "C:\\win95\\desktop", "C:/win95/desktop", "C:/windows/desktop", ) { return $fixed if $class->_d($fixed); } return undef; } sub my_documents { my $class = shift; # The most correct way to find my documents SCOPE: { require Win32; my $dir = Win32::GetFolderPath(Win32::CSIDL_PERSONAL(), CREATE); return $dir if $dir and $class->_d($dir); } return undef; } sub my_data { my $class = shift; # The most correct way to find my documents SCOPE: { require Win32; my $dir = Win32::GetFolderPath(Win32::CSIDL_LOCAL_APPDATA(), CREATE); return $dir if $dir and $class->_d($dir); } return undef; } sub my_music { my $class = shift; # The most correct way to find my music SCOPE: { require Win32; my $dir = Win32::GetFolderPath(Win32::CSIDL_MYMUSIC(), CREATE); return $dir if $dir and $class->_d($dir); } return undef; } sub my_pictures { my $class = shift; # The most correct way to find my pictures SCOPE: { require Win32; my $dir = Win32::GetFolderPath(Win32::CSIDL_MYPICTURES(), CREATE); return $dir if $dir and $class->_d($dir); } return undef; } sub my_videos { my $class = shift; # The most correct way to find my videos SCOPE: { require Win32; my $dir = Win32::GetFolderPath(Win32::CSIDL_MYVIDEO(), CREATE); return $dir if $dir and $class->_d($dir); } return undef; } # Special case version of -d sub _d { my $self = shift; my $path = shift; # Window can legally return a UNC path from GetFolderPath. # Not only is the meaning of -d complicated in this situation, # but even on a local network calling -d "\\\\cifs\\path" can # take several seconds. UNC can also do even weirder things, # like launching processes and such. # To avoid various crazy bugs caused by this, we do NOT attempt # to validate UNC paths at all so that the code that is calling # us has an opportunity to take special actions without our # blundering getting in the way. if ( $path =~ /\\\\/ ) { return 1; } # Otherwise do a stat as normal return -d $path; } 1; =pod =head1 NAME File::HomeDir::Windows - Find your home and other directories on Windows =head1 SYNOPSIS use File::HomeDir; # Find directories for the current user (eg. using Windows XP Professional) $home = File::HomeDir->my_home; # C:\Documents and Settings\mylogin $desktop = File::HomeDir->my_desktop; # C:\Documents and Settings\mylogin\Desktop $docs = File::HomeDir->my_documents; # C:\Documents and Settings\mylogin\My Documents $music = File::HomeDir->my_music; # C:\Documents and Settings\mylogin\My Documents\My Music $pics = File::HomeDir->my_pictures; # C:\Documents and Settings\mylogin\My Documents\My Pictures $videos = File::HomeDir->my_videos; # C:\Documents and Settings\mylogin\My Documents\My Video $data = File::HomeDir->my_data; # C:\Documents and Settings\mylogin\Local Settings\Application Data =head1 DESCRIPTION This module provides Windows-specific implementations for determining common user directories. In normal usage this module will always be used via L<File::HomeDir>. Internally this module will use L<Win32>::GetFolderPath to fetch the location of your directories. As a result of this, in certain unusual situations (usually found inside large organisations) the methods may return UNC paths such as C<\\cifs.local\home$>. If your application runs on Windows and you want to have it work comprehensively everywhere, you may need to implement your own handling for these paths as they can cause strange behaviour. For example, stat calls to UNC paths may work but block for several seconds, but opendir() may not be able to read any files (creating the appearance of an existing but empty directory). To avoid complicating the problem any further, in the rare situation that a UNC path is returned by C<GetFolderPath> the usual -d validation checks will B<not> be done. =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 Darwin/Cocoa.pm 0000644 00000007002 15204355714 0007357 0 ustar 00 package File::HomeDir::Darwin::Cocoa; use 5.00503; use strict; use Cwd (); use Carp (); use File::HomeDir::Darwin (); use vars qw{$VERSION @ISA}; BEGIN { $VERSION = '1.002'; @ISA = 'File::HomeDir::Darwin'; # Load early if in a forking environment and we have # prefork, or at run-time if not. local $@; eval "use prefork 'Mac::SystemDirectory'"; } ##################################################################### # Current User Methods sub my_home { my $class = shift; # A lot of unix people and unix-derived tools rely on # the ability to overload HOME. We will support it too # so that they can replace raw HOME calls with File::HomeDir. if ( exists $ENV{HOME} and defined $ENV{HOME} ) { return $ENV{HOME}; } require Mac::SystemDirectory; return Mac::SystemDirectory::HomeDirectory(); } # from 10.4 sub my_desktop { my $class = shift; require Mac::SystemDirectory; eval { $class->_find_folder(Mac::SystemDirectory::NSDesktopDirectory()) } || $class->SUPER::my_desktop; } # from 10.2 sub my_documents { my $class = shift; require Mac::SystemDirectory; eval { $class->_find_folder(Mac::SystemDirectory::NSDocumentDirectory()) } || $class->SUPER::my_documents; } # from 10.4 sub my_data { my $class = shift; require Mac::SystemDirectory; eval { $class->_find_folder(Mac::SystemDirectory::NSApplicationSupportDirectory()) } || $class->SUPER::my_data; } # from 10.6 sub my_music { my $class = shift; require Mac::SystemDirectory; eval { $class->_find_folder(Mac::SystemDirectory::NSMusicDirectory()) } || $class->SUPER::my_music; } # from 10.6 sub my_pictures { my $class = shift; require Mac::SystemDirectory; eval { $class->_find_folder(Mac::SystemDirectory::NSPicturesDirectory()) } || $class->SUPER::my_pictures; } # from 10.6 sub my_videos { my $class = shift; require Mac::SystemDirectory; eval { $class->_find_folder(Mac::SystemDirectory::NSMoviesDirectory()) } || $class->SUPER::my_videos; } sub _find_folder { my $class = shift; my $name = shift; require Mac::SystemDirectory; my $folder = Mac::SystemDirectory::FindDirectory($name); return undef unless defined $folder; 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); } 1; =pod =head1 NAME File::HomeDir::Darwin::Cocoa - Find your home and other directories on Darwin (OS X) =head1 DESCRIPTION This module provides Darwin-specific implementations for determining common user directories using Cocoa API through L<Mac::SystemDirectory>. In normal usage this module will always be used via L<File::HomeDir>. Theoretically, this should return the same paths as both of the other Darwin drivers. Because this module requires L<Mac::SystemDirectory>, if the module is not installed, L<File::HomeDir> will fall back to L<File::HomeDir::Darwin>. =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 Darwin/Carbon.pm 0000644 00000010770 15204355714 0007545 0 ustar 00 package File::HomeDir::Darwin::Carbon; # Basic implementation for the Dawin family of operating systems. # This includes (most prominently) Mac OS X. use 5.00503; use strict; use Cwd (); use Carp (); use File::HomeDir::Darwin (); use vars qw{$VERSION @ISA}; BEGIN { $VERSION = '1.002'; # This is only a child class of the pure Perl darwin # class so that we can do homedir detection of all three # drivers at one via ->isa. @ISA = 'File::HomeDir::Darwin'; # Load early if in a forking environment and we have # prefork, or at run-time if not. local $@; eval "use prefork 'Mac::Files'"; } ##################################################################### # Current User Methods sub my_home { my $class = shift; # A lot of unix people and unix-derived tools rely on # the ability to overload HOME. We will support it too # so that they can replace raw HOME calls with File::HomeDir. if ( exists $ENV{HOME} and defined $ENV{HOME} ) { return $ENV{HOME}; } require Mac::Files; $class->_find_folder( Mac::Files::kCurrentUserFolderType(), ); } sub my_desktop { my $class = shift; require Mac::Files; $class->_find_folder( Mac::Files::kDesktopFolderType(), ); } sub my_documents { my $class = shift; require Mac::Files; $class->_find_folder( Mac::Files::kDocumentsFolderType(), ); } sub my_data { my $class = shift; require Mac::Files; $class->_find_folder( Mac::Files::kApplicationSupportFolderType(), ); } sub my_music { my $class = shift; require Mac::Files; $class->_find_folder( Mac::Files::kMusicDocumentsFolderType(), ); } sub my_pictures { my $class = shift; require Mac::Files; $class->_find_folder( Mac::Files::kPictureDocumentsFolderType(), ); } sub my_videos { my $class = shift; require Mac::Files; $class->_find_folder( Mac::Files::kMovieDocumentsFolderType(), ); } sub _find_folder { my $class = shift; my $name = shift; require Mac::Files; my $folder = Mac::Files::FindFolder( Mac::Files::kUserDomain(), $name, ); return undef unless defined $folder; 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); } ##################################################################### # Arbitrary User Methods sub users_home { my $class = shift; my $home = $class->SUPER::users_home(@_); return defined $home ? Cwd::abs_path($home) : undef; } # in theory this can be done, but for now, let's cheat, since the # rest is Hard 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 Darwin-specific implementations for determining common user directories. In normal usage this module will always be used via L<File::HomeDir>. Note -- since this module requires Mac::Carbon and Mac::Carbon does not work with 64-bit perls, on such systems, File::HomeDir will try L<File::HomeDir::Darwin::Cocoa> and then fall back to the (pure Perl) L<File::HomeDir::Darwin>. =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 =head1 TODO =over 4 =item * Test with Mac OS (versions 7, 8, 9) =item * Some better way for users_* ? =back Darwin.pm 0000644 00000006276 15204355715 0006350 0 ustar 00 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.002'; @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 Test.pm 0000644 00000005704 15204355715 0006036 0 ustar 00 package File::HomeDir::Test; use 5.00503; use strict; use Carp (); use File::Spec (); use File::Temp (); use File::HomeDir::Driver (); use vars qw{$VERSION @ISA %DIR $ENABLED}; BEGIN { $VERSION = '1.002'; @ISA = 'File::HomeDir::Driver'; %DIR = (); $ENABLED = 0; } # Special magic use in test scripts sub import { my $class = shift; die "Attempted to initialise File::HomeDir::Test trice" if %DIR; # Fill the test directories my $BASE = File::Temp::tempdir( CLEANUP => 1 ); %DIR = map { $_ => File::Spec->catdir( $BASE, $_ ) } qw{ my_home my_desktop my_documents my_data my_music my_pictures my_videos }; # Hijack HOME to the home directory $ENV{HOME} = $DIR{my_home}; # Make File::HomeDir load us instead of the native driver $File::HomeDir::IMPLEMENTED_BY = # Prevent a warning $File::HomeDir::IMPLEMENTED_BY = 'File::HomeDir::Test'; # Ready to go $ENABLED = 1; } ##################################################################### # Current User Methods sub my_home { mkdir($DIR{my_home}, 0755) unless -d $DIR{my_home}; return $DIR{my_home}; } sub my_desktop { mkdir($DIR{my_desktop}, 0755) unless -d $DIR{my_desktop}; return $DIR{my_desktop}; } sub my_documents { mkdir($DIR{my_documents}, 0755) unless -f $DIR{my_documents}; return $DIR{my_documents}; } sub my_data { mkdir($DIR{my_data}, 0755) unless -d $DIR{my_data}; return $DIR{my_data}; } sub my_music { mkdir($DIR{my_music}, 0755) unless -d $DIR{my_music}; return $DIR{my_music}; } sub my_pictures { mkdir($DIR{my_pictures}, 0755) unless -d $DIR{my_pictures}; return $DIR{my_pictures}; } sub my_videos { mkdir($DIR{my_videos}, 0755) unless -d $DIR{my_videos}; return $DIR{my_videos}; } sub users_home { return undef; } 1; __END__ =pod =head1 NAME File::HomeDir::Test - Prevent the accidental creation of user-owned files during testing =head1 SYNOPSIS use Test::More test => 1; use File::HomeDir::Test; use File::HomeDir; =head1 DESCRIPTION B<File::HomeDir::Test> is a L<File::HomeDir> driver intended for use in the test scripts of modules or applications that write files into user-owned directories. It is designed to prevent the pollution of user directories with files that are not part of the application install itself, but were created during testing. These files can leak state information from the tests into the run-time usage of an application, and on Unix systems also prevents tests (which may be executed as root via sudo) from writing files which cannot later be modified or removed by the regular user. =head1 SUPPORT See the support section of the main L<File::HomeDir> documentation. =head1 AUTHOR Adam Kennedy E<lt>adamk@cpan.orgE<gt> =head1 COPYRIGHT Copyright 2005 - 2011 Adam Kennedy. 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 FreeDesktop.pm 0000644 00000007064 15204355715 0007333 0 ustar 00 package File::HomeDir::FreeDesktop; # Specific functionality for unixes running free desktops # compatible with (but not using) File-BaseDir-0.03 # See POD at the end of the file for more documentation. use 5.00503; use strict; use Carp (); use File::Spec (); use File::Which (); use File::HomeDir::Unix (); use vars qw{$VERSION @ISA}; BEGIN { $VERSION = '1.002'; @ISA = 'File::HomeDir::Unix'; } # xdg uses $ENV{XDG_CONFIG_HOME}/user-dirs.dirs to know where are the # various "my xxx" directories. That is a shell file. The official API # is the xdg-user-dir executable. It has no provision for assessing # the directories of a user that is different than the one we are # running under; the standard substitute user mechanisms are needed to # overcome this. my $xdgprog = File::Which::which('xdg-user-dir'); sub _my { # No quoting because input is hard-coded and only comes from this module my $thingy = qx($xdgprog $_[1]); chomp $thingy; return $thingy; } # Simple stuff sub my_desktop { shift->_my('DESKTOP') } sub my_documents { shift->_my('DOCUMENTS') } sub my_music { shift->_my('MUSIC') } sub my_pictures { shift->_my('PICTURES') } sub my_videos { shift->_my('VIDEOS') } sub my_data { $ENV{XDG_DATA_HOME} or File::Spec->catdir( shift->my_home, qw{ .local share } ); } sub my_config { $ENV{XDG_CONFIG_HOME} or File::Spec->catdir( shift->my_home, qw{ .config } ); } # Custom locations (currently undocumented) sub my_download { shift->_my('DOWNLOAD') } sub my_publicshare { shift->_my('PUBLICSHARE') } sub my_templates { shift->_my('TEMPLATES') } sub my_cache { $ENV{XDG_CACHE_HOME} || File::Spec->catdir(shift->my_home, qw{ .cache }); } ##################################################################### # General User Methods sub users_desktop { Carp::croak('The users_desktop method is not available on an XDG based system.'); } sub users_documents { Carp::croak('The users_documents method is not available on an XDG based system.'); } sub users_music { Carp::croak('The users_music method is not available on an XDG based system.'); } sub users_pictures { Carp::croak('The users_pictures method is not available on an XDG based system.'); } sub users_videos { Carp::croak('The users_videos method is not available on an XDG based system.'); } sub users_data { Carp::croak('The users_data method is not available on an XDG based system.'); } 1; =pod =head1 NAME File::HomeDir::FreeDesktop - Find your home and other directories on FreeDesktop.org Unix =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 SYNOPSIS use File::HomeDir; # Find directories for the current user $home = File::HomeDir->my_home; # /home/mylogin $desktop = File::HomeDir->my_desktop; $docs = File::HomeDir->my_documents; $music = File::HomeDir->my_music; $pics = File::HomeDir->my_pictures; $videos = File::HomeDir->my_videos; $data = File::HomeDir->my_data; =head1 AUTHORS Jerome Quelin E<lt>jquellin@cpan.org<gt> Adam Kennedy E<lt>adamk@cpan.orgE<gt> =head1 SEE ALSO L<File::HomeDir>, L<File::HomeDir::Win32> (legacy) =head1 COPYRIGHT Copyright 2009 - 2011 Jerome Quelin. Some parts copyright 2010 Adam Kennedy. 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 Driver.pm 0000644 00000002143 15204355715 0006344 0 ustar 00 package File::HomeDir::Driver; # Abstract base class that provides no functionality, # but confirms the class is a File::HomeDir driver class. use 5.00503; use strict; use Carp (); use vars qw{$VERSION}; BEGIN { $VERSION = '1.002'; } sub my_home { Carp::croak("$_[0] does not implement compulsory method $_[1]"); } 1; =pod =head1 NAME File::HomeDir::Driver - Base class for all File::HomeDir drivers =head1 DESCRIPTION This module is the base class for all L<File::HomeDir> drivers, and must be inherited from to identify a class as a driver. It is primarily provided as a convenience for this specific identification purpose, as L<File::HomeDir> supports the specification of custom drivers and an C<-E<gt>isa> check is used during the loading of the driver. =head1 AUTHOR Adam Kennedy E<lt>adamk@cpan.orgE<gt> =head1 SEE ALSO L<File::HomeDir> =head1 COPYRIGHT Copyright 2009 - 2011 Adam Kennedy. 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
| ver. 1.4 |
Github
|
.
| PHP 8.1.34 | ���֧ߧ֧�ѧ�ڧ� ����ѧߧڧ��: 0.1 |
proxy
|
phpinfo
|
���ѧ����ۧܧ�