[libsys-filesystem-perl] 01/04: Imported Upstream version 1.406
gregor herrmann
gregoa at debian.org
Wed May 14 21:25:54 UTC 2014
This is an automated email from the git hooks/post-receive script.
gregoa pushed a commit to branch master
in repository libsys-filesystem-perl.
commit 8584ef60d2ab09540723acc03cd0d4dbf9303bfa
Author: gregor herrmann <gregoa at debian.org>
Date: Wed May 14 23:18:32 2014 +0200
Imported Upstream version 1.406
---
CREDITS | 2 +-
Changes | 9 ++-
MANIFEST | 6 +-
MANIFEST.SKIP | 1 +
META.json | 26 +++++---
META.yml | 46 +++++++-------
Makefile.PL | 136 ++++++++++++++++++++++--------------------
README | 42 +++++++++----
lib/Sys/Filesystem.pm | 116 +++++++++++++++++++++--------------
lib/Sys/Filesystem/Aix.pm | 38 ++++++------
lib/Sys/Filesystem/Cygwin.pm | 19 +++---
lib/Sys/Filesystem/Darwin.pm | 18 +++---
lib/Sys/Filesystem/Dummy.pm | 4 +-
lib/Sys/Filesystem/Freebsd.pm | 19 +++---
lib/Sys/Filesystem/Hpux.pm | 13 ++--
lib/Sys/Filesystem/Linux.pm | 61 +++++++++----------
lib/Sys/Filesystem/Mswin32.pm | 21 ++-----
lib/Sys/Filesystem/Netbsd.pm | 26 ++++----
lib/Sys/Filesystem/Solaris.pm | 35 ++++++-----
lib/Sys/Filesystem/Unix.pm | 22 ++++---
t/01_load.t | 9 ++-
t/02_basic.t | 28 +++++----
t/03_whereami.t | 13 ++--
t/04_special.t | 11 +++-
t/05_error.t | 23 +++++++
t/06_settings.t | 64 ++++++++++++++++++++
26 files changed, 501 insertions(+), 307 deletions(-)
diff --git a/CREDITS b/CREDITS
index 9c9b43e..0c3a82b 100644
--- a/CREDITS
+++ b/CREDITS
@@ -6,5 +6,5 @@ Ying-Chieh Liao <ijliao at csie.nctu.edu.tw>
Dintelmann, Peter <Peter.Dintelmann at Dresdner-Bank.com>
Artur Penttinen <arto-p at yandex.ru>
Dirk Langer <dirk.langer at vvovgonik.de>
-Jens Rehsack <rehsack at web.de>
+Jens Rehsack <rehsack at cpan.org>
H.Merijn Brand <h.m.brand at xs4all.nl>
diff --git a/Changes b/Changes
index 003380d..3d6a909 100644
--- a/Changes
+++ b/Changes
@@ -1,8 +1,15 @@
Revision history for CPAN distribution Sys-Filesystem
+1.406 2014-05-13
+ - always use global kernel mount table (/proc/mounts), not the process
+ mirror
+ - add support for getting canonical device path
+ - add support for package wide settings to tune Sys::Filesystem even
+ when used indirectly
+
1.405 2013-10-28
- Fix Mswin32 mounted/unmounted support (thanks to Christian "Mithaldu"
- Walde for remote testing support
+ Walde for remote testing support)
- skip format test in case of unmounted device (unmounted devices might
or might not know in before the fstype)
- clean up basic tests and BAIL_OUT when unsupported environment
diff --git a/MANIFEST b/MANIFEST
index 7e0ea8d..f0ecfdd 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -17,12 +17,14 @@ LICENSE
Makefile.PL
MANIFEST
MANIFEST.SKIP
-META.json
-META.yml
NOTICE
README
t/01_load.t
t/02_basic.t
t/03_whereami.t
t/04_special.t
+t/05_error.t
+t/06_settings.t
TODO
+META.yml Module YAML meta-data (added by MakeMaker)
+META.json Module JSON meta-data (added by MakeMaker)
diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP
index 46e2f99..b6d55d8 100644
--- a/MANIFEST.SKIP
+++ b/MANIFEST.SKIP
@@ -27,3 +27,4 @@ _Inline/.*
Sys-Filesystem-.*
^MYMETA\..*$
\bxt
+\.travis.yml
diff --git a/META.json b/META.json
index 5ad3c7c..7e2327a 100644
--- a/META.json
+++ b/META.json
@@ -5,7 +5,7 @@
"Jens Rehsack <rehsack at cpan.org>"
],
"dynamic_config" : 1,
- "generated_by" : "ExtUtils::MakeMaker version 6.8, CPAN::Meta::Converter version 2.132830",
+ "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.141170",
"license" : [
"apache_2_0"
],
@@ -27,13 +27,14 @@
"configure" : {
"requires" : {
"Carp" : "0",
+ "Cwd" : "0",
"ExtUtils::MakeMaker" : "0",
+ "File::Spec" : "0",
"FindBin" : "0",
"IO" : "0",
"IPC::Cmd" : "0.80",
"Module::Pluggable" : "4.8",
- "Params::Util" : "1.00",
- "perl" : "5.008001"
+ "Params::Util" : "1.00"
}
},
"develop" : {
@@ -51,12 +52,13 @@
},
"requires" : {
"Carp" : "0",
+ "Cwd" : "0",
+ "File::Spec" : "0",
"FindBin" : "0",
"IO" : "0",
"IPC::Cmd" : "0.80",
"Module::Pluggable" : "4.8",
- "Params::Util" : "1.00",
- "perl" : "5.008001"
+ "Params::Util" : "1.00"
}
},
"test" : {
@@ -67,9 +69,15 @@
},
"release_status" : "stable",
"resources" : {
- "license" : [
- "http://www.apache.org/licenses/LICENSE-2.0.html"
- ]
+ "bugtracker" : {
+ "mailto" : "fsys-filesystem at rt.cpan.org",
+ "web" : "http://rt.cpan.org/Public/Dist/Display.html?Name=Sys-Filesystem"
+ },
+ "homepage" : "https://metacpan.org/release/Sys-Filesystem",
+ "repository" : {
+ "type" : "git",
+ "web" : "https://github.com/rehsack/Sys-Filesystem"
+ }
},
- "version" : "1.405"
+ "version" : "1.406"
}
diff --git a/META.yml b/META.yml
index 9654c16..576a967 100644
--- a/META.yml
+++ b/META.yml
@@ -4,37 +4,41 @@ author:
- 'Nicola Worthington <nicolaw at cpan.org>'
- 'Jens Rehsack <rehsack at cpan.org>'
build_requires:
- Test::More: 0.9
+ Test::More: '0.9'
configure_requires:
- Carp: 0
- ExtUtils::MakeMaker: 0
- FindBin: 0
- IO: 0
- IPC::Cmd: 0.80
- Module::Pluggable: 4.8
- Params::Util: 1.00
- perl: 5.008001
+ Carp: '0'
+ Cwd: '0'
+ ExtUtils::MakeMaker: '0'
+ File::Spec: '0'
+ FindBin: '0'
+ IO: '0'
+ IPC::Cmd: '0.80'
+ Module::Pluggable: '4.8'
+ Params::Util: '1.00'
dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 6.8, CPAN::Meta::Converter version 2.132830'
+generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.141170'
license: apache
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ version: '1.4'
name: Sys-Filesystem
no_index:
directory:
- t
- inc
recommends:
- perl: 5.018001
+ perl: '5.018001'
requires:
- Carp: 0
- FindBin: 0
- IO: 0
- IPC::Cmd: 0.80
- Module::Pluggable: 4.8
- Params::Util: 1.00
- perl: 5.008001
+ Carp: '0'
+ Cwd: '0'
+ File::Spec: '0'
+ FindBin: '0'
+ IO: '0'
+ IPC::Cmd: '0.80'
+ Module::Pluggable: '4.8'
+ Params::Util: '1.00'
resources:
- license: http://www.apache.org/licenses/LICENSE-2.0.html
-version: 1.405
+ bugtracker: http://rt.cpan.org/Public/Dist/Display.html?Name=Sys-Filesystem
+ homepage: https://metacpan.org/release/Sys-Filesystem
+ repository: https://github.com/rehsack/Sys-Filesystem
+version: '1.406'
diff --git a/Makefile.PL b/Makefile.PL
index 3638b13..bf158b7 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -6,7 +6,8 @@ use 5.008001;
use strict;
use vars qw($build);
use FindBin;
-use lib $FindBin::Bin . '/lib';
+use File::Spec;
+use lib File::Spec->catdir( $FindBin::Bin, 'lib' );
use ExtUtils::MakeMaker;
@@ -22,74 +23,81 @@ $^O eq 'MSWin32' or eval {
};
my %RUN_DEPS = (
- 'perl' => '5.008001',
- 'Carp' => 0,
- 'FindBin' => 0,
- 'IO' => 0,
- 'IPC::Cmd' => '0.80',
- 'Module::Pluggable' => '4.8',
- 'Params::Util' => '1.00',
- (
- $^O eq 'MSWin32'
- ? (
- 'Win32::DriveInfo' => 0,
- )
- : ()
- ),
- );
+ 'Carp' => 0,
+ 'Cwd' => 0,
+ 'File::Spec' => 0,
+ 'FindBin' => 0,
+ 'IO' => 0,
+ 'IPC::Cmd' => '0.80',
+ 'Module::Pluggable' => '4.8',
+ 'Params::Util' => '1.00',
+ (
+ $^O eq 'MSWin32'
+ ? (
+ 'Win32::DriveInfo' => 0,
+ )
+ : ()
+ ),
+);
my %CONFIGURE_DEPS = (
- 'ExtUtils::MakeMaker' => 0,
- %RUN_DEPS
- );
+ 'ExtUtils::MakeMaker' => 0,
+ %RUN_DEPS
+);
my %BUILD_DEPS = ();
my %TEST_DEPS = (
- 'Test::More' => 0.90,
- );
+ 'Test::More' => 0.90,
+);
WriteMakefile1(
- MIN_PERL_VERSION => '5.008001',
- META_ADD => {
- 'meta-spec' => { version => 2 },
- resources => {
- repository => "https://github.com/rehsack/Sys-Filesystem",
- license => 'http://www.apache.org/licenses/LICENSE-2.0.html',
- },
- prereqs => {
- develop => {
- requires => {
- 'Test::CPAN::Changes' => 0,
- 'Test::CheckManifest' => 0,
- 'Test::Pod' => 0,
- 'Test::Pod::Coverage' => 0,
- 'Test::Pod::Spelling::CommonMistakes' => 0,
- },
- },
- configure => {
- requires => {%CONFIGURE_DEPS},
- },
- build => { requires => {%BUILD_DEPS} },
- test => { requires => {%TEST_DEPS} },
- runtime => {
- recommends => {
- 'perl' => '5.018001',
- },
- requires => {
- %RUN_DEPS,
- },
- },
- },
- },
- NAME => 'Sys::Filesystem',
- VERSION_FROM => 'lib/Sys/Filesystem.pm',
- ABSTRACT_FROM => 'lib/Sys/Filesystem.pm',
- LICENSE => 'Apache',
- AUTHOR => [q{Nicola Worthington <nicolaw at cpan.org>}, q{Jens Rehsack <rehsack at cpan.org>}],
- PREREQ_PM => \%RUN_DEPS,
- BUILD_REQUIRES => \%BUILD_DEPS,
- TEST_REQUIRES => \%TEST_DEPS,
- test => { TESTS => 't/*.t xt/*.t' },
- );
+ MIN_PERL_VERSION => '5.008001',
+ META_ADD => {
+ 'meta-spec' => { version => 2 },
+ resources => {
+ homepage => 'https://metacpan.org/release/Sys-Filesystem',
+ repository => {
+ url => 'git at github.com:rehsack/Sys-Filesystem.git',
+ web => 'https://github.com/rehsack/Sys-Filesystem',
+ type => 'git',
+ },
+ bugtracker => {
+ web => 'http://rt.cpan.org/Public/Dist/Display.html?Name=Sys-Filesystem',
+ mailto => 'fsys-filesystem at rt.cpan.org',
+ },
+ },
+ prereqs => {
+ develop => {
+ requires => {
+ 'Test::CPAN::Changes' => 0,
+ 'Test::CheckManifest' => 0,
+ 'Test::Pod' => 0,
+ 'Test::Pod::Coverage' => 0,
+ 'Test::Pod::Spelling::CommonMistakes' => 0,
+ },
+ },
+ configure => {
+ requires => {%CONFIGURE_DEPS},
+ },
+ build => { requires => {%BUILD_DEPS} },
+ test => { requires => {%TEST_DEPS} },
+ runtime => {
+ recommends => {
+ 'perl' => '5.018001',
+ },
+ requires => { %RUN_DEPS, },
+ },
+ },
+ },
+ NAME => 'Sys::Filesystem',
+ VERSION_FROM => 'lib/Sys/Filesystem.pm',
+ ABSTRACT_FROM => 'lib/Sys/Filesystem.pm',
+ LICENSE => 'Apache',
+ AUTHOR => [ q{Nicola Worthington <nicolaw at cpan.org>}, q{Jens Rehsack <rehsack at cpan.org>} ],
+ PREREQ_PM => \%RUN_DEPS,
+ BUILD_REQUIRES => \%BUILD_DEPS,
+ TEST_REQUIRES => \%TEST_DEPS,
+ test => { TESTS => 't/*.t xt/*.t' },
+);
sub WriteMakefile1
{ # originally written by Alexandr Ciornii, version 0.21. Added by eumm-upgrade.
@@ -132,7 +140,7 @@ sub WriteMakefile1
my $ok = CheckConflicts(%params);
exit(0) if ( $params{PREREQ_FATAL} and not $ok );
my $cpan_smoker = grep { $_ =~ m/(?:CR_SMOKER|CPAN_REPORTER|AUTOMATED_TESTING)/ } keys %ENV;
- unless ( $cpan_smoker || $ENV{PERL_MM_USE_DEFAULT} || $ENV{SQL_STATEMENT_WARN_UPDATE} )
+ unless ( $cpan_smoker || $ENV{PERL_MM_USE_DEFAULT} )
{
sleep 4 unless ($ok);
}
diff --git a/README b/README
index a088aa6..a740cb7 100644
--- a/README
+++ b/README
@@ -41,27 +41,49 @@ INHERITANCE
ISA UNIVERSAL
METHODS
- new Creates a new Sys::Filesystem object. new() accepts 3 optional key
- pair values to help or force where mount information is gathered
- from. These values are not otherwise defaulted by the main
+ new Creates a new Sys::Filesystem object. "new" accepts following
+ optional key value pairs to help or force where mount information is
+ gathered from. These values are not otherwise defaulted by the main
Sys::Filesystem object, but left to the platform specific helper
modules to determine as an exercise of common sense.
+ canondev
+ Specify whether device path's shall be resolved when they're a
+ symbolic link.
+
+ $Sys::Filesystem::CANONDEV is used when no key "canondev" is
+ passed.
+
fstab
Specify the full path and filename of the filesystem table (or
- fstab for short).
+ fstab for short). Not all platforms have such a file and so this
+ option may be ignored on some systems.
+
+ $Sys::Filesystem::FSTAB is used when no key "fstab" is passed.
mtab
Specify the full path and filename of the mounted filesystem
table (or mtab for short). Not all platforms have such a file
and so this option may be ignored on some systems.
+ $Sys::Filesystem::MTAB is used when no key "mtab" is passed.
+
xtab
- Specify the full path and filename of the mounted NFS filesystem
- table (or xtab for short). This is usually only pertinant to
- Unix bases systems. Not all helper modules will query NFS mounts
- as a separate exercise, and therefore this option may be ignored
- on some systems.
+ DEPRECIATED Specify the full path and filename of the mounted
+ NFS filesystem table (or xtab for short). This is usually only
+ pertinant to Unix bases systems. Not all helper modules will
+ query NFS mounts as a separate exercise, and therefore this
+ option may be ignored on some systems.
+
+ None of the OS plugins use that tunable (anymore?), so it now a
+ warning is raised when it's used. The entire support will be
+ removed not before 2015. Once that happened, using "xtab" will
+ raise an exception.
+
+ aliases
+ Overrides internal aliasing table used to match queries against
+ OS plugin. This should be used only when dealing with closed
+ source platform helper module(s).
supported
Returns true if the operating system is supported by
@@ -284,7 +306,7 @@ ACKNOWLEDGEMENTS
COPYRIGHT
Copyright 2004,2005,2006 Nicola Worthington.
- Copyright 2008-2013 Jens Rehsack.
+ Copyright 2008-2014 Jens Rehsack.
This software is licensed under The Apache Software License, Version
2.0.
diff --git a/lib/Sys/Filesystem.pm b/lib/Sys/Filesystem.pm
index 2f72852..d0d7a38 100644
--- a/lib/Sys/Filesystem.pm
+++ b/lib/Sys/Filesystem.pm
@@ -30,31 +30,28 @@ my @query_order;
use strict;
use warnings;
-use vars qw($VERSION $AUTOLOAD);
+use vars qw($VERSION $AUTOLOAD $CANONDEV $FSTAB $MTAB);
use Carp qw(croak cluck confess);
use Module::Pluggable
require => 1,
- only => [
- @query_order = map { __PACKAGE__ . '::' . $_ } ucfirst( lc($^O) ),
- $^O =~ m/Win32/i ? 'Win32' : 'Unix', 'Dummy'
- ],
- inner => 0,
- search_path => ['Sys::Filesystem'];
+ only => [ @query_order = map { __PACKAGE__ . '::' . $_ } ( ucfirst( lc $^O ), $^O =~ m/Win32/i ? 'Win32' : 'Unix', 'Dummy' ) ],
+ inner => 0,
+ search_path => ['Sys::Filesystem'],
+ sub_name => '_plugins';
use Params::Util qw(_INSTANCE);
use Scalar::Util qw(blessed);
use List::Util qw(first);
use constant DEBUG => $ENV{SYS_FILESYSTEM_DEBUG} ? 1 : 0;
use constant SPECIAL => ( 'darwin' eq $^O ) ? 0 : undef;
-#use constant SPECIAL => undef;
-$VERSION = '1.405';
+$VERSION = '1.406';
my ( $FsPlugin, $Supported );
BEGIN
{
- Sys::Filesystem->plugins();
+ Sys::Filesystem->_plugins();
foreach my $qo (@query_order)
{
@@ -69,42 +66,45 @@ BEGIN
sub new
{
# Check we're being called correctly with a class name
- ref( my $class = shift ) && croak 'Class name required';
+ ref( my $class = shift ) and croak 'Class name required';
# Check we've got something sane passed
croak 'Odd number of elements passed when even number was expected' if ( @_ % 2 );
my %args = @_;
- # Double check the key pairs for stuff we recognise
- while ( my ( $k, $v ) = each(%args) )
- {
- unless ( grep( /^$k$/i, qw(fstab mtab xtab) ) )
- {
- croak("Unrecognised paramater '$k' passed to module $class");
- }
- }
+ exists $args{xtab} and carp("Using xtab is depreciated") and delete $args{xtab};
+ defined $FSTAB and not exists $args{fstab} and $args{fstab} = $FSTAB;
+ defined $MTAB and not exists $args{mtab} and $args{mtab} = $MTAB;
+ defined $CANONDEV and not exists $args{canondev} and $args{canondev} = $CANONDEV;
- my $self = {%args};
-
- # Filesystem property aliases
- $self->{aliases} = {
- device => [qw(fs_spec dev)],
- filesystem => [qw(fs_file mount_point)],
- mount_point => [qw(fs_file filesystem)],
- type => [qw(fs_vfstype vfs)],
- format => [qw(fs_vfstype vfs vfstype)],
- options => [qw(fs_mntops)],
- check_frequency => [qw(fs_freq)],
- check_order => [qw(fs_passno)],
- boot_order => [qw(fs_mntno)],
- volume => [qw(fs_volume fs_vol vol)],
- label => [qw(fs_label)],
- };
+ # Double check the key pairs for stuff we recognise
+ my @sane_keys = qw(aliases canondev fstab mtab);
+ my %sane_args;
+ @sane_args{@sane_keys} = delete @args{@sane_keys};
+ scalar keys %args and croak( "Unrecognised parameter(s) '" . join( "', '", sort keys %args ) . "' passed to module $class" );
+
+ my $self = {%sane_args};
+
+ # Filesystem property aliases - unless caller knows better ...
+ defined $self->{aliases}
+ or $self->{aliases} = {
+ device => [qw(fs_spec dev)],
+ filesystem => [qw(fs_file mount_point)],
+ mount_point => [qw(fs_file filesystem)],
+ type => [qw(fs_vfstype vfs)],
+ format => [qw(fs_vfstype vfs vfstype)],
+ options => [qw(fs_mntops)],
+ check_frequency => [qw(fs_freq)],
+ check_order => [qw(fs_passno)],
+ boot_order => [qw(fs_mntno)],
+ volume => [qw(fs_volume fs_vol vol)],
+ label => [qw(fs_label)],
+ };
# Debug
DUMP( '$self', $self ) if (DEBUG);
- $self->{filesystems} = $FsPlugin->new(%args);
+ $self->{filesystems} = $FsPlugin->new(%sane_args);
# Maybe upchuck a little
croak "Unable to create object for OS type '$self->{osname}'" unless ( $self->{filesystems} );
@@ -295,17 +295,28 @@ with common aliases wherever possible.
=item new
-Creates a new Sys::Filesystem object. new() accepts 3 optional key pair values
-to help or force where mount information is gathered from. These values are
-not otherwise defaulted by the main Sys::Filesystem object, but left to the
-platform specific helper modules to determine as an exercise of common sense.
+Creates a new Sys::Filesystem object. C<new> accepts following optional key
+value pairs to help or force where mount information is gathered from. These
+values are not otherwise defaulted by the main Sys::Filesystem object, but
+left to the platform specific helper modules to determine as an exercise of
+common sense.
=over 4
+=item canondev
+
+Specify whether device path's shall be resolved when they're a symbolic
+link.
+
+C<$Sys::Filesystem::CANONDEV> is used when no key C<canondev> is passed.
+
=item fstab
Specify the full path and filename of the filesystem table (or fstab for
-short).
+short). Not all platforms have such a file and so this option may be
+ignored on some systems.
+
+C<$Sys::Filesystem::FSTAB> is used when no key C<fstab> is passed.
=item mtab
@@ -313,12 +324,25 @@ Specify the full path and filename of the mounted filesystem table (or mtab
for short). Not all platforms have such a file and so this option may be
ignored on some systems.
+C<$Sys::Filesystem::MTAB> is used when no key C<mtab> is passed.
+
=item xtab
-Specify the full path and filename of the mounted NFS filesystem table
-(or xtab for short). This is usually only pertinant to Unix bases systems.
-Not all helper modules will query NFS mounts as a separate exercise, and
-therefore this option may be ignored on some systems.
+B<DEPRECIATED> Specify the full path and filename of the mounted NFS
+filesystem table (or xtab for short). This is usually only pertinant
+to Unix bases systems. Not all helper modules will query NFS mounts
+as a separate exercise, and therefore this option may be ignored on
+some systems.
+
+B<None> of the OS plugins use that tunable (anymore?), so it now a warning
+is raised when it's used. The entire support will be removed not before
+2015. Once that happened, using C<xtab> will raise an exception.
+
+=item aliases
+
+Overrides internal aliasing table used to match queries against OS
+plugin. This should be used only when dealing with closed source platform
+helper module(s).
=back
@@ -593,7 +617,7 @@ See CREDITS in the distribution tarball.
Copyright 2004,2005,2006 Nicola Worthington.
-Copyright 2008-2013 Jens Rehsack.
+Copyright 2008-2014 Jens Rehsack.
This software is licensed under The Apache Software License, Version 2.0.
diff --git a/lib/Sys/Filesystem/Aix.pm b/lib/Sys/Filesystem/Aix.pm
index 55cf8bb..ef5ddb3 100644
--- a/lib/Sys/Filesystem/Aix.pm
+++ b/lib/Sys/Filesystem/Aix.pm
@@ -31,9 +31,10 @@ use warnings;
use vars qw($VERSION);
use Carp qw(croak);
+use Cwd 'abs_path';
use IO::File;
-$VERSION = '1.405';
+$VERSION = '1.406';
sub version()
{
@@ -42,13 +43,13 @@ sub version()
my @fstab_keys = qw(account boot check dev mount nodename size type vfs vol log);
my %special_fs = (
- swap => 1,
- procfs => 1,
- proc => 1,
- tmpfs => 1,
- mntfs => 1,
- autofs => 1,
- );
+ swap => 1,
+ procfs => 1,
+ proc => 1,
+ tmpfs => 1,
+ mntfs => 1,
+ autofs => 1,
+);
# see AIX commands at
# http://publib.boulder.ibm.com/infocenter/pseries/v5r3/topic/com.ibm.aix.doc/doc/base/alphabeticallistofcommands.htm
@@ -82,6 +83,7 @@ sub new
my ( $device, $vfs, $nodename, $type, $size, $options, $mount, $account ) =
@{ $fs_info{$current_filesystem} };
+ $args{canondev} and -l $device and $device = abs_path($device);
$self->{$current_filesystem}->{dev} = $device;
$self->{$current_filesystem}->{vfs} = $vfs;
$self->{$current_filesystem}->{options} = $options;
@@ -117,6 +119,7 @@ sub new
my ( $lvname, $type, $lps, $pps, $pvs, $lvstate ) = @{ $fs_info{$current_filesystem} };
+ $args{canondev} and -l $lvname and $lvname = abs_path($lvname);
$self->{$current_filesystem}->{dev} = $lvname;
$self->{$current_filesystem}->{vfs} = $type;
$self->{$current_filesystem}->{LPs} = $lps;
@@ -139,7 +142,6 @@ sub new
my $current_filesystem = '*UNDEFINED*';
while (<$fstab>)
{
-
# skip comments and blank lines.
next if m{^ [*] }x || m{^ \s* $}x;
@@ -159,15 +161,15 @@ sub new
}
elsif ( my ( $key, $value ) = $_ =~ /^\s*([a-z]{3,8})\s+=\s+"?(.+)"?\s*$/ )
{
- unless ( defined( $self->{$current_filesystem}->{$key} ) )
- {
+ # do not overwrite already known data
+ defined $self->{$current_filesystem}->{$key} and next;
- # do not overwrite already known data
- $self->{$current_filesystem}->{$key} = $value;
- if ( ( $key eq 'vfs' ) && defined( $special_fs{$value} ) )
- {
- $self->{$current_filesystem}->{special} = 1;
- }
+ $key eq "dev" and $args{canondev} and -l $value and $value = abs_path($value);
+
+ $self->{$current_filesystem}->{$key} = $value;
+ if ( ( $key eq 'vfs' ) && defined( $special_fs{$value} ) )
+ {
+ $self->{$current_filesystem}->{special} = 1;
}
}
}
@@ -350,7 +352,7 @@ Jens Rehsack <rehsack at cpan.org> - L<http://www.rehsack.de/>
Copyright 2004,2005,2006 Nicola Worthington.
-Copyright 2008-2013 Jens Rehsack.
+Copyright 2008-2014 Jens Rehsack.
This software is licensed under The Apache Software License, Version 2.0.
diff --git a/lib/Sys/Filesystem/Cygwin.pm b/lib/Sys/Filesystem/Cygwin.pm
index 59890cc..11bfdba 100644
--- a/lib/Sys/Filesystem/Cygwin.pm
+++ b/lib/Sys/Filesystem/Cygwin.pm
@@ -32,7 +32,7 @@ use vars qw($VERSION @ISA);
use Carp qw(croak);
require Sys::Filesystem::Unix;
-$VERSION = '1.405';
+$VERSION = '1.406';
@ISA = qw(Sys::Filesystem::Unix);
sub version()
@@ -40,13 +40,13 @@ sub version()
return $VERSION;
}
-my @keys = qw(fs_spec fs_file fs_vfstype fs_mntops);
+my @keys = qw(fs_spec fs_file fs_vfstype fs_mntops);
my %special_fs = (
- swap => 1,
- proc => 1,
- devpts => 1,
- tmpfs => 1,
- );
+ swap => 1,
+ proc => 1,
+ devpts => 1,
+ tmpfs => 1,
+);
my $mount_rx = qr/^\s*(.+?)\s+on\s+(\/.+?)\s+type\s+(\S+)\s+\((\S+)\)\s*$/;
sub new
@@ -54,11 +54,14 @@ sub new
ref( my $class = shift ) && croak 'Class name required';
my %args = @_;
my $self = bless( {}, $class );
+ $args{canondev} and $self->{canondev} = 1;
local $/ = "\n";
my @mounts = qx( mount );
$self->readMounts( $mount_rx, [ 0, 1, 2 ], \@keys, \%special_fs, @mounts );
+ delete $self->{canondev};
+
$self;
}
@@ -147,7 +150,7 @@ Jens Rehsack <rehsack at cpan.org> - L<http://www.rehsack.de/>
Copyright 2004,2005,2006 Nicola Worthington.
-Copyright 2008-2013 Jens Rehsack.
+Copyright 2008-2014 Jens Rehsack.
This software is licensed under The Apache Software License, Version 2.0.
diff --git a/lib/Sys/Filesystem/Darwin.pm b/lib/Sys/Filesystem/Darwin.pm
index ee1748c..a1b7698 100644
--- a/lib/Sys/Filesystem/Darwin.pm
+++ b/lib/Sys/Filesystem/Darwin.pm
@@ -35,7 +35,7 @@ use IPC::Cmd ();
use Carp qw(croak);
-$VERSION = '1.405';
+$VERSION = '1.406';
@ISA = qw(Sys::Filesystem::Unix);
sub version()
@@ -46,10 +46,10 @@ sub version()
my @dt_keys = qw(fs_spec fs_file fs_vfstype fs_name);
my @mount_keys1 = qw(fs_spec fs_file fs_vfstype);
my @mount_keys2 = qw(fs_spec fs_file fs_mntops);
-my %special_fs = (
- devfs => 1,
- autofs => 1,
- );
+my %special_fs = (
+ devfs => 1,
+ autofs => 1,
+);
my $dt_rx = qr/Disk\sAppeared\s+\('([^']+)',\s*
Mountpoint\s*=\s*'([^']+)',\s*
@@ -62,12 +62,12 @@ sub new
{
my ( $class, %args ) = @_;
my $self = bless( {}, $class );
+ $args{canondev} and $self->{canondev} = 1;
foreach my $prog (qw(diskutil disktool mount))
{
defined $args{$prog}
- or $args{$prog} =
- ( grep { defined $_ and -x $_ } ( "/usr/sbin/$prog", "/sbin/$prog" ) )[0];
+ or $args{$prog} = ( grep { defined $_ and -x $_ } ( "/usr/sbin/$prog", "/sbin/$prog" ) )[0];
}
my @list_fs_cmd;
@@ -122,6 +122,8 @@ sub new
# }
#}
+ delete $self->{canondev};
+
$self;
}
@@ -231,7 +233,7 @@ Jens Rehsack <rehsack at cpan.org> - L<http://www.rehsack.de/>
=head1 COPYRIGHT
Copyright 2004,2005,2006 Nicola Worthington.
-Copyright 2009,2013 Jens Rehsack.
+Copyright 2009-2014 Jens Rehsack.
This software is licensed under The Apache Software License, Version 2.0.
diff --git a/lib/Sys/Filesystem/Dummy.pm b/lib/Sys/Filesystem/Dummy.pm
index 5d4fb5b..508215d 100644
--- a/lib/Sys/Filesystem/Dummy.pm
+++ b/lib/Sys/Filesystem/Dummy.pm
@@ -29,7 +29,7 @@ use strict;
use Carp qw(croak);
use vars qw($VERSION);
-$VERSION = '1.405';
+$VERSION = '1.406';
sub version()
{
@@ -86,7 +86,7 @@ Jens Rehsack <rehsack at cpan.org> - L<http://www.rehsack.de/>
Copyright 2004,2005,2006 Nicola Worthington.
-Copyright 2009,2013 Jens Rehsack.
+Copyright 2009-2014 Jens Rehsack.
This software is licensed under The Apache Software License, Version 2.0.
diff --git a/lib/Sys/Filesystem/Freebsd.pm b/lib/Sys/Filesystem/Freebsd.pm
index ffc9b01..714427b 100644
--- a/lib/Sys/Filesystem/Freebsd.pm
+++ b/lib/Sys/Filesystem/Freebsd.pm
@@ -33,7 +33,7 @@ use vars qw(@ISA $VERSION);
require Sys::Filesystem::Unix;
use Carp qw(croak);
-$VERSION = '1.405';
+$VERSION = '1.406';
@ISA = qw(Sys::Filesystem::Unix);
sub version()
@@ -41,13 +41,13 @@ sub version()
return $VERSION;
}
-my @keys = qw(fs_spec fs_file fs_vfstype fs_mntops fs_freq fs_passno);
+my @keys = qw(fs_spec fs_file fs_vfstype fs_mntops fs_freq fs_passno);
my %special_fs = (
- swap => 1,
- proc => 1,
- devpts => 1,
- tmpfs => 1,
- );
+ swap => 1,
+ proc => 1,
+ devpts => 1,
+ tmpfs => 1,
+);
my $mount_rx = qr|^([^\s]+)\s+([^\s]+)\s+([^\s]+)\s+([^\s]+)\s+([^\s]+)\s+([^\s]+)|;
my $swap_rx = qr|^(/[/\w]+)\s+|;
@@ -57,6 +57,7 @@ sub new
ref( my $class = shift ) && croak 'Class name required';
my %args = @_;
my $self = bless( {}, $class );
+ $args{canondev} and $self->{canondev} = 1;
$args{fstab} ||= $ENV{PATH_FSTAB} || '/etc/fstab';
@@ -68,6 +69,8 @@ sub new
croak "Unable to open fstab file ($args{fstab})\n";
}
+ delete $self->{canondev};
+
$self;
}
@@ -172,7 +175,7 @@ Jens Rehsack <rehsack at cpan.org> - L<http://www.rehsack.de>
Copyright 2004,2005,2006 Nicola Worthington.
-Copyright 2009,2013 Jens Rehsack.
+Copyright 2009-2014 Jens Rehsack.
This software is licensed under The Apache Software License, Version 2.0.
diff --git a/lib/Sys/Filesystem/Hpux.pm b/lib/Sys/Filesystem/Hpux.pm
index 420add2..593612a 100644
--- a/lib/Sys/Filesystem/Hpux.pm
+++ b/lib/Sys/Filesystem/Hpux.pm
@@ -30,7 +30,7 @@ require Sys::Filesystem::Unix;
use Carp qw(croak);
-$VERSION = '1.405';
+$VERSION = '1.406';
@ISA = qw(Sys::Filesystem::Unix);
sub version()
@@ -42,9 +42,9 @@ sub version()
my @fstabkeys = qw(fs_spec fs_file fs_vfstype fs_mntops fs_freq fs_passno);
my @mnttabkeys = qw(fs_spec fs_file fs_vfstype fs_mntops fs_freq fs_passno mount_time);
my %special_fs = (
- swap => 1,
- proc => 1
- );
+ swap => 1,
+ proc => 1
+);
sub new
{
@@ -52,6 +52,7 @@ sub new
my $class = ref($proto) || $proto or croak 'Class name required';
my %args = @_;
my $self = bless( {}, $class );
+ $args{canondev} and $self->{canondev} = 1;
# Defaults
$args{fstab} ||= '/etc/fstab';
@@ -67,6 +68,8 @@ sub new
croak "Unable to open fstab file ($args{mtab})\n";
}
+ delete $self->{canondev};
+
$self;
}
@@ -110,7 +113,7 @@ H.Merijn Brand, PROCURA B.V.
Copyright 2009 H.Merijn Brand PROCURA B.V.
-Copyright 2009,2013 Jens Rehsack.
+Copyright 2009-2014 Jens Rehsack.
This software is licensed under The Apache Software License, Version 2.0.
diff --git a/lib/Sys/Filesystem/Linux.pm b/lib/Sys/Filesystem/Linux.pm
index 7e7fa7c..3120b86 100644
--- a/lib/Sys/Filesystem/Linux.pm
+++ b/lib/Sys/Filesystem/Linux.pm
@@ -30,10 +30,11 @@ use warnings;
use vars qw($VERSION @ISA);
use Carp qw(croak);
-require IO::File;
-require Sys::Filesystem::Unix;
+use Cwd 'abs_path';
+use IO::File ();
+use Sys::Filesystem::Unix ();
-$VERSION = '1.405';
+$VERSION = '1.406';
@ISA = qw(Sys::Filesystem::Unix);
sub version()
@@ -42,23 +43,23 @@ sub version()
}
# Default fstab and mtab layout
-my @keys = qw(fs_spec fs_file fs_vfstype fs_mntops fs_freq fs_passno);
+my @keys = qw(fs_spec fs_file fs_vfstype fs_mntops fs_freq fs_passno);
my %special_fs = (
- binfmt_misc => 1,
- debugfs => 1,
- devpts => 1,
- fusectl => 1,
- 'fuse.gvfs-fuse-daemon' => 1,
- mini_fo => 1,
- nfsd => 1,
- proc => 1,
- procbususb => 1,
- securityfs => 1,
- swap => 1,
- sysfs => 1,
- tmpfs => 1,
- udev => 1,
- );
+ binfmt_misc => 1,
+ debugfs => 1,
+ devpts => 1,
+ fusectl => 1,
+ 'fuse.gvfs-fuse-daemon' => 1,
+ mini_fo => 1,
+ nfsd => 1,
+ proc => 1,
+ procbususb => 1,
+ securityfs => 1,
+ swap => 1,
+ sysfs => 1,
+ tmpfs => 1,
+ udev => 1,
+);
sub new
{
@@ -68,8 +69,9 @@ sub new
# Defaults
$args{fstab} ||= '/etc/fstab';
- $args{mtab} ||= -r '/proc/self/mounts' ? '/proc/self/mounts' : '/etc/mtab';
+ $args{mtab} ||= -r '/proc/mounts' ? '/proc/mounts' : '/etc/mtab';
#$args{xtab} ||= '/etc/lib/nfs/xtab';
+ $args{canondev} and $self->{canondev} = 1;
local $/ = "\n";
@@ -80,18 +82,15 @@ sub new
{
next if ( /^\s*#/ || /^\s*$/ );
my @vals = split( ' ', $_ );
- if ( $vals[0] =~ /^\s*LABEL=(.+)\s*$/ )
- {
- $self->{ $vals[1] }->{label} = $1;
- }
+ $vals[0] =~ /^\s*LABEL=(.+)\s*$/
+ and $self->{ $vals[1] }->{label} = $1;
+ $args{canondev} and -l $vals[0] and $vals[0] = abs_path( $vals[0] );
$self->{ $vals[1] }->{mount_point} = $vals[1];
$self->{ $vals[1] }->{device} = $vals[0];
$self->{ $vals[1] }->{unmounted} = 1;
- $self->{ $vals[1] }->{special} = 1 if ( defined( $special_fs{ $vals[2] } ) );
- for ( my $i = 0; $i < @keys; ++$i )
- {
- $self->{ $vals[1] }->{ $keys[$i] } = $vals[$i];
- }
+ defined $special_fs{ $vals[2] }
+ and $self->{ $vals[1] }->{special} = 1;
+ @{ $self->{ $vals[1] } }{@keys} = @vals;
}
$fstab->close();
}
@@ -106,6 +105,8 @@ sub new
croak "Unable to open fstab file ($args{mtab})\n";
}
+ delete $self->{canondev};
+
$self;
}
@@ -233,7 +234,7 @@ Jens Rehsack <rehsack at cpan.org> - L<http://www.rehsack.de/>
Copyright 2004,2005,2006 Nicola Worthington.
-Copyright 2009,2013 Jens Rehsack.
+Copyright 2009-2014 Jens Rehsack.
This software is licensed under The Apache Software License, Version 2.0.
diff --git a/lib/Sys/Filesystem/Mswin32.pm b/lib/Sys/Filesystem/Mswin32.pm
index 1094564..838225f 100644
--- a/lib/Sys/Filesystem/Mswin32.pm
+++ b/lib/Sys/Filesystem/Mswin32.pm
@@ -33,28 +33,15 @@ use Params::Util qw(_STRING);
use Win32::DriveInfo;
use Carp qw(croak);
-$VERSION = '1.405';
+$VERSION = '1.406';
sub version()
{
return $VERSION;
}
-my @volInfoAttrs = (
- 'n/a',
- 'preserve case',
- 'case sensitive',
- 'unicode',
- 'acl',
- 'file compression',
- 'compressed volume'
- );
-my @typeExplain = (
- 'unable to determine', 'no root directory',
- 'removeable', 'fixed',
- 'network', 'cdrom',
- 'ram disk'
- );
+my @volInfoAttrs = ( 'n/a', 'preserve case', 'case sensitive', 'unicode', 'acl', 'file compression', 'compressed volume' );
+my @typeExplain = ( 'unable to determine', 'no root directory', 'removeable', 'fixed', 'network', 'cdrom', 'ram disk' );
sub new
{
@@ -160,7 +147,7 @@ drives are recognized, no UNC names neither file systems mounted to a path.
Copyright 2004,2005,2006 Nicola Worthington.
-Copyright 2009,2013 Jens Rehsack.
+Copyright 2009-2014 Jens Rehsack.
This software is licensed under The Apache Software License, Version 2.0.
diff --git a/lib/Sys/Filesystem/Netbsd.pm b/lib/Sys/Filesystem/Netbsd.pm
index 20bf311..445f000 100644
--- a/lib/Sys/Filesystem/Netbsd.pm
+++ b/lib/Sys/Filesystem/Netbsd.pm
@@ -32,7 +32,7 @@ use vars qw(@ISA $VERSION);
require Sys::Filesystem::Unix;
use Carp qw(croak);
-$VERSION = '1.405';
+$VERSION = '1.406';
@ISA = qw(Sys::Filesystem::Unix);
sub version()
@@ -41,14 +41,14 @@ sub version()
}
# Default fstab and mtab layout
-my @keys = qw(fs_spec fs_file fs_vfstype fs_mntops fs_freq fs_passno);
+my @keys = qw(fs_spec fs_file fs_vfstype fs_mntops fs_freq fs_passno);
my %special_fs = (
- swap => 1,
- procfs => 1,
- kernfs => 1,
- ptyfs => 1,
- tmpfs => 1,
- );
+ swap => 1,
+ procfs => 1,
+ kernfs => 1,
+ ptyfs => 1,
+ tmpfs => 1,
+);
my $mount_rx = qr|^([/:\w]+)\s+on\s+([/\w]+)\s+type\s+(\w+)|;
my $swap_rx = qr|^(/[/\w]+)\s+|;
@@ -58,21 +58,21 @@ sub new
ref( my $class = shift ) && croak 'Class name required';
my %args = @_;
my $self = bless( {}, $class );
+ $args{canondev} and $self->{canondev} = 1;
# Defaults
$args{fstab} ||= $ENV{PATH_FSTAB} || '/etc/fstab';
my @mounts = qx( /sbin/mount );
- $self->readMounts( $mount_rx,
- [ 0, 1, 2 ],
- [qw(fs_spec fs_file fs_vfstype fs_mntops)],
- \%special_fs, @mounts );
+ $self->readMounts( $mount_rx, [ 0, 1, 2 ], [qw(fs_spec fs_file fs_vfstype fs_mntops)], \%special_fs, @mounts );
$self->readSwap( $swap_rx, qx( /sbin/swapctl -l ) );
unless ( $self->readFsTab( $args{fstab}, \@keys, [ 0, 1, 2 ], \%special_fs ) )
{
croak "Unable to open fstab file ($args{fstab})\n";
}
+ delete $self->{canondev};
+
return $self;
}
@@ -151,7 +151,7 @@ Jens Rehsack <rehsack at cpan.org> - L<http://www.rehsack.de/>
=head1 COPYRIGHT
-Copyright 2009,2013 Jens Rehsack.
+Copyright 2009-2014 Jens Rehsack.
This software is licensed under The Apache Software License, Version 2.0.
diff --git a/lib/Sys/Filesystem/Solaris.pm b/lib/Sys/Filesystem/Solaris.pm
index 06aa9e0..3e327db 100644
--- a/lib/Sys/Filesystem/Solaris.pm
+++ b/lib/Sys/Filesystem/Solaris.pm
@@ -34,7 +34,7 @@ use Carp qw(croak);
use Data::Dumper;
require Sys::Filesystem::Unix;
-$VERSION = '1.405';
+$VERSION = '1.406';
@ISA = qw(Sys::Filesystem::Unix);
sub version()
@@ -45,26 +45,27 @@ sub version()
my @fstab_keys = qw(device device_to_fsck mount_point fs_vfstype fs_freq mount_at_boot fs_mntops);
my @mtab_keys = qw(device mount_point fs_vfstype fs_mntops time);
my %special_fs = (
- swap => 1,
- proc => 1,
- procfs => 1,
- tmpfs => 1,
- mntfs => 1,
- autofs => 1,
- lofs => 1,
- fd => 1,
- ctfs => 1,
- devfs => 1,
- dev => 1,
- objfs => 1,
- cachefs => 1,
- );
+ swap => 1,
+ proc => 1,
+ procfs => 1,
+ tmpfs => 1,
+ mntfs => 1,
+ autofs => 1,
+ lofs => 1,
+ fd => 1,
+ ctfs => 1,
+ devfs => 1,
+ dev => 1,
+ objfs => 1,
+ cachefs => 1,
+);
sub new
{
ref( my $class = shift ) && croak 'Class name required';
my %args = @_;
my $self = bless( {}, $class );
+ $args{canondev} and $self->{canondev} = 1;
$args{fstab} ||= '/etc/vfstab';
$args{mtab} ||= '/etc/mnttab';
@@ -79,6 +80,8 @@ sub new
croak "Unable to open mtab file ($args{mtab})\n";
}
+ delete $self->{canondev};
+
$self;
}
@@ -169,7 +172,7 @@ Jens Rehsack <rehsack at cpan.org> - L<http://www.rehsack.de/>
=head1 COPYRIGHT
Copyright 2004,2005,2006 Nicola Worthington.
-Copyright 2009,2013 Jens Rehsack.
+Copyright 2009-2014 Jens Rehsack.
This software is licensed under The Apache Software License, Version 2.0.
diff --git a/lib/Sys/Filesystem/Unix.pm b/lib/Sys/Filesystem/Unix.pm
index a730445..bce4bef 100644
--- a/lib/Sys/Filesystem/Unix.pm
+++ b/lib/Sys/Filesystem/Unix.pm
@@ -31,10 +31,11 @@ use warnings;
use vars qw($VERSION);
use Carp qw(croak);
+use Cwd 'abs_path';
use Fcntl qw(:flock);
use IO::File;
-$VERSION = '1.405';
+$VERSION = '1.406';
sub version()
{
@@ -42,27 +43,28 @@ sub version()
}
# Default fstab and mtab layout
-my @keys = qw(fs_spec fs_file fs_vfstype fs_mntops fs_freq fs_passno);
+my @keys = qw(fs_spec fs_file fs_vfstype fs_mntops fs_freq fs_passno);
my %special_fs = (
- swap => 1,
- proc => 1
- );
+ swap => 1,
+ proc => 1
+);
sub new
{
ref( my $class = shift ) && croak 'Class name required';
my %args = @_;
my $self = bless( {}, $class );
+ $args{canondev} and $self->{canondev} = 1;
# Defaults
$args{fstab} ||= '/etc/fstab';
$args{mtab} ||= '/etc/mtab';
- # $args{xtab} ||= '/etc/lib/nfs/xtab';
-
$self->readFsTab( $args{fstab}, \@keys, [ 0, 1, 2 ], \%special_fs );
$self->readMntTab( $args{mtab}, \@keys, [ 0, 1, 2 ], \%special_fs );
+ delete $self->{canondev};
+
$self;
}
@@ -82,6 +84,7 @@ sub readFsTab($\@\@\%)
# next if( /^\s*$/ );
my @vals = split( ' ', $_ );
+ $self->{canondev} and -l $vals[ $pridx->[0] ] and $vals[ $pridx->[0] ] = abs_path( $vals[ $pridx->[0] ] );
$self->{ $vals[ $pridx->[1] ] }->{mount_point} = $vals[ $pridx->[1] ];
$self->{ $vals[ $pridx->[1] ] }->{device} = $vals[ $pridx->[0] ];
$self->{ $vals[ $pridx->[1] ] }->{unmounted} = 1
@@ -131,6 +134,7 @@ sub readMntTab($\@\@\%)
# next if( /^\s*$/ );
my @vals = split( /\s+/, $_ );
+ $self->{canondev} and -l $vals[ $pridx->[0] ] and $vals[ $pridx->[0] ] = abs_path( $vals[ $pridx->[0] ] );
delete $self->{ $vals[ $pridx->[1] ] }->{unmounted}
if ( exists( $self->{ $vals[ $pridx->[1] ] }->{unmounted} ) );
$self->{ $vals[ $pridx->[1] ] }->{mounted} = 1;
@@ -172,6 +176,7 @@ sub readMounts
{
if ( my @vals = $line =~ $mount_rx )
{
+ $self->{canondev} and -l $vals[ $pridx->[0] ] and $vals[ $pridx->[0] ] = abs_path( $vals[ $pridx->[0] ] );
$self->{ $vals[ $pridx->[1] ] }->{mount_point} = $vals[ $pridx->[1] ];
$self->{ $vals[ $pridx->[1] ] }->{device} = $vals[ $pridx->[0] ];
$self->{ $vals[ $pridx->[1] ] }->{mounted} = 1;
@@ -207,6 +212,7 @@ sub readSwap
{
if ( my ($dev) = $line =~ $swap_rx )
{
+ $self->{canondev} and -l $dev and $dev = abs_path($dev);
$self->{none}->{mount_point} ||= 'none';
$self->{none}->{device} = $dev;
$self->{none}->{fs_vfstype} = 'swap';
@@ -361,7 +367,7 @@ Jens Rehsack <rehsack at cpan.org> - L<http://www.rehsack.de/>
=head1 COPYRIGHT
Copyright 2004,2005,2006 Nicola Worthington.
-Copyright 2008-2013 Jens Rehsack.
+Copyright 2008-2014 Jens Rehsack.
This software is licensed under The Apache Software License, Version 2.0.
diff --git a/t/01_load.t b/t/01_load.t
index 5a3940a..2af3208 100644
--- a/t/01_load.t
+++ b/t/01_load.t
@@ -1,4 +1,7 @@
-# $Id: 00compile.t,v 1.1 2005/12/29 19:49:25 nicolaw Exp $
+#!perl
+
+use strict;
+use warnings;
use Test::More tests => 2;
@@ -7,7 +10,7 @@ use_ok('Sys::Filesystem');
use Config;
-my $os_info = join("-", $Config{osname}, $Config{osvers});
-$^O eq "MSWin32" and eval "use Win32;" and $os_info = join("-", Win32::GetOSName(), Win32::GetOSVersion());
+my $os_info = join( "-", $Config{osname}, $Config{osvers} );
+$^O eq "MSWin32" and eval "use Win32;" and $os_info = join( "-", Win32::GetOSName(), Win32::GetOSVersion() );
diag("Testing Sys::Filesystem $Sys::Filesystem::VERSION, Perl $] ($^X) on $os_info");
diff --git a/t/02_basic.t b/t/02_basic.t
index c40195a..c43fd06 100644
--- a/t/02_basic.t
+++ b/t/02_basic.t
@@ -1,11 +1,16 @@
+#!perl
+
+use strict;
+use warnings;
+
use Test::More;
use Sys::Filesystem;
my ( $fs, @filesystems );
eval { $fs = Sys::Filesystem->new(); @filesystems = $fs->filesystems(); };
-$@ and BAIL_OUT("Cannot initialize Sys::Filesystem: $@");
- at filesystems or BAILOUT("Badly poor supported OS or no file systems found.");
+$@ and plan skip_all => "Cannot initialize Sys::Filesystem: $@";
+ at filesystems or BAIL_OUT("Badly poor supported OS or no file systems found.");
ok( ref($fs) eq 'Sys::Filesystem', 'Create new Sys::Filesystem object' );
@@ -34,28 +39,27 @@ for my $filesystem (@filesystems)
ok( $special == grep( /^\Q$filesystem\E$/, @special_filesystems ), 'Special' );
ok( $regular == grep( /^\Q$filesystem\E$/, @regular_filesystems ), 'Regular' );
- my ( $device, $options, $format, $volume, $label );
+ my ( $device, $options, $format, $volume, $label, $type );
ok( $device = $fs->device($filesystem), "Get device for $filesystem" );
ok( defined( $options = $fs->options($filesystem) ), "Get options for $filesystem: $options" );
SKIP:
{
- $mounted or skip("Format might be unavailable unless mounted",1);
- ok( $format = $fs->format($filesystem), "Get format for $filesystem" );
+ $format = $fs->format($filesystem);
+ $mounted or skip( "Format might be unavailable unless mounted", 1 );
+ ok( $format, "Get format for $filesystem" );
}
ok( $volume = $fs->volume($filesystem) || 1, "Get volume type for $filesystem" );
ok( $label = $fs->label($filesystem) || 1, "Get label for $filesystem" );
$type = $fs->type($filesystem);
diag(
- join( ' - ',
- $filesystem, $mounted, $special,
- $device, $options, $format,
- $volume || 'n/a', $label || 'n/a', $type || 'n/a' )
- );
+ join( ' - ',
+ $filesystem, $mounted, $special, $device, $options,
+ $format || 'n/a', $volume || 'n/a', $label || 'n/a', $type || 'n/a' )
+ );
}
my $device = $fs->device( $filesystems[0] );
-ok( my $foo_filesystem = Sys::Filesystem::filesystems( device => $device ),
- "Get filesystem attached to $device" );
+ok( my $foo_filesystem = Sys::Filesystem::filesystems( device => $device ), "Get filesystem attached to $device" );
done_testing();
diff --git a/t/03_whereami.t b/t/03_whereami.t
index 20efe04..32a367f 100644
--- a/t/03_whereami.t
+++ b/t/03_whereami.t
@@ -1,3 +1,8 @@
+#!perl
+
+use strict;
+use warnings;
+
use Test::More;
use Sys::Filesystem;
use Cwd qw(abs_path);
@@ -14,7 +19,8 @@ $RealTest = ucfirst($RealTest) if ( $^O =~ m/Win32/ );
my $sfs;
eval { $sfs = Sys::Filesystem->new(); };
-plan( skip_all => "Cannot initialize Sys::Filesystem" ) if ($@);
+$@ and plan skip_all => "Cannot initialize Sys::Filesystem: $@";
+
ok( ref($sfs) eq 'Sys::Filesystem', 'Create new Sys::Filesystem object' );
my ( $binmount, $mymount );
@@ -47,9 +53,8 @@ SKIP:
TODO:
{
local $TODO = "Known fail for MSWin32, cygwin & Co. - let's make it not so important ...";
- ok( $mymount, sprintf( q{Found mountpoint for test file '%s' at '%s'}, $RealTest, $mymount || '<n/a>' ) );
- ok( $binmount,
- sprintf( q{Found mountpoint for perl executable '%s' at '%s'}, $RealPerl, $binmount || '<n/a>' ) );
+ ok( $mymount, sprintf( q{Found mountpoint for test file '%s' at '%s'}, $RealTest, $mymount || '<n/a>' ) );
+ ok( $binmount, sprintf( q{Found mountpoint for perl executable '%s' at '%s'}, $RealPerl, $binmount || '<n/a>' ) );
}
}
diff --git a/t/04_special.t b/t/04_special.t
index f3b0bbe..cc24e36 100644
--- a/t/04_special.t
+++ b/t/04_special.t
@@ -1,7 +1,16 @@
+#!perl
+
+use strict;
+use warnings;
+
use Test::More;
use Sys::Filesystem;
-my $fs = Sys::Filesystem->new();
+my $fs;
+eval { $fs = Sys::Filesystem->new(); };
+
+$@ and plan skip_all => "Cannot initialize Sys::Filesystem: $@";
+
ok( ref($fs) eq 'Sys::Filesystem', 'Create new Sys::Filesystem object' );
my @special_filesystems = $fs->special_filesystems();
diff --git a/t/05_error.t b/t/05_error.t
new file mode 100644
index 0000000..3cac55c
--- /dev/null
+++ b/t/05_error.t
@@ -0,0 +1,23 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Sys::Filesystem;
+
+my $fs;
+eval { $fs = Sys::Filesystem->new(); };
+
+$@ and plan skip_all => "Cannot initialize Sys::Filesystem: $@";
+
+eval { $fs = $fs->new(); };
+like( $@, qr/Class name required/, "No object new" );
+
+eval { $fs = Sys::Filesystem->new( insane => 1 ); };
+like( $@, qr/Unrecognised.*insane.*/, "No insane parameters" );
+
+eval { $fs = Sys::Filesystem->new('insane'); };
+like( $@, qr/Odd number of elements passed when even number was expected/, "No odd parameter list" );
+
+done_testing();
diff --git a/t/06_settings.t b/t/06_settings.t
new file mode 100644
index 0000000..a56f578
--- /dev/null
+++ b/t/06_settings.t
@@ -0,0 +1,64 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Sys::Filesystem;
+
+delete @ENV{qw(CANONDEV FSTAB MTAB)};
+
+my ( $fs, @filesystems );
+eval { $fs = Sys::Filesystem->new(); };
+
+$@ and plan skip_all => "Cannot initialize Sys::Filesystem: $@";
+ at filesystems = $fs->filesystems;
+
+my %devsymlinks;
+for my $filesystem (@filesystems)
+{
+ my $device = $fs->device($filesystem);
+ -l $device and $devsymlinks{$filesystem} = $device;
+}
+
+$fs = Sys::Filesystem->new( canondev => 1 );
+ at filesystems = $fs->filesystems;
+
+for my $filesystem (@filesystems)
+{
+ my $device = $fs->device($filesystem);
+ ok( !-l $device, "$device is not a symlink (canondev => 1)" );
+}
+
+SCOPE:
+{
+ local $Sys::Filesystem::CANONDEV = 0;
+ $fs = Sys::Filesystem->new();
+ @filesystems = $fs->filesystems;
+ my %symdevs;
+ for my $filesystem (@filesystems)
+ {
+ my $device = $fs->device($filesystem);
+ -l $device and $symdevs{$filesystem} = $device;
+ }
+ is_deeply( \%symdevs, \%devsymlinks, "\$S::F::CANONDEV = 0 works as expected" );
+}
+
+SCOPE:
+{
+ local $Sys::Filesystem::CANONDEV = 1;
+ $fs = Sys::Filesystem->new();
+ @filesystems = $fs->filesystems;
+ for my $filesystem (@filesystems)
+ {
+ my $device = $fs->device($filesystem);
+ ok( !-l $device, "$device is not a symlink (\$S::F::CANONDEV = 1)" );
+ }
+}
+
+# Testing $S::F::MTAB and/or $S::F::FSTAB is pointless - half of the
+# plugins ignore at least one, likely both
+
+# devnull
+
+done_testing;
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libsys-filesystem-perl.git
More information about the Pkg-perl-cvs-commits
mailing list