File Coverage

blib/lib/File/DirList.pm

Criterion	Covered	Total	%
statement	37	38	97.3
branch	6	8	75.0
condition	8	12	66.6
subroutine	6	6	100.0
pod	2	2	100.0
total	59	66	89.3

package File::DirList;

use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use File::DirList ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(

);

our $VERSION = '0.05';

use DirHandle;
use Cwd;

my %sortSubs = ();

$sortSubs{'s'} = sub {    $_[0]->[7]   <=>    $_[1]->[7];   };
$sortSubs{'S'} = sub {    $_[1]->[7]   <=>    $_[0]->[7];   };
$sortSubs{'a'} = sub {    $_[0]->[8]   <=>    $_[1]->[8];   };
$sortSubs{'A'} = sub {    $_[1]->[8]   <=>    $_[0]->[8];   };
$sortSubs{'m'} = sub {    $_[0]->[9]   <=>    $_[1]->[9];   };
$sortSubs{'M'} = sub {    $_[1]->[9]   <=>    $_[0]->[9];   };
$sortSubs{'c'} = sub {    $_[0]->[10]  <=>    $_[1]->[10];  };
$sortSubs{'C'} = sub {    $_[1]->[10]  <=>    $_[0]->[10];  };
$sortSubs{'n'} = sub {    $_[0]->[13]  cmp    $_[1]->[13];  };
$sortSubs{'N'} = sub {    $_[1]->[13]  cmp    $_[0]->[13];  };
$sortSubs{'i'} = sub { uc($_[0]->[13]) cmp uc($_[1]->[13]); };
$sortSubs{'I'} = sub { uc($_[1]->[13]) cmp uc($_[0]->[13]); };
$sortSubs{'d'} = sub {    $_[1]->[14]  <=>    $_[0]->[14];  };
$sortSubs{'D'} = sub {    $_[0]->[14]  <=>    $_[1]->[14];  };


my $statFile = sub
	{
	return [lstat($_[0].'/'.$_[1]),
		    $_[1],
		    (-d _ ? (($_[1] eq '..') ? 2 : (($_[1] eq '.') ? 3 : 1)) : 0),
		    0,
		    undef
		   ];
	};

my $statLink = sub
	{
	my $res = &{$statFile}(@_);

	if (-l _)
		{
		$res->[16] = readlink($_[0].'/'.$_[1]);
		if (-e $res->[16])
			{
			$res->[15] = 1;
			(@{$res}[0..12]) = stat(_);
			$res->[14] = -d _;
			$res->[15] = 1;
			}
		else
			{
			$res->[15] = -1;
			};
		};
	return $res;
	};

sub sortList($$)
	{
	my @sortMode = split(//, $_[1]);
	my @result = sort {my $r = 0;
	                   foreach my $m (@sortMode)
	                       {
	                       if (($r = &{$sortSubs{$m}}($a, $b)) != 0)
	                           { last; };
	                       };
	                   $r;
	                  } @{$_[0]};

	return \@result;
	};

sub list($$@)
	{
	my ($dirName, $sortMode, $noLinks, $hideDotFiles, $showSelf) = @_;

	my @list  = ();

	my $d = DirHandle->new($dirName);

	if (!defined($d))
		{ return undef; };

	my $cwd = getcwd;
	chdir($dirName);

	my $statSub = $noLinks ? $statFile : $statLink;

	while (defined(my $entry = $d->read()))
		{
		if ((($entry eq '.') && !$showSelf) || ($hideDotFiles && ($entry =~ m/^\../) && ($entry ne '..')))
			{ next; };

		push(@list,  &{$statSub}($dirName, $entry));
		};

	undef $d;

	chdir($cwd);

	return sortList(\@list, $sortMode);
	};

# Preloaded methods go here.

1;
__END__