r70340 - in /branches/upstream/libfile-homedir-perl/current: ./ lib/File/ lib/File/HomeDir/ lib/File/HomeDir/Darwin/ t/
angelabad-guest at users.alioth.debian.org
angelabad-guest at users.alioth.debian.org
Fri Mar 4 11:52:32 UTC 2011
Author: angelabad-guest
Date: Fri Mar 4 11:52:22 2011
New Revision: 70340
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=70340
Log:
[svn-upgrade] new version libfile-homedir-perl (0.97)
Modified:
branches/upstream/libfile-homedir-perl/current/Changes
branches/upstream/libfile-homedir-perl/current/META.yml
branches/upstream/libfile-homedir-perl/current/Makefile.PL
branches/upstream/libfile-homedir-perl/current/README
branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir.pm
branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Darwin.pm
branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Darwin/Carbon.pm
branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Darwin/Cocoa.pm
branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Driver.pm
branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/FreeDesktop.pm
branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/MacOS9.pm
branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Test.pm
branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Unix.pm
branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Windows.pm
branches/upstream/libfile-homedir-perl/current/t/02_main.t
branches/upstream/libfile-homedir-perl/current/t/11_darwin.t
branches/upstream/libfile-homedir-perl/current/t/12_darwin_carbon.t
branches/upstream/libfile-homedir-perl/current/t/13_darwin_cocoa.t
Modified: branches/upstream/libfile-homedir-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-homedir-perl/current/Changes?rev=70340&op=diff
==============================================================================
--- branches/upstream/libfile-homedir-perl/current/Changes (original)
+++ branches/upstream/libfile-homedir-perl/current/Changes Fri Mar 4 11:52:22 2011
@@ -1,4 +1,28 @@
Changes for Perl extension File-HomeDir
+
+0.97 Sun 20 Feb 2011
+ - Looks good, moving to production release
+ - This should finally pass on ActivePerl Mac
+
+0.96_04 Tue 1 Feb 2011
+ - Typo in 11_darwin.t
+
+0.96_03 Mon 31 Jan 2011
+ - Return undef in list context on Mac as per the documentation
+
+0.96_02 Mon 31 Jan 2011
+ - No longer assume we have Application Support, sigh
+
+0.96_01 Mon 31 Jan 2011
+ - Removed a dubious "different users have different data" test on Macs
+ - Removed tests for legacy %~ interface
+
+0.95 Mon 31 Jan 2011
+ - Switch to prod version
+
+0.94_01 Tue 14 Dec 2010
+ - More special casing in tests to deal with stripped down non-root
+ Mac environments (mostly to make BINGOS' automated testing pass)
0.93 Wed 13 Sep 2010
- Production release, no changes from 0.92_05
Modified: branches/upstream/libfile-homedir-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-homedir-perl/current/META.yml?rev=70340&op=diff
==============================================================================
--- branches/upstream/libfile-homedir-perl/current/META.yml (original)
+++ branches/upstream/libfile-homedir-perl/current/META.yml Fri Mar 4 11:52:22 2011
@@ -32,4 +32,4 @@
ChangeLog: http://fisheye2.atlassian.com/changelog/cpan/trunk/File-HomeDir
license: http://dev.perl.org/licenses/
repository: http://svn.ali.as/cpan/trunk/File-HomeDir
-version: 0.93
+version: 0.97
Modified: branches/upstream/libfile-homedir-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-homedir-perl/current/Makefile.PL?rev=70340&op=diff
==============================================================================
--- branches/upstream/libfile-homedir-perl/current/Makefile.PL (original)
+++ branches/upstream/libfile-homedir-perl/current/Makefile.PL Fri Mar 4 11:52:22 2011
@@ -12,16 +12,29 @@
# Dependencies for specific platforms
### Use variable twice to avoid a warning
-if ( $MacPerl::Version and $MacPerl::Version ) {
- # Old Mac OS 9
- requires 'Mac::Files' => 0;
+if ( $MacPerl::Version and $MacPerl::Version
+ or $^O eq 'darwin' and _check_old_mac_os_x() ) {
+ # Old Mac OS 9, or Mac OS X before Mac::SystemDirectory is supported.
+ requires 'Mac::Files' => 0;
} elsif ( $^O eq 'darwin' ) {
# Modern Max OS X and Darwin OSS releases for 32bit and 64bit
requires 'Mac::SystemDirectory' => '0.04';
} elsif ( $^O eq 'MSWin32' ) {
- requires 'Win32' => '0.31';
+ requires 'Win32' => '0.31';
}
WriteAll;
+
+sub _check_old_mac_os_x {
+ local $@;
+ $Config{ptrsize} == 8 and return;
+ return eval {
+ require POSIX;
+ my $release = ( POSIX::uname() )[2];
+ my ( $major ) = split qr{ [.] }smx, $release;
+ # 'old' means before darwin 8 = Mac OS 10.4 = Tiger
+ $major < 8;
+ };
+}
Modified: branches/upstream/libfile-homedir-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-homedir-perl/current/README?rev=70340&op=diff
==============================================================================
--- branches/upstream/libfile-homedir-perl/current/README (original)
+++ branches/upstream/libfile-homedir-perl/current/README Fri Mar 4 11:52:22 2011
@@ -54,17 +54,18 @@
back-compatibility reasons they will remain supported until at least
2010.
- The "%~" interface has been deprecated and is no longer documented. Any
- usage will issue warnings from 2013 and be removed in 2015 (in line with
- the general Perl convention of a 10 year support period for legacy APIs
- potentially or actually in common use).
+ The "%~" interface has been deprecated. Documentation was removed in
+ 2009, Unit test were removed in 2011, usage will issue warnings from
+ 2013, and the interface will be removed entirely in 2015 (in line with
+ the general Perl toolchain convention of a 10 year support period for
+ legacy APIs that are potentially or actually in common use).
Platform Neutrality
In the Unix world, many different types of data can be mixed together in
your home directory (although on some Unix platforms this is no longer
the case, particularly for "desktop"-oriented platforms).
- On some non-Unix platforms, seperate directories are allocated for
+ On some non-Unix platforms, separate directories are allocated for
different types of data and have been for a long time.
When writing applications on top of File::HomeDir, you should thus
@@ -82,7 +83,7 @@
finding resources for the current user, and the "users_method" (read as
"user's method") series for finding resources for arbitrary users.
- This split is necesary, as on most platforms it is much easier to find
+ This split is necessary, as on most platforms it is much easier to find
information about the current user compared to other users, and indeed
on a number you cannot find out information such as "users_desktop" at
all, due to security restrictions.
@@ -120,8 +121,8 @@
directory for the current user.
Due to the diversity and complexity of implementions required to deal
- with implementing the required functionality fully and completely, for
- the moment "my_desktop" is not going to be implemented.
+ with implementing the required functionality fully and completely, the
+ "my_desktop" method may or may not be implemented on each platform.
That said, I am extremely interested in code to implement "my_desktop"
on Unix, as long as it is capable of dealing (as the Windows
@@ -348,7 +349,7 @@
File::ShareDir, File::HomeDir::Win32 (legacy)
COPYRIGHT
- Copyright 2005 - 2010 Adam Kennedy.
+ Copyright 2005 - 2011 Adam Kennedy.
Some parts copyright 2000 Sean M. Burke.
@@ -356,7 +357,7 @@
Some parts copyright 2006 Stephen Steneker.
- Some parts copyright 2009-2010 Jérôme Quelin.
+ Some parts copyright 2009-2011 Jérôme Quelin.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
Modified: branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir.pm?rev=70340&op=diff
==============================================================================
--- branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir.pm (original)
+++ branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir.pm Fri Mar 4 11:52:22 2011
@@ -12,7 +12,7 @@
# Globals
use vars qw{$VERSION @ISA @EXPORT @EXPORT_OK $IMPLEMENTED_BY};
BEGIN {
- $VERSION = '0.93';
+ $VERSION = '0.97';
# Inherit manually
require Exporter;
@@ -382,10 +382,11 @@
It is generally not recommended that you use this interface, but due to
back-compatibility reasons they will remain supported until at least 2010.
-The C<%~> interface has been deprecated and is no longer documented. Any
-usage will issue warnings from 2013 and be removed in 2015 (in line with
-the general Perl convention of a 10 year support period for legacy APIs
-potentially or actually in common use).
+The C<%~> interface has been deprecated. Documentation was removed in 2009,
+Unit test were removed in 2011, usage will issue warnings from 2013, and the
+interface will be removed entirely in 2015 (in line with the general Perl
+toolchain convention of a 10 year support period for legacy APIs that
+are potentially or actually in common use).
=head2 Platform Neutrality
@@ -393,7 +394,7 @@
in your home directory (although on some Unix platforms this is no longer
the case, particularly for "desktop"-oriented platforms).
-On some non-Unix platforms, seperate directories are allocated for
+On some non-Unix platforms, separate directories are allocated for
different types of data and have been for a long time.
When writing applications on top of B<File::HomeDir>, you should thus
@@ -412,7 +413,7 @@
finding resources for the current user, and the C<users_method> (read as
"user's method") series for finding resources for arbitrary users.
-This split is necesary, as on most platforms it is B<much> easier to find
+This split is necessary, as on most platforms it is B<much> easier to find
information about the current user compared to other users, and indeed
on a number you cannot find out information such as C<users_desktop> at
all, due to security restrictions.
@@ -451,8 +452,8 @@
directory for the current user.
Due to the diversity and complexity of implementions required to deal with
-implementing the required functionality fully and completely, for the moment
-C<my_desktop> is B<not> going to be implemented.
+implementing the required functionality fully and completely, the
+C<my_desktop> method may or may not be implemented on each platform.
That said, I am extremely interested in code to implement C<my_desktop> on
Unix, as long as it is capable of dealing (as the Windows implementation
@@ -708,7 +709,7 @@
=head1 COPYRIGHT
-Copyright 2005 - 2010 Adam Kennedy.
+Copyright 2005 - 2011 Adam Kennedy.
Some parts copyright 2000 Sean M. Burke.
@@ -716,7 +717,7 @@
Some parts copyright 2006 Stephen Steneker.
-Some parts copyright 2009-2010 Jérôme Quelin.
+Some parts copyright 2009-2011 Jérôme Quelin.
This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.
Modified: branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Darwin.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Darwin.pm?rev=70340&op=diff
==============================================================================
--- branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Darwin.pm (original)
+++ branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Darwin.pm Fri Mar 4 11:52:22 2011
@@ -8,7 +8,7 @@
use vars qw{$VERSION @ISA};
BEGIN {
- $VERSION = '0.93';
+ $VERSION = '0.97';
@ISA = 'File::HomeDir::Unix';
}
@@ -40,9 +40,9 @@
my $folder = "$home/$path";
unless ( -d $folder ) {
# Make sure that symlinks resolve to directories.
- return unless -l $folder;
+ return undef unless -l $folder;
my $dir = readlink $folder or return;
- return unless -d $dir;
+ return undef unless -d $dir;
}
return Cwd::abs_path($folder);
Modified: branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Darwin/Carbon.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Darwin/Carbon.pm?rev=70340&op=diff
==============================================================================
--- branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Darwin/Carbon.pm (original)
+++ branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Darwin/Carbon.pm Fri Mar 4 11:52:22 2011
@@ -11,7 +11,7 @@
use vars qw{$VERSION @ISA};
BEGIN {
- $VERSION = '0.93';
+ $VERSION = '0.97';
# This is only a child class of the pure Perl darwin
# class so that we can do homedir detection of all three
@@ -110,13 +110,13 @@
Mac::Files::kUserDomain(),
$name,
);
- return unless defined $folder;
+ return undef unless defined $folder;
unless ( -d $folder ) {
# Make sure that symlinks resolve to directories.
- return unless -l $folder;
+ return undef unless -l $folder;
my $dir = readlink $folder or return;
- return unless -d $dir;
+ return undef unless -d $dir;
}
return Cwd::abs_path($folder);
Modified: branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Darwin/Cocoa.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Darwin/Cocoa.pm?rev=70340&op=diff
==============================================================================
--- branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Darwin/Cocoa.pm (original)
+++ branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Darwin/Cocoa.pm Fri Mar 4 11:52:22 2011
@@ -8,7 +8,7 @@
use vars qw{$VERSION @ISA};
BEGIN {
- $VERSION = '0.93';
+ $VERSION = '0.97';
@ISA = 'File::HomeDir::Darwin';
# Load early if in a forking environment and we have
@@ -116,13 +116,13 @@
require Mac::SystemDirectory;
my $folder = Mac::SystemDirectory::FindDirectory($name);
- return unless defined $folder;
+ return undef unless defined $folder;
unless ( -d $folder ) {
# Make sure that symlinks resolve to directories.
- return unless -l $folder;
+ return undef unless -l $folder;
my $dir = readlink $folder or return;
- return unless -d $dir;
+ return undef unless -d $dir;
}
return Cwd::abs_path($folder);
Modified: branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Driver.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Driver.pm?rev=70340&op=diff
==============================================================================
--- branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Driver.pm (original)
+++ branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Driver.pm Fri Mar 4 11:52:22 2011
@@ -9,7 +9,7 @@
use vars qw{$VERSION};
BEGIN {
- $VERSION = '0.93';
+ $VERSION = '0.97';
}
sub my_home {
@@ -43,7 +43,7 @@
=head1 COPYRIGHT
-Copyright 2009 - 2010 Adam Kennedy.
+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.
Modified: branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/FreeDesktop.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/FreeDesktop.pm?rev=70340&op=diff
==============================================================================
--- branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/FreeDesktop.pm (original)
+++ branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/FreeDesktop.pm Fri Mar 4 11:52:22 2011
@@ -14,7 +14,7 @@
use vars qw{$VERSION @ISA};
BEGIN {
- $VERSION = '0.93';
+ $VERSION = '0.97';
@ISA = 'File::HomeDir::Unix';
}
@@ -123,7 +123,7 @@
=head1 COPYRIGHT
-Copyright 2009 - 2010 Jerome Quelin.
+Copyright 2009 - 2011 Jerome Quelin.
Some parts copyright 2010 Adam Kennedy.
Modified: branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/MacOS9.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/MacOS9.pm?rev=70340&op=diff
==============================================================================
--- branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/MacOS9.pm (original)
+++ branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/MacOS9.pm Fri Mar 4 11:52:22 2011
@@ -11,7 +11,7 @@
use vars qw{$VERSION @ISA};
BEGIN {
- $VERSION = '0.93';
+ $VERSION = '0.97';
@ISA = 'File::HomeDir::Driver';
}
@@ -137,7 +137,7 @@
=head1 COPYRIGHT
-Copyright 2005 - 2010 Adam Kennedy.
+Copyright 2005 - 2011 Adam Kennedy.
Some parts copyright 2000 Sean M. Burke.
Modified: branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Test.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Test.pm?rev=70340&op=diff
==============================================================================
--- branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Test.pm (original)
+++ branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Test.pm Fri Mar 4 11:52:22 2011
@@ -9,7 +9,7 @@
use vars qw{$VERSION @ISA %DIR $ENABLED};
BEGIN {
- $VERSION = '0.93';
+ $VERSION = '0.97';
@ISA = 'File::HomeDir::Driver';
%DIR = ();
$ENABLED = 0;
@@ -126,7 +126,7 @@
=head1 COPYRIGHT
-Copyright 2005 - 2010 Adam Kennedy.
+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.
Modified: branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Unix.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Unix.pm?rev=70340&op=diff
==============================================================================
--- branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Unix.pm (original)
+++ branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Unix.pm Fri Mar 4 11:52:22 2011
@@ -9,7 +9,7 @@
use vars qw{$VERSION @ISA};
BEGIN {
- $VERSION = '0.93';
+ $VERSION = '0.97';
@ISA = 'File::HomeDir::Driver';
}
@@ -173,7 +173,7 @@
=head1 COPYRIGHT
-Copyright 2005 - 2010 Adam Kennedy.
+Copyright 2005 - 2011 Adam Kennedy.
Some parts copyright 2000 Sean M. Burke.
Modified: branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Windows.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Windows.pm?rev=70340&op=diff
==============================================================================
--- branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Windows.pm (original)
+++ branches/upstream/libfile-homedir-perl/current/lib/File/HomeDir/Windows.pm Fri Mar 4 11:52:22 2011
@@ -10,7 +10,7 @@
use vars qw{$VERSION @ISA};
BEGIN {
- $VERSION = '0.93';
+ $VERSION = '0.97';
@ISA = 'File::HomeDir::Driver';
}
@@ -190,7 +190,7 @@
=head1 COPYRIGHT
-Copyright 2005 - 2010 Adam Kennedy.
+Copyright 2005 - 2011 Adam Kennedy.
Some parts copyright 2000 Sean M. Burke.
Modified: branches/upstream/libfile-homedir-perl/current/t/02_main.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-homedir-perl/current/t/02_main.t?rev=70340&op=diff
==============================================================================
--- branches/upstream/libfile-homedir-perl/current/t/02_main.t (original)
+++ branches/upstream/libfile-homedir-perl/current/t/02_main.t Fri Mar 4 11:52:22 2011
@@ -35,21 +35,23 @@
# Environment Detection and Plan
# For what scenarios can we be sure that we have desktop/documents
-my $NO_GETPWUID = 0;
-my $HAVEHOME = 0;
-my $HAVEDESKTOP = 0;
-my $HAVEMUSIC = 0;
-my $HAVEVIDEOS = 0;
-my $HAVEOTHERS = 0;
+my $NO_GETPWUID = 0;
+my $HAVEHOME = 0;
+my $HAVEDESKTOP = 0;
+my $HAVEMUSIC = 0;
+my $HAVEPICTURES = 0;
+my $HAVEVIDEOS = 0;
+my $HAVEOTHERS = 0;
# Various cases of things we should try to test for
# Top level is entire classes of operating system.
# Below that are more general things.
if ( $^O eq 'MSWin32' ) {
- $NO_GETPWUID = 1;
- $HAVEHOME = 1;
- $HAVEDESKTOP = 1;
- $HAVEOTHERS = 1;
+ $NO_GETPWUID = 1;
+ $HAVEHOME = 1;
+ $HAVEDESKTOP = 1;
+ $HAVEPICTURES = 1;
+ $HAVEOTHERS = 1;
# My Music does not exist on Win2000
require Win32;
@@ -69,50 +71,64 @@
# Nobody users on all unix systems generally don't have home directories
} elsif ( getpwuid($<) eq 'nobody' ) {
- $HAVEHOME = 0;
- $HAVEDESKTOP = 0;
- $HAVEMUSIC = 0;
- $HAVEVIDEOS = 0;
- $HAVEOTHERS = 0;
+ $HAVEHOME = 0;
+ $HAVEDESKTOP = 0;
+ $HAVEMUSIC = 0;
+ $HAVEPICTURES = 0;
+ $HAVEVIDEOS = 0;
+ $HAVEOTHERS = 0;
} elsif (
$^O eq 'darwin'
) {
# "Unixes with proper desktops" special cases
- if ( $< ) {
+ if ( $ENV{AUTOMATED_TESTING} ) {
+ # Automated testers on Mac (notably BINGOS) will often have
+ # super stripped down testing users.
+ $HAVEHOME = 1;
+ $HAVEDESKTOP = 1;
+ $HAVEMUSIC = 0;
+ $HAVEPICTURES = 0;
+ $HAVEVIDEOS = 0;
+ $HAVEOTHERS = 1;
+ } elsif ( $< ) {
# Normal user
- $HAVEHOME = 1;
- $HAVEDESKTOP = 1;
- $HAVEMUSIC = 1;
- $HAVEVIDEOS = 1;
- $HAVEOTHERS = 1;
+ $HAVEHOME = 1;
+ $HAVEDESKTOP = 1;
+ $HAVEMUSIC = 1;
+ $HAVEPICTURES = 1;
+ $HAVEVIDEOS = 1;
+ $HAVEOTHERS = 1;
} else {
# Root can only be relied on to have a home
- $HAVEHOME = 1;
- $HAVEDESKTOP = 0;
- $HAVEMUSIC = 0;
- $HAVEVIDEOS = 0;
- $HAVEOTHERS = 0;
+ $HAVEHOME = 1;
+ $HAVEDESKTOP = 0;
+ $HAVEMUSIC = 0;
+ $HAVEPICTURES = 0;
+ $HAVEVIDEOS = 0;
+ $HAVEOTHERS = 0;
}
} elsif ( $File::HomeDir::IMPLEMENTED_BY eq 'File::HomeDir::FreeDesktop' ) {
# On FreeDesktop we can't trust people to have a desktop (annoyingly)
- $HAVEHOME = 1;
- $HAVEDESKTOP = 0;
- $HAVEMUSIC = 1;
- $HAVEVIDEOS = 1;
- $HAVEOTHERS = 0;
+ $HAVEHOME = 1;
+ $HAVEDESKTOP = 0;
+ $HAVEMUSIC = 1;
+ $HAVEVIDEOS = 1;
+ $HAVEPICTURES = 0;
+ $HAVEOTHERS = 0;
} else {
# Default to traditional Unix
- $HAVEHOME = 1;
- $HAVEDESKTOP = 1;
- $HAVEMUSIC = 1;
- $HAVEVIDEOS = 1;
- $HAVEOTHERS = 1;
-}
-
-plan tests => 51;
+ $HAVEHOME = 1;
+ $HAVEDESKTOP = 1;
+ $HAVEMUSIC = 1;
+ $HAVEPICTURES = 1;
+ $HAVEVIDEOS = 1;
+ $HAVEOTHERS = 1;
+}
+
+plan tests => 39;
@@ -126,69 +142,6 @@
};
like( $@, qr{Can\'t use undef as a username}, 'home(undef)' );
-# Warning is not reliably thrown on older Perls,
-# as well as on some old 5.9 series releases (5.9.0)
-SKIP: {
- skip("Skipping unreliable warning test", 2) if $] < 5.008007;
- skip("Skipping unreliable warning test", 2) if $] == 5.009;
- my @warned = ();
- eval {
- local $SIG{__WARN__} = sub {
- push @warned, $_[0];
- };
- my $h = $~{undef()};
- };
- is( scalar(@warned), 1, 'Emitted a single warning' );
- unless ( scalar(@warned) ) {
- foreach ( @warned ) {
- diag( $_ );
- }
- }
- like( $@, qr{Can't use undef as a username}, '%~(undef())' );
-}
-
-# Check error messages for unavailable tie constructs
-SKIP: {
- skip("getpwuid not available", 3) if $NO_GETPWUID;
-
- eval {
- $~{getpwuid($<)} = "new_dir";
- };
- like( $@, qr{You can't STORE with the %~ hash}, 'Cannot store in %~ hash' );
-
- eval {
- exists $~{getpwuid($<)};
- };
- like( $@, qr{You can't EXISTS with the %~ hash}, 'Cannot store in %~ hash' );
-
- eval {
- delete $~{getpwuid($<)};
- };
- like( $@, qr{You can't DELETE with the %~ hash}, 'Cannot store in %~ hash' );
-}
-
-eval {
- %~ = ();
-};
-like( $@, qr{You can't CLEAR with the %~ hash}, 'Cannot store in %~ hash' );
-
-eval {
- my ($k, $v) = each(%~);
-};
-like( $@, qr{You can't FIRSTKEY with the %~ hash}, 'Cannot store in %~ hash' );
-
-# right now if you call keys in void context
-# keys(%~);
-# it does not throw an exception while if you call it in list context it
-# throws an exception.
-my @usernames;
-eval {
- @usernames = keys(%~);
-};
-like( $@, qr{You can't FIRSTKEY with the %~ hash}, 'Cannot store in %~ hash' );
-
-# How to test NEXTKEY error if FIRSTKEY already throws an exception?
-
@@ -232,12 +185,6 @@
{
local $ENV{HOME} = rel2abs('.');
is( File::HomeDir->my_home(), $ENV{HOME}, "my_home() returns $ENV{HOME}" );
-}
-
-is( $~{""}, $home, 'Legacy %~ tied interface' );
-SKIP: {
- skip("getpwuid not available", 1) if $NO_GETPWUID;
- is( $~{getpwuid($<)}, $home, 'Legacy %~ tied interface' );
}
my $my_home2 = File::HomeDir::my_home();
@@ -272,7 +219,7 @@
# Find this user's pictures directory
SKIP: {
- skip("Cannot assume existance of pictures", 3) unless $HAVEOTHERS;
+ skip("Cannot assume existance of pictures", 3) unless $HAVEPICTURES;
my $my_pictures = File::HomeDir->my_pictures;
my $my_pictures2 = File::HomeDir::my_pictures();
is( $my_pictures, $my_pictures2, 'Different APIs give the same results' );
@@ -318,23 +265,16 @@
# On platforms other than windows, find root's homedir
SKIP: {
if ( $^O eq 'MSWin32' or $^O eq 'darwin') {
- skip("Skipping root test on $^O", 3 );
+ skip("Skipping root test on $^O", 1 );
}
# Determine root
my $root = getpwuid(0);
unless ( $root ) {
- skip("Skipping, can't determine root", 3 );
+ skip("Skipping, can't determine root", 1 );
}
# Get root's homedir
my $root_home1 = home($root);
ok( !!($root_home1 and is_dir $root_home1), "Found root's home directory" );
-
- # Confirm against %~ hash
- my $root_home2 = $~{$root};
- ok( !!($root_home2 and is_dir $root_home2), "Found root's home directory" );
-
- # Root account via different methods match
- is( $root_home1, $root_home2, 'Home dirs match' );
-}
+}
Modified: branches/upstream/libfile-homedir-perl/current/t/11_darwin.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-homedir-perl/current/t/11_darwin.t?rev=70340&op=diff
==============================================================================
--- branches/upstream/libfile-homedir-perl/current/t/11_darwin.t (original)
+++ branches/upstream/libfile-homedir-perl/current/t/11_darwin.t Fri Mar 4 11:52:22 2011
@@ -2,7 +2,7 @@
use strict;
BEGIN {
- $| = 1;
+ $| = 1;
$^W = 1;
}
@@ -12,7 +12,7 @@
if ( $File::HomeDir::IMPLEMENTED_BY->isa('File::HomeDir::Darwin') ) {
# Force pure perl since it should work everywhere
$File::HomeDir::IMPLEMENTED_BY = 'File::HomeDir::Darwin';
- plan( tests => 6 );
+ plan( tests => 9 );
} else {
plan( skip_all => "Not running on Darwin" );
exit(0);
@@ -20,7 +20,7 @@
SKIP: {
my $user;
- foreach (0 .. 9) {
+ foreach ( 0 .. 9 ) {
my $temp = sprintf 'fubar%04d', rand(10000);
getpwnam $temp and next;
$user = $temp;
@@ -34,43 +34,53 @@
}
SCOPE: {
- # reality check:
- like( File::HomeDir->my_music, qr/Music/ );
- like( File::HomeDir->my_videos, qr/Movies/ );
- like( File::HomeDir->my_pictures, qr/Pictures/ );
- like( File::HomeDir->my_data, qr/Application Support/ );
+ # Reality Check
+ my $music = File::HomeDir->my_music;
+ my $videos = File::HomeDir->my_videos;
+ my $pictures = File::HomeDir->my_pictures;
+ my $data = File::HomeDir->my_data;
+ SKIP: {
+ skip( "No music directory", 1 ) unless defined $music;
+ like( $music, qr/Music/ );
+ }
+ SKIP: {
+ skip( "Have music directory", 1 ) if defined $music;
+ is_deeply(
+ [ File::HomeDir->my_music ], [ undef ],
+ "Returns undef in list context",
+ )
+ }
+ SKIP: {
+ skip( "No videos directory", 1 ) unless defined $videos;
+ like( $videos, qr/Movies/ );
+ }
+ SKIP: {
+ skip( "Have videos directory", 1 ) if defined $videos;
+ is_deeply(
+ [ File::HomeDir->my_videos ], [ undef ],
+ "Returns undef in list context",
+ )
+ }
+ SKIP: {
+ skip( "No pictures directory", 1 ) unless defined $pictures;
+ like( $pictures, qr/Pictures/ );
+ }
+ SKIP: {
+ skip( "Have pictures directory", 1 ) if defined $pictures;
+ is_deeply(
+ [ File::HomeDir->my_pictures ], [ undef ],
+ "Returns undef in list context",
+ )
+ }
+ SKIP: {
+ skip( "No application support directory", 1 ) unless defined $data;
+ like( $data, qr/Application Support/ );
+ }
+ SKIP: {
+ skip( "Have data directory", 1 ) if defined $data;
+ is_deeply(
+ [ File::HomeDir->my_data ], [ undef ],
+ "Returns undef in list context",
+ )
+ }
}
-
-SKIP: {
- my $user;
- foreach my $uid (501 .. 540) {
- $uid == $< and next;
- $user = getpwuid $uid or next;
- last;
- }
- $user or skip("Unable to find another user", 1);
- my $me = getpwuid $<;
- my $my_home = eval { File::HomeDir->my_home() };
- unless ( defined $my_home ) {
- skip( "File::HomeDir->my_home() undefined", 1 );
- }
- my $users_home = eval { File::HomeDir->users_home($user) };
- unless ( defined $users_home ) {
- skip( "File::HomeDir->users_home('$user') undefined", 1 );
- }
- if ( $my_home eq $users_home ) {
- skip( "Users '$me' and '$user' have same home", 1 );
- }
- my $my_data = eval { File::HomeDir->my_data() };
- unless ( defined $my_data ) {
- skip( "File::HomeDir->my_data() undefined", 1 );
- }
- my $users_data = eval { File::HomeDir->users_data($user) };
- unless ( defined $users_data ) {
- skip( "File::HomeDir->users_data('$user') undefined", 1 );
- }
- ok (
- $my_data ne $users_data,
- "Users '$me' and '$user' should have different data",
- );
-}
Modified: branches/upstream/libfile-homedir-perl/current/t/12_darwin_carbon.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-homedir-perl/current/t/12_darwin_carbon.t?rev=70340&op=diff
==============================================================================
--- branches/upstream/libfile-homedir-perl/current/t/12_darwin_carbon.t (original)
+++ branches/upstream/libfile-homedir-perl/current/t/12_darwin_carbon.t Fri Mar 4 11:52:22 2011
@@ -10,7 +10,7 @@
use File::HomeDir;
if ( $File::HomeDir::IMPLEMENTED_BY->isa('File::HomeDir::Darwin::Carbon') ) {
- plan( tests => 6 );
+ plan( tests => 5 );
} else {
plan( skip_all => "Not running on 32-bit Darwin" );
exit(0);
@@ -55,42 +55,8 @@
like( $dir, qr/Pictures/ );
}
-# For now, lets continue to assume everyone has this one
-like(
- File::HomeDir->my_data,
- qr/Application Support/,
-);
-
SKIP: {
- my $user;
- foreach my $uid ( 501 .. 540 ) {
- $uid == $< and next;
- $user = getpwuid $uid or next;
- last;
- }
- $user or skip("Unable to find another user", 1);
- my $me = getpwuid $<;
- my $my_home = eval { File::HomeDir->my_home() };
- unless ( defined $my_home ) {
- skip( "File::HomeDir->my_home() undefined", 1 );
- }
- my $users_home = eval { File::HomeDir->users_home($user) };
- unless ( defined $users_home ) {
- skip( "File::HomeDir->users_home('$user') undefined", 1 );
- }
- if ( $my_home eq $users_home ) {
- skip( "Users '$me' and '$user' have same home", 1 );
- }
- my $my_data = eval { File::HomeDir->my_data() };
- unless ( defined $my_data ) {
- skip( "File::HomeDir->my_data() undefined", 1 );
- }
- my $users_data = eval { File::HomeDir->users_data($user) };
- unless ( defined $users_data ) {
- skip( "File::HomeDir->users_data('$user') undefined", 1 );
- }
- ok (
- $my_data ne $users_data,
- "Users '$me' and '$user' should have different data",
- );
+ my $data = File::HomeDir->my_data;
+ skip( "No application support directory", 1 ) unless defined $data;
+ like( $data, qr/Application Support/ );
}
Modified: branches/upstream/libfile-homedir-perl/current/t/13_darwin_cocoa.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-homedir-perl/current/t/13_darwin_cocoa.t?rev=70340&op=diff
==============================================================================
--- branches/upstream/libfile-homedir-perl/current/t/13_darwin_cocoa.t (original)
+++ branches/upstream/libfile-homedir-perl/current/t/13_darwin_cocoa.t Fri Mar 4 11:52:22 2011
@@ -17,7 +17,7 @@
# Force Cocoa if you have Mac::SystemDirectory
require File::HomeDir::Darwin::Cocoa;
$File::HomeDir::IMPLEMENTED_BY = 'File::HomeDir::Darwin::Cocoa';
- plan( tests => 6 );
+ plan( tests => 5 );
} else {
plan( skip_all => "Not running on Darwin with Cocoa API using Mac::SystemDirectory" );
exit(0);
@@ -25,7 +25,7 @@
SKIP: {
my $user;
- foreach (0 .. 9) {
+ foreach ( 0 .. 9 ) {
my $temp = sprintf 'fubar%04d', rand(10000);
getpwnam $temp and next;
$user = $temp;
@@ -33,49 +33,32 @@
}
$user or skip("Unable to find non-existent user", 1);
$@ = undef;
- my $home = eval {File::HomeDir->users_home($user)};
+ my $home = eval { File::HomeDir->users_home($user) };
$@ and skip("Unable to execute File::HomeDir->users_home('$user')", 1);
ok (!defined $home, "Home of non-existent user should be undef");
}
SCOPE: {
- # reality check:
- like( File::HomeDir->my_music, qr/Music/ );
- like( File::HomeDir->my_videos, qr/Movies/ );
- like( File::HomeDir->my_pictures, qr/Pictures/ );
- like( File::HomeDir->my_data, qr/Application Support/ );
+ # Reality Check
+ my $music = File::HomeDir->my_music;
+ my $video = File::HomeDir->my_videos;
+ my $pictures = File::HomeDir->my_pictures;
+ SKIP: {
+ skip( "No music directory", 1 ) unless defined $music;
+ like( File::HomeDir->my_music, qr/Music/ );
+ }
+ SKIP: {
+ skip( "No videos directory", 1 ) unless defined $video;
+ like( File::HomeDir->my_videos, qr/Movies/ );
+ }
+ SKIP: {
+ skip( "No pictures directory", 1 ) unless defined $pictures;
+ like( File::HomeDir->my_pictures, qr/Pictures/ );
+ }
+
+ SKIP: {
+ my $data = File::HomeDir->my_data;
+ skip( "No application support directory", 1 ) unless defined $data;
+ like( $data, qr/Application Support/ );
+ }
}
-
-SKIP: {
- my $user;
- foreach my $uid ( 501 .. 540 ) {
- $uid == $< and next;
- $user = getpwuid $uid or next;
- last;
- }
- $user or skip("Unable to find another user", 1);
- my $me = getpwuid $<;
- my $my_home = eval { File::HomeDir->my_home() };
- unless ( defined $my_home ) {
- skip( "File::HomeDir->my_home() undefined", 1 );
- }
- my $users_home = eval { File::HomeDir->users_home($user) };
- unless ( defined $users_home ) {
- skip( "File::HomeDir->users_home('$user') undefined", 1 );
- }
- if ( $my_home eq $users_home ) {
- skip( "Users '$me' and '$user' have same home", 1 );
- }
- my $my_data = eval { File::HomeDir->my_data() };
- unless ( defined $my_data ) {
- skip( "File::HomeDir->my_data() undefined", 1 );
- }
- my $users_data = eval { File::HomeDir->users_data($user) };
- unless ( defined $users_data ) {
- skip( "File::HomeDir->users_data('$user') undefined", 1 );
- }
- ok (
- $my_data ne $users_data,
- "Users '$me' and '$user' should have different data",
- );
-}
More information about the Pkg-perl-cvs-commits
mailing list