r52680 - in /branches/upstream/libsys-filesystem-perl/current: ./ lib/Sys/ lib/Sys/Filesystem/ t/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Sat Feb 13 22:14:14 UTC 2010
Author: jawnsy-guest
Date: Sat Feb 13 22:13:52 2010
New Revision: 52680
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=52680
Log:
[svn-upgrade] Integrating new upstream version, libsys-filesystem-perl (1.26)
Modified:
branches/upstream/libsys-filesystem-perl/current/Build.PL
branches/upstream/libsys-filesystem-perl/current/Changes
branches/upstream/libsys-filesystem-perl/current/MANIFEST.SKIP
branches/upstream/libsys-filesystem-perl/current/META.yml
branches/upstream/libsys-filesystem-perl/current/Makefile.PL
branches/upstream/libsys-filesystem-perl/current/README
branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem.pm
branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Aix.pm
branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Cygwin.pm
branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Darwin.pm
branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Dummy.pm
branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Freebsd.pm
branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Hpux.pm
branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Linux.pm
branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Mswin32.pm
branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Netbsd.pm
branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Solaris.pm
branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Unix.pm
branches/upstream/libsys-filesystem-perl/current/t/03test.t
branches/upstream/libsys-filesystem-perl/current/t/04whereami.t
Modified: branches/upstream/libsys-filesystem-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsys-filesystem-perl/current/Build.PL?rev=52680&op=diff
==============================================================================
--- branches/upstream/libsys-filesystem-perl/current/Build.PL (original)
+++ branches/upstream/libsys-filesystem-perl/current/Build.PL Sat Feb 13 22:13:52 2010
@@ -1,5 +1,5 @@
# vim:ts=4:sw=4:tw=78
-# $Id: Build.PL 43 2009-10-30 20:00:31Z trevor $
+# $Id: Build.PL 47 2009-11-29 13:50:03Z trevor $
use 5.006;
@@ -20,12 +20,12 @@
'perl' => '5.006',
'Carp' => 0,
'Params::Util' => '1.00',
+ 'Module::Pluggable' => '3.9',
'IO' => 0,
( $^O eq /Win32/i ? ( 'Win32::DriveInfo' => 0, ) : () ),
},
recommends => {
- 'Test' => 0,
'Test::More' => 0,
'Test::Pod' => 0,
'Test::Pod::Coverage' => 0,
Modified: branches/upstream/libsys-filesystem-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsys-filesystem-perl/current/Changes?rev=52680&op=diff
==============================================================================
--- branches/upstream/libsys-filesystem-perl/current/Changes (original)
+++ branches/upstream/libsys-filesystem-perl/current/Changes Sat Feb 13 22:13:52 2010
@@ -1,3 +1,10 @@
+1.26
+ Adding more special file systems for Linux
+ Prefer /proc/self/mounts over /etc/mtab (when available), fixes
+ RT #51151 (Thanks Tyler MacDonald)
+ Fix some tests to skip when no regular file systems could be found
+ Some Win32 fixes
+ Switch to Module::Pluggable to load OS-plugins
1.25
Fixed support for FreeBSD and generalize BSD support
Fixed support for AIX
Modified: branches/upstream/libsys-filesystem-perl/current/MANIFEST.SKIP
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsys-filesystem-perl/current/MANIFEST.SKIP?rev=52680&op=diff
==============================================================================
--- branches/upstream/libsys-filesystem-perl/current/MANIFEST.SKIP (original)
+++ branches/upstream/libsys-filesystem-perl/current/MANIFEST.SKIP Sat Feb 13 22:13:52 2010
@@ -22,3 +22,4 @@
^pm_to_blib$
^_build/.*
~$
+^MYMETA.yml$
Modified: branches/upstream/libsys-filesystem-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsys-filesystem-perl/current/META.yml?rev=52680&op=diff
==============================================================================
--- branches/upstream/libsys-filesystem-perl/current/META.yml (original)
+++ branches/upstream/libsys-filesystem-perl/current/META.yml Sat Feb 13 22:13:52 2010
@@ -1,62 +1,62 @@
---
-name: Sys-Filesystem
-version: 1.25
+abstract: 'Retrieve list of filesystems and their properties'
author:
- 'Jens Rehsack <rehsack at cpan.org>'
-abstract: Retrieve list of filesystems and their properties
+configure_requires:
+ Module::Build: 0.36
+generated_by: 'Module::Build version 0.3603'
license: apache
-resources:
- license: http://apache.org/licenses/LICENSE-2.0
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: Sys-Filesystem
+provides:
+ Sys::Filesystem:
+ file: lib/Sys/Filesystem.pm
+ version: 1.26
+ Sys::Filesystem::Aix:
+ file: lib/Sys/Filesystem/Aix.pm
+ version: 1.26
+ Sys::Filesystem::Cygwin:
+ file: lib/Sys/Filesystem/Cygwin.pm
+ version: 1.26
+ Sys::Filesystem::Darwin:
+ file: lib/Sys/Filesystem/Darwin.pm
+ version: 1.26
+ Sys::Filesystem::Dummy:
+ file: lib/Sys/Filesystem/Dummy.pm
+ version: 1.26
+ Sys::Filesystem::Freebsd:
+ file: lib/Sys/Filesystem/Freebsd.pm
+ version: 1.26
+ Sys::Filesystem::Hpux:
+ file: lib/Sys/Filesystem/Hpux.pm
+ version: 1.26
+ Sys::Filesystem::Linux:
+ file: lib/Sys/Filesystem/Linux.pm
+ version: 1.26
+ Sys::Filesystem::Mswin32:
+ file: lib/Sys/Filesystem/Mswin32.pm
+ version: 1.26
+ Sys::Filesystem::Netbsd:
+ file: lib/Sys/Filesystem/Netbsd.pm
+ version: 1.26
+ Sys::Filesystem::Solaris:
+ file: lib/Sys/Filesystem/Solaris.pm
+ version: 1.26
+ Sys::Filesystem::Unix:
+ file: lib/Sys/Filesystem/Unix.pm
+ version: 1.26
+recommends:
+ Test::More: 0
+ Test::Pod: 0
+ Test::Pod::Coverage: 0
requires:
Carp: 0
IO: 0
+ Module::Pluggable: 3.9
Params::Util: 1.00
perl: 5.006
-recommends:
- Test: 0
- Test::More: 0
- Test::Pod: 0
- Test::Pod::Coverage: 0
-configure_requires:
- Module::Build: 0.35
-provides:
- Sys::Filesystem:
- file: lib/Sys/Filesystem.pm
- version: 1.25
- Sys::Filesystem::Aix:
- file: lib/Sys/Filesystem/Aix.pm
- version: 1.25
- Sys::Filesystem::Cygwin:
- file: lib/Sys/Filesystem/Cygwin.pm
- version: 1.25
- Sys::Filesystem::Darwin:
- file: lib/Sys/Filesystem/Darwin.pm
- version: 1.25
- Sys::Filesystem::Dummy:
- file: lib/Sys/Filesystem/Dummy.pm
- version: 1.06
- Sys::Filesystem::Freebsd:
- file: lib/Sys/Filesystem/Freebsd.pm
- version: 1.25
- Sys::Filesystem::Hpux:
- file: lib/Sys/Filesystem/Hpux.pm
- version: 1.25
- Sys::Filesystem::Linux:
- file: lib/Sys/Filesystem/Linux.pm
- version: 1.25
- Sys::Filesystem::Mswin32:
- file: lib/Sys/Filesystem/Mswin32.pm
- version: 1.25
- Sys::Filesystem::Netbsd:
- file: lib/Sys/Filesystem/Netbsd.pm
- version: 1.25
- Sys::Filesystem::Solaris:
- file: lib/Sys/Filesystem/Solaris.pm
- version: 1.25
- Sys::Filesystem::Unix:
- file: lib/Sys/Filesystem/Unix.pm
- version: 1.25
-generated_by: Module::Build version 0.35
-meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+resources:
+ license: http://www.apache.org/licenses/LICENSE-2.0.txt
+version: 1.26
Modified: branches/upstream/libsys-filesystem-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsys-filesystem-perl/current/Makefile.PL?rev=52680&op=diff
==============================================================================
--- branches/upstream/libsys-filesystem-perl/current/Makefile.PL (original)
+++ branches/upstream/libsys-filesystem-perl/current/Makefile.PL Sat Feb 13 22:13:52 2010
@@ -1,34 +1,34 @@
-# Note: this file was auto-generated by Module::Build::Compat version 0.35
+# Note: this file was auto-generated by Module::Build::Compat version 0.3603
require 5.006;
-
+
unless (eval "use Module::Build::Compat 0.02; 1" ) {
print "This module requires Module::Build to install itself.\n";
-
+
require ExtUtils::MakeMaker;
my $yn = ExtUtils::MakeMaker::prompt
(' Install Module::Build now from CPAN?', 'y');
-
+
unless ($yn =~ /^y/i) {
die " *** Cannot install without Module::Build. Exiting ...\n";
}
-
+
require Cwd;
require File::Spec;
require CPAN;
-
+
# Save this 'cause CPAN will chdir all over the place.
my $cwd = Cwd::cwd();
-
+
CPAN::Shell->install('Module::Build::Compat');
CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate
or die "Couldn't install Module::Build, giving up.\n";
-
+
chdir $cwd or die "Cannot chdir() back to $cwd: $!";
}
eval "use Module::Build::Compat 0.02; 1" or die $@;
Module::Build::Compat->run_build_pl(args => \@ARGV);
- my $build_script = 'Build';
+ my $build_script = 'Build';
$build_script .= '.com' if $^O eq 'VMS';
exit(0) unless(-e $build_script); # cpantesters convention
require Module::Build;
Modified: branches/upstream/libsys-filesystem-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsys-filesystem-perl/current/README?rev=52680&op=diff
==============================================================================
--- branches/upstream/libsys-filesystem-perl/current/README (original)
+++ branches/upstream/libsys-filesystem-perl/current/README Sat Feb 13 22:13:52 2010
@@ -205,7 +205,7 @@
First written by Christian Renz <crenz at web42.com>.
Win32
- Provides "mount_point" and "device" of mounted filesystems on Windows.
+ Provides `mount_point' and `device' of mounted filesystems on Windows.
AIX
Please be aware that the AIX /etc/filesystems file has both a "type" and
@@ -235,12 +235,12 @@
perlport, Solaris::DeviceTree, Win32::DriveInfo
VERSION
- $Id: Filesystem.pm 43 2009-10-30 20:00:31Z trevor $
+ $Id: Filesystem.pm 61 2010-02-12 14:36:11Z trevor $
AUTHOR
- Nicola Worthington <nicolaw at cpan.org> - <http://perlgirl.org.uk>
-
- Jens Rehsack <rehsack at cpan.org> - <http://www.rehsack.de/>
+ Nicola Worthington <nicolaw at cpan.org> - http://perlgirl.org.uk
+
+ Jens Rehsack <rehsack at cpan.org> - http://www.rehsack.de/
ACKNOWLEDGEMENTS
See CREDITS in the distribution tarball.
@@ -253,5 +253,5 @@
This software is licensed under The Apache Software License, Version
2.0.
- <http://www.apache.org/licenses/LICENSE-2.0>
-
+ http://www.apache.org/licenses/LICENSE-2.0
+
Modified: branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem.pm?rev=52680&op=diff
==============================================================================
--- branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem.pm (original)
+++ branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem.pm Sat Feb 13 22:13:52 2010
@@ -1,6 +1,6 @@
############################################################
#
-# $Id: Filesystem.pm 43 2009-10-30 20:00:31Z trevor $
+# $Id: Filesystem.pm 61 2010-02-12 14:36:11Z trevor $
# Sys::Filesystem - Retrieve list of filesystems and their properties
#
# Copyright 2004,2005,2006 Nicola Worthington
@@ -26,58 +26,61 @@
use 5.006;
+my @query_order;
+
use strict;
-use FileHandle;
+use warnings;
+use vars qw($VERSION $AUTOLOAD);
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'];
use Params::Util qw(_INSTANCE);
+use Scalar::Util qw(blessed);
use constant DEBUG => $ENV{SYS_FILESYSTEM_DEBUG} ? 1 : 0;
use constant SPECIAL => ( 'darwin' eq $^O ) ? 0 : undef;
-use vars qw($VERSION $AUTOLOAD);
-$VERSION = '1.25';
+
+$VERSION = '1.26';
+
+my ( $FsPlugin, $Supported );
+
+BEGIN
+{
+ Sys::Filesystem->plugins();
+
+ foreach my $qo (@query_order)
+ {
+ next unless ( UNIVERSAL::isa( $qo, $qo ) );
+ $FsPlugin = $qo;
+ last;
+ }
+
+ $Supported = ( $FsPlugin ne 'Sys::Filesystem::Unix' ) && ( $FsPlugin ne 'Sys::Filesystem::Dummy' );
+}
sub new
{
-
# Check we're being called correctly with a class name
ref( my $class = shift ) && croak 'Class name required';
# Check we've got something sane passed
- croak 'Odd number of elements passed when even number was expected' if @_ % 2;
+ 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 )
+ while ( my ( $k, $v ) = each(%args) )
{
unless ( grep( /^$k$/i, qw(fstab mtab xtab) ) )
{
- croak "Unrecognised paramater '$k' passed to module $class";
+ croak("Unrecognised paramater '$k' passed to module $class");
}
}
- # How to query
my $self = {%args};
- $self->{osname} = $^O;
- my @query_order = ( ucfirst( $self->{osname} ) );
- push @query_order, $self->{osname} =~ /Win32/i ? 'Win32' : 'Unix';
- push @query_order, 'Dummy';
-
- # Try and query
- for (@query_order)
- {
- my $obj = undef;
- my $code = sprintf( 'require %s::%s; $obj = %s::%s->new(%%args);', __PACKAGE__, $_, __PACKAGE__, $_ );
- eval { eval($code); };
- if ( defined $obj && ref($obj) && !$@ )
- {
- $self->{filesystems} = $obj;
- last;
- }
- }
-
- $self->{supported} =
- ( ref( $self->{filesystems} ) ne 'Sys::Filesystem::Unix' )
- && ( ref( $self->{filesystems} ) ne 'Sys::Filesystem::Dummy' );
# Filesystem property aliases
$self->{aliases} = {
@@ -95,10 +98,12 @@
};
# Debug
- DUMP( '$self', $self );
+ DUMP( '$self', $self ) if (DEBUG);
+
+ $self->{filesystems} = $FsPlugin->new(%args);
# Maybe upchuck a little
- croak "Unable to create object for OS type '$self->{osname}'" unless $self->{filesystems};
+ croak "Unable to create object for OS type '$self->{osname}'" unless ( $self->{filesystems} );
# Bless and return
bless( $self, $class );
@@ -175,7 +180,7 @@
sub supported()
{
- return $_[0]->{supported};
+ return $Supported;
}
sub mounted_filesystems
@@ -203,9 +208,9 @@
sub AUTOLOAD
{
my ( $self, $fs ) = @_;
- my $type = ref($self) || croak "$self is not an object";
-
- croak "No filesystem passed where expected" unless $fs;
+
+ croak "$self is not an object" unless ( blessed($self) );
+ croak "No filesystem passed where expected" unless ($fs);
( my $name = $AUTOLOAD ) =~ s/.*://;
@@ -213,27 +218,20 @@
unless ( exists $self->{filesystems}->{$fs} )
{
croak "No such filesystem";
-
- # Look for the property
}
else
{
-
# Found the property
if ( exists $self->{filesystems}->{$fs}->{$name} )
{
return $self->{filesystems}->{$fs}->{$name};
-
- # Didn't find the property, but check any aliases
}
elsif ( exists $self->{aliases}->{$name} )
- {
+ { # Didn't find the property, but check any aliases
for my $alias ( @{ $self->{aliases}->{$name} } )
{
-
- # Found the Alias
if ( exists $self->{filesystems}->{$fs}->{$alias} )
- {
+ { # Found the Alias
return $self->{filesystems}->{$fs}->{$alias};
}
}
@@ -554,7 +552,7 @@
=head1 VERSION
-$Id: Filesystem.pm 43 2009-10-30 20:00:31Z trevor $
+$Id: Filesystem.pm 61 2010-02-12 14:36:11Z trevor $
=head1 AUTHOR
Modified: branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Aix.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Aix.pm?rev=52680&op=diff
==============================================================================
--- branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Aix.pm (original)
+++ branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Aix.pm Sat Feb 13 22:13:52 2010
@@ -1,6 +1,6 @@
############################################################
#
-# $Id: Aix.pm 43 2009-10-30 20:00:31Z trevor $
+# $Id: Aix.pm 61 2010-02-12 14:36:11Z trevor $
# Sys::Filesystem - Retrieve list of filesystems and their properties
#
# Copyright 2004,2005,2006 Nicola Worthington
@@ -31,7 +31,7 @@
use Carp qw(croak);
use IO::File;
-$VERSION = '1.25';
+$VERSION = '1.26';
sub version()
{
@@ -327,7 +327,7 @@
=head1 VERSION
-$Id: Aix.pm 43 2009-10-30 20:00:31Z trevor $
+$Id: Aix.pm 61 2010-02-12 14:36:11Z trevor $
=head1 AUTHOR
Modified: branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Cygwin.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Cygwin.pm?rev=52680&op=diff
==============================================================================
--- branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Cygwin.pm (original)
+++ branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Cygwin.pm Sat Feb 13 22:13:52 2010
@@ -1,6 +1,6 @@
############################################################
#
-# $Id: Cygwin.pm 43 2009-10-30 20:00:31Z trevor $
+# $Id: Cygwin.pm 49 2009-12-05 11:08:35Z trevor $
# Sys::Filesystem - Retrieve list of filesystems and their properties
#
# Copyright 2004,2005,2006 Nicola Worthington
@@ -30,7 +30,7 @@
use Carp qw(croak);
require Sys::Filesystem::Unix;
-$VERSION = '1.25';
+$VERSION = '1.26';
@ISA = qw(Sys::Filesystem::Unix);
sub version()
@@ -133,7 +133,7 @@
=head1 VERSION
-$Id: Cygwin.pm 43 2009-10-30 20:00:31Z trevor $
+$Id: Cygwin.pm 49 2009-12-05 11:08:35Z trevor $
=head1 AUTHOR
Modified: branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Darwin.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Darwin.pm?rev=52680&op=diff
==============================================================================
--- branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Darwin.pm (original)
+++ branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Darwin.pm Sat Feb 13 22:13:52 2010
@@ -1,6 +1,6 @@
############################################################
#
-# $Id: Darwin.pm 43 2009-10-30 20:00:31Z trevor $
+# $Id: Darwin.pm 61 2010-02-12 14:36:11Z trevor $
# Sys::Filesystem - Retrieve list of filesystems and their properties
#
# Copyright 2004,2005,2006 Nicola Worthington
@@ -34,7 +34,7 @@
use Carp qw(croak);
-$VERSION = '1.25';
+$VERSION = '1.26';
@ISA = qw(Sys::Filesystem::Unix);
sub version()
@@ -46,14 +46,16 @@
my @mount_keys = qw(fs_spec fs_file fs_mntops);
my %special_fs = qw();
-my $dt_rx = qr/Disk Appeared \('([^']+)',Mountpoint = '([^']+)', fsType = '([^']*)', volName = '([^']*)'\)/;
+my $dt_rx = qr/Disk\sAppeared\s+\('([^']+)',\s*
+ Mountpoint\s*=\s*'([^']+)',\s*
+ fsType\s*=\s*'([^']*)',\s*
+ volName\s*=\s*'([^']*)'\)/x;
my $mount_rx = qr/(.*) on (.*) \((.*)\)/; # /dev/disk on / (hfs,...)
sub new
{
- my $class = shift;
- my %args = @_;
- my $self = bless( {}, $class );
+ my ( $class, %args ) = @_;
+ my $self = bless( {}, $class );
$args{disktool} ||= '/usr/sbin/disktool';
$args{mount} ||= '/sbin/mount';
@@ -197,7 +199,7 @@
=head1 VERSION
-$Id: Darwin.pm 43 2009-10-30 20:00:31Z trevor $
+$Id: Darwin.pm 61 2010-02-12 14:36:11Z trevor $
=head1 AUTHOR
Modified: branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Dummy.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Dummy.pm?rev=52680&op=diff
==============================================================================
--- branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Dummy.pm (original)
+++ branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Dummy.pm Sat Feb 13 22:13:52 2010
@@ -1,6 +1,6 @@
############################################################
#
-# $Id: Dummy.pm 41 2009-10-30 19:23:22Z trevor $
+# $Id: Dummy.pm 61 2010-02-12 14:36:11Z trevor $
# Sys::Filesystem - Retrieve list of filesystems and their properties
#
# Copyright 2004,2005,2006 Nicola Worthington
@@ -27,7 +27,7 @@
use Carp qw(croak);
use vars qw($VERSION);
-$VERSION = '1.06';
+$VERSION = '1.26';
sub version()
{
@@ -72,7 +72,7 @@
=head1 VERSION
-$Id: Dummy.pm 41 2009-10-30 19:23:22Z trevor $
+$Id: Dummy.pm 61 2010-02-12 14:36:11Z trevor $
=head1 AUTHOR
Modified: branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Freebsd.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Freebsd.pm?rev=52680&op=diff
==============================================================================
--- branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Freebsd.pm (original)
+++ branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Freebsd.pm Sat Feb 13 22:13:52 2010
@@ -1,6 +1,6 @@
############################################################
#
-# $Id: Freebsd.pm 43 2009-10-30 20:00:31Z trevor $
+# $Id: Freebsd.pm 61 2010-02-12 14:36:11Z trevor $
# Sys::Filesystem - Retrieve list of filesystems and their properties
#
# Copyright 2004,2005,2006 Nicola Worthington
@@ -31,7 +31,7 @@
require Sys::Filesystem::Unix;
use Carp qw(croak);
-$VERSION = '1.25';
+$VERSION = '1.26';
@ISA = qw(Sys::Filesystem::Unix);
sub version()
@@ -158,7 +158,7 @@
=head1 VERSION
-$Id: Freebsd.pm 43 2009-10-30 20:00:31Z trevor $
+$Id: Freebsd.pm 61 2010-02-12 14:36:11Z trevor $
=head1 AUTHOR
Modified: branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Hpux.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Hpux.pm?rev=52680&op=diff
==============================================================================
--- branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Hpux.pm (original)
+++ branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Hpux.pm Sat Feb 13 22:13:52 2010
@@ -1,5 +1,5 @@
# Sys::Filesystem - Retrieve list of filesystems and their properties
-# $Id: Hpux.pm 43 2009-10-30 20:00:31Z trevor $
+# $Id: Hpux.pm 61 2010-02-12 14:36:11Z trevor $
#
# Copyright (c) 2009 H.Merijn Brand, All rights reserved.
# Copyright (c) 2009 Jens Rehsack, All rights reserved.
@@ -30,7 +30,7 @@
use Carp qw(croak);
-$VERSION = '1.25';
+$VERSION = '1.26';
@ISA = qw(Sys::Filesystem::Unix);
sub version()
@@ -100,7 +100,7 @@
=head1 VERSION
-$Id: Hpux.pm 43 2009-10-30 20:00:31Z trevor $
+$Id: Hpux.pm 61 2010-02-12 14:36:11Z trevor $
=head1 AUTHOR
Modified: branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Linux.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Linux.pm?rev=52680&op=diff
==============================================================================
--- branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Linux.pm (original)
+++ branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Linux.pm Sat Feb 13 22:13:52 2010
@@ -1,6 +1,6 @@
############################################################
#
-# $Id: Linux.pm 43 2009-10-30 20:00:31Z trevor $
+# $Id: Linux.pm 61 2010-02-12 14:36:11Z trevor $
# Sys::Filesystem - Retrieve list of filesystems and their properties
#
# Copyright 2004,2005,2006 Nicola Worthington
@@ -31,7 +31,7 @@
require IO::File;
require Sys::Filesystem::Unix;
-$VERSION = '1.25';
+$VERSION = '1.26';
@ISA = qw(Sys::Filesystem::Unix);
sub version()
@@ -42,10 +42,15 @@
# Default fstab and mtab layout
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,
+ sysfs => 1,
+ procbususb => 1,
+ udev => 1,
+ devpts => 1,
+ nfsd => 1,
);
sub new
@@ -56,8 +61,7 @@
# Defaults
$args{fstab} ||= '/etc/fstab';
- $args{mtab} ||= '/etc/mtab';
-
+ $args{mtab} ||= -r '/proc/self/mounts' ? '/proc/self/mounts' : '/etc/mtab';
#$args{xtab} ||= '/etc/lib/nfs/xtab';
local $/ = "\n";
@@ -210,7 +214,7 @@
=head1 VERSION
-$Id: Linux.pm 43 2009-10-30 20:00:31Z trevor $
+$Id: Linux.pm 61 2010-02-12 14:36:11Z trevor $
=head1 AUTHOR
Modified: branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Mswin32.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Mswin32.pm?rev=52680&op=diff
==============================================================================
--- branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Mswin32.pm (original)
+++ branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Mswin32.pm Sat Feb 13 22:13:52 2010
@@ -1,6 +1,6 @@
############################################################
#
-# $Id: Mswin32.pm 41 2009-10-30 19:23:22Z trevor $
+# $Id: Mswin32.pm 61 2010-02-12 14:36:11Z trevor $
# Sys::Filesystem - Retrieve list of filesystems and their properties
#
# Copyright 2004,2005,2006 Nicola Worthington
@@ -24,11 +24,13 @@
# vim:ts=4:sw=4:tw=78
use strict;
+use warnings;
+use Params::Util qw(_STRING);
use Win32::DriveInfo;
use Carp qw(croak);
use vars qw($VERSION);
-$VERSION = '1.25';
+$VERSION = '1.26';
sub version()
{
@@ -48,10 +50,16 @@
my $type = Win32::DriveInfo::DriveType($volume);
my ( $VolumeName, $VolumeSerialNumber, $MaximumComponentLength, $FileSystemName, @attr ) =
Win32::DriveInfo::VolumeInfo($volume);
+ next unless ( defined($VolumeName) );
+ $VolumeName = $volume unless ( defined( _STRING($VolumeName) ) );
+ $VolumeName =~ s/\\/\//g;
+ $VolumeName = ucfirst($VolumeName);
$self->{$VolumeName}->{mount_point} = $VolumeName;
- $self->{$VolumeName}->{device} = $FileSystemName;
- $self->{$VolumeName}->{mounted} = 1;
+ $self->{$VolumeName}->{device} = $FileSystemName; # XXX Win32::DriveInfo gives no details here ...
+ $self->{$VolumeName}->{format} = $FileSystemName; # XXX Win32::DriveInfo gives wrong information here
+ $self->{$VolumeName}->{options} = join( ',', @attr );
+ $self->{$VolumeName}->{mounted} = 1;
}
bless( $self, $class );
@@ -105,7 +113,7 @@
=head1 VERSION
-$Id: Mswin32.pm 41 2009-10-30 19:23:22Z trevor $
+$Id: Mswin32.pm 61 2010-02-12 14:36:11Z trevor $
=head1 AUTHOR
Modified: branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Netbsd.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Netbsd.pm?rev=52680&op=diff
==============================================================================
--- branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Netbsd.pm (original)
+++ branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Netbsd.pm Sat Feb 13 22:13:52 2010
@@ -1,6 +1,6 @@
############################################################
#
-# $Id: Netbsd.pm 43 2009-10-30 20:00:31Z trevor $
+# $Id: Netbsd.pm 61 2010-02-12 14:36:11Z trevor $
# Sys::Filesystem - Retrieve list of filesystems and their properties
#
# Copyright 2009 Jens Rehsack
@@ -29,7 +29,7 @@
require Sys::Filesystem::Unix;
use Carp qw(croak);
-$VERSION = '1.25';
+$VERSION = '1.26';
@ISA = qw(Sys::Filesystem::Unix);
sub version()
@@ -137,7 +137,7 @@
=head1 VERSION
-$Id: Netbsd.pm 43 2009-10-30 20:00:31Z trevor $
+$Id: Netbsd.pm 61 2010-02-12 14:36:11Z trevor $
=head1 AUTHOR
Modified: branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Solaris.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Solaris.pm?rev=52680&op=diff
==============================================================================
--- branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Solaris.pm (original)
+++ branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Solaris.pm Sat Feb 13 22:13:52 2010
@@ -1,6 +1,6 @@
############################################################
#
-# $Id: Solaris.pm 43 2009-10-30 20:00:31Z trevor $
+# $Id: Solaris.pm 61 2010-02-12 14:36:11Z trevor $
# Sys::Filesystem - Retrieve list of filesystems and their properties
#
# Copyright 2004,2005,2006 Nicola Worthington
@@ -29,9 +29,10 @@
use vars qw($VERSION @ISA);
use Carp qw(croak);
+use Data::Dumper;
require Sys::Filesystem::Unix;
-$VERSION = '1.25';
+$VERSION = '1.26';
@ISA = qw(Sys::Filesystem::Unix);
sub version()
@@ -70,11 +71,13 @@
{
croak "Unable to open fstab file ($args{fstab})\n";
}
+ print( STDERR Dumper( \$self ) );
unless ( $self->readMntTab( $args{mtab}, \@mtab_keys, [ 0, 1, 2 ], \%special_fs ) )
{
croak "Unable to open mtab file ($args{mtab})\n";
}
+ print( STDERR Dumper( \$self ) );
$self;
}
@@ -155,7 +158,7 @@
=head1 VERSION
-$Id: Solaris.pm 43 2009-10-30 20:00:31Z trevor $
+$Id: Solaris.pm 61 2010-02-12 14:36:11Z trevor $
=head1 AUTHOR
Modified: branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Unix.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Unix.pm?rev=52680&op=diff
==============================================================================
--- branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Unix.pm (original)
+++ branches/upstream/libsys-filesystem-perl/current/lib/Sys/Filesystem/Unix.pm Sat Feb 13 22:13:52 2010
@@ -1,6 +1,6 @@
############################################################
#
-# $Id: Unix.pm 43 2009-10-30 20:00:31Z trevor $
+# $Id: Unix.pm 61 2010-02-12 14:36:11Z trevor $
# Sys::Filesystem - Retrieve list of filesystems and their properties
#
# Copyright 2004,2005,2006 Nicola Worthington
@@ -30,7 +30,7 @@
use IO::File;
use vars qw($VERSION);
-$VERSION = '1.25';
+$VERSION = '1.26';
sub version()
{
@@ -344,7 +344,7 @@
=head1 VERSION
-$Id: Unix.pm 43 2009-10-30 20:00:31Z trevor $
+$Id: Unix.pm 61 2010-02-12 14:36:11Z trevor $
=head1 AUTHOR
Modified: branches/upstream/libsys-filesystem-perl/current/t/03test.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsys-filesystem-perl/current/t/03test.t?rev=52680&op=diff
==============================================================================
--- branches/upstream/libsys-filesystem-perl/current/t/03test.t (original)
+++ branches/upstream/libsys-filesystem-perl/current/t/03test.t Sat Feb 13 22:13:52 2010
@@ -2,45 +2,50 @@
use Test::More qw(no_plan);
use Sys::Filesystem;
-use constant DEBUG => $ENV{SYS_FILESYSTEM_DEBUG} ? 1 : 0;
-
my $fs = Sys::Filesystem->new();
ok( ref($fs) eq 'Sys::Filesystem', 'Create new Sys::Filesystem object' );
-my @mounted_filesystems;
-my @mounted_filesystems2;
- at mounted_filesystems = $fs->mounted_filesystems;
- at mounted_filesystems2 = $fs->filesystems( mounted => 1 );
+my @mounted_filesystems = $fs->mounted_filesystems();
+my @mounted_filesystems2 = $fs->filesystems( mounted => 1 );
ok( "@mounted_filesystems" eq "@mounted_filesystems2", 'Compare mounted methods' );
-#ok(my @unmounted_filesystems = $fs->unmounted_filesystems, 'Get list of unmounted filesystems');
-#ok(my @special_filesystems = $fs->special_filesystems, 'Get list of special filesystems');
-my @unmounted_filesystems = $fs->unmounted_filesystems;
-my @special_filesystems = $fs->special_filesystems;
+my @unmounted_filesystems = $fs->unmounted_filesystems();
+my @special_filesystems = $fs->special_filesystems();
-ok( my @regular_filesystems = $fs->regular_filesystems, 'Get list of regular filesystems' );
-ok( my @filesystems = $fs->filesystems, 'Get list of all filesystems' );
+my @regular_filesystems = $fs->regular_filesystems();
+my @filesystems = $fs->filesystems();
-for my $filesystem (@filesystems)
+SKIP:
{
- my $mounted = $fs->mounted($filesystem) || 0;
- my $unmounted = !$mounted;
- ok( $mounted == grep( /^$filesystem$/, @mounted_filesystems ), 'Mounted' );
- ok( $unmounted == grep( /^$filesystem$/, @unmounted_filesystems ), 'Unmounted' );
+ unless (@regular_filesystems)
+ {
+ skip('Badly poor supported OS or no file systems found.');
+ }
+ else
+ {
+ ok( @regular_filesystems, 'Get list of regular filesystems' );
+ ok( @filesystems, 'Get list of all filesystems' );
- my $special = $fs->special($filesystem) || 0;
- my $regular = !$special;
- ok( $special == grep( /^$filesystem$/, @special_filesystems ), 'Special' );
- ok( $regular == grep( /^$filesystem$/, @regular_filesystems ), 'Regular' );
+ for my $filesystem (@filesystems)
+ {
+ my $mounted = $fs->mounted($filesystem) || 0;
+ my $unmounted = !$mounted;
+ ok( $mounted == grep( /^$filesystem$/, @mounted_filesystems ), 'Mounted' );
+ ok( $unmounted == grep( /^$filesystem$/, @unmounted_filesystems ), 'Unmounted' );
- ok( my $device = $fs->device($filesystem), "Get device for $filesystem" );
- ok( my $options = $fs->options($filesystem), "Get options for $filesystem" );
- ok( my $format = $fs->format($filesystem), "Get format for $filesystem" );
- ok( my $volume = $fs->volume($filesystem) || 1, "Get volume type for $filesystem" );
- ok( my $label = $fs->label($filesystem) || 1, "Get label for $filesystem" );
+ my $special = $fs->special($filesystem) || 0;
+ my $regular = !$special;
+ ok( $special == grep( /^$filesystem$/, @special_filesystems ), 'Special' );
+ ok( $regular == grep( /^$filesystem$/, @regular_filesystems ), 'Regular' );
+
+ ok( my $device = $fs->device($filesystem), "Get device for $filesystem" );
+ ok( my $options = $fs->options($filesystem), "Get options for $filesystem" );
+ ok( my $format = $fs->format($filesystem), "Get format for $filesystem" );
+ ok( my $volume = $fs->volume($filesystem) || 1, "Get volume type for $filesystem" );
+ ok( my $label = $fs->label($filesystem) || 1, "Get label for $filesystem" );
+ }
+
+ my $device = $fs->device( $filesystems[0] );
+ ok( my $foo_filesystem = Sys::Filesystem::filesystems( device => $device ), "Get filesystem attached to $device" );
+ }
}
-
-my $filesystem = $filesystems[0];
-my $device = $fs->device( $filesystems[0] );
-
-ok( my $foo_filesystem = Sys::Filesystem::filesystems( device => $device ), "Get filesystem attached to $device" );
Modified: branches/upstream/libsys-filesystem-perl/current/t/04whereami.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsys-filesystem-perl/current/t/04whereami.t?rev=52680&op=diff
==============================================================================
--- branches/upstream/libsys-filesystem-perl/current/t/04whereami.t (original)
+++ branches/upstream/libsys-filesystem-perl/current/t/04whereami.t Sat Feb 13 22:13:52 2010
@@ -10,6 +10,7 @@
$RealPerl .= $Config{_exe}
unless $RealPerl =~ m/$Config{_exe}$/i;
}
+$RealTest = ucfirst($RealTest) if( $^O =~ m/Win32/ );
my $sfs = Sys::Filesystem->new();
ok( ref($sfs) eq 'Sys::Filesystem', 'Create new Sys::Filesystem object' );
More information about the Pkg-perl-cvs-commits
mailing list