File Coverage

blib/lib/Data/CTable/Listing.pm

Criterion	Covered	Total	%
statement	24	209	11.4
branch	0	82	0.0
condition	0	40	0.0
subroutine	8	21	38.1
pod	0	7	0.0
total	32	359	8.9

#!/usr/bin/perl
## Emacs: -*- tab-width: 4; -*-

use strict;

package   Data::CTable::Listing;

use vars qw($VERSION);				$VERSION = '0.1';

=pod

=head1 NAME

Data::CTable::Listing - CTable holding file and directory listings

=head1 SYNOPSIS

	## Call from a shell script:
	use 	 Data::CTable::Listing;
	exit	!Data::CTable::Listing->script();

This is an OO implementation of the guts of the "tls" perl script that
comes with the Data::CTable distribution.

Please see Listing.pm for the full usage() message, or run the tls
perl script with the --help option.

=head1 FURTHER INFO

See the Data::CTable home page:

	http://christhorman.com/projects/perl/Data-CTable/

=head1 AUTHOR

Chris Thorman

Copyright (c) 1995-2002 Chris Thorman.  All rights reserved.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut
{};

use       Data::CTable::Script;  use vars qw(@ISA);
@ISA = qw(Data::CTable::Script);

sub usage_message
{
	my $this = shift();
	my ($ScriptName) = @_;

	return(do{(my $doc = << 'END') =~ s/_SCR_/$ScriptName/g; $doc});

_SCR_ [path path path...] [options]

_SCR_ is a command-line tool similar to the Unix "ls" (directory
listing) command.  It should run on any platform that has perl.

It uses Data::CTable (Data::CTable::Listing sublcass) and
Data::ShowTable to build in memory a table of information about
specified files and directories and then output it to the console or a
file.

Each command line path must be either a file or directory to be
included in the listing.

If no paths are specified at all, the current directory is assumed.

For each path argument that is a directory, an entry for each file in
that directory will also be included in the listing unless the
--nochildren option is specified.  (You may suppress the top-level
item itself by specifying --notop).  Other than the default single
level of children listed, recursion is not done unless you specify
--recurse.

Options may appear in any order, before, after, or intermixed with the
path arguments.  See below for options.

In addition to the Path field which contains the absolute or relative
path name of each listed item, _SCR_ also derives a number of
additional fields which you may include in the listing.

Available fields are:

    Main path field:

	Path         Absolute or relative path of specified item

    Fields from stat($Path) (see --fields, --all, or --info):

	Device   0 dev     device number of filesystem
	INode    1 ino     inode number
	Mode     2 mode    file mode  (type and permissions)
	NLink    3 nlink   number of (hard) links to the file
	UID      4 uid     numeric user ID of file's owner
	GID      5 gid     numeric group ID of file's owner
	RDev     6 rdev    the device identifier (special files only)
	Size     7 size    total size of file, in bytes
	ATime    8 atime   last access time in seconds since the epoch
	MTime    9 mtime   last modify time in seconds since the epoch
	CTime   10 ctime   inode change time (NOT creation time)
	BlkSize 11 blksize preferred block size for file system I/O
	Blocks  12 blocks  actual number of blocks allocated

    Fields from localtime($MTime) (see --fields, --all, or --localtime):
                                  (see man ctime or struct tm):

	Sec   0 tm_sec   The number of seconds after the minute, normally in
	                 the range 0 to 59, but can be up to 61 to allow for
	                 leap seconds.
	Min   1 tm_min   The number of minutes after the hour, in the range 0 to 59.
	Hour  2 tm_hour  The number of hours past midnight, in the range 0 to 23.
	Day   3 tm_mday  The day of the month, in the range 1 to 31.
	TMon  4 tm_mon   The number of months since January, in the range 0 to 11.
	TYear 5 tm_year  The number of years since 1900 (range   69 to  138)
	WDay  6 tm_wday  The number of days since Sunday, in the range 0 to 6.
	YDay  7 tm_yday  The number of days since January 1, in the range 0 to 365.
	IsDST 8 tm_isdst A flag that indicates whether daylight saving
	                 time is in effect at the time described.  The
	                 value is positive if daylight saving time is in
	                 effect, zero if it is not, and negative if the
	                 information is not available.

    Fields from File::Basename (see --fields, --all, or --base):

	Dir        Directory component of Path
	Base       Base component of file name (without the Ext)
	Ext        Extension (any non-. characters after last . plus the . itself)

    Other derived fields (see --fields, --all, or --derived):

	File       Filename component of Path (= Base + Ext)
	Type       File or directory

	Perms      Permissions (from Mode), specified as an octal string
	Owner      Unix owner name: getpwuid(UID) (empty on Win)
	Group      Unix owner name: getgrgid(GID) (empty on Win)

	Mon        TMon  + 1                          (range    1 to   12)
	Year       TYear + 1900                       (range 1900 to 2038)

	RTime      ModTime as human-readable string (localtime(MTIME)."")
	Stamp      String-sortable semi-numeric time stamp (based on MTIME)

Field names are always built and output using mixed-case as indicated.

However, case is ignored by the --fields or --sort options (you may
specify the field names in all lower-case, for example).  You may also
specify any shorter form of any field name as long as it is not
ambiguous.  (For example "fi" for File or "pa" for Path.)

Available command-line options are:

    Miscellaneous
    -------------

	Ignore all other options and print this help message instead.

	--help
	-h

	Don't turn off progress() calls in the table.

	--verbose
	-v


    Controlling files (rows) included in listing
    --------------------------------------------

	Don't include children of specified directories.

	--nochildren
	--nochild
	--noc

	Don't list specified directories themselves (but do list their
	children unless --noc).

	--notop
	--not

	Recursively include all sub-directories in listings (overrides
	--nochildren).

	--recurse
	-r

	Restrict listing to only directories (d) or files (f).

	--type=d
	-ty=d

	--type=f
	-ty=f


    Setting which fields (columns) to include in output
    ---------------------------------------------------

	Use the options below to specify the fields to be listed in the
	output table, in order.  If no fields are specified, the following
	fields will be used:

	Path Owner Group Size RTime  (except Path when --nopath)

	--fields f1,f2
	--field f1 --field f2
	-f=f1,f2,f3
	-f="f1 f2 f3"

	Force all available fields to be included in output (overrides --fields).

	--all
	-a

	Force all localtime-derived fields to be included in output (adds
	any not yet specified in --fields).

	--localtime
	-l

	Force all stat-derived fields to be included in output (adds
	any not yet specified in --fields).

	--info
	-i

	Force all File::Basename-derived fields to be included in output
	(adds any not yet specified in --fields).

	--base
	-b

	Force all other derived fields to be included in output.

	--derived
	-de

	Don't automatically put the Path as first field in output (but do
	include it if no other fields are specified).

	--nopath
	--nop


    Sort order
    ----------

	Specify ordered list of field names to use to sort and sub-sort
	the output.

	--sort f1 --sort f2
	--sort f1,f2
	-s=f1,f2,f3
	-s="f1 f2 f3"

	If none are specified, the table is sorted ascending by Path.

	In fact, Path is always the LAST field in the sort order, whether
	you specify it explicity or not.  This guarantees that the sort
	order is always unambiguous since no two items will have the same
	Path.

	In the sort order, each field will be sorted ascending unless a
	"+" is appended to its name (mnemonic: + sorts highest items
	first).  For example:

	-s=Size+
	-s=WDay+,Size+

    Controlling the output method and its arguments
    --------------------------------------------

	Specify name of method Data::CTable::Listing method to call in
	order to output data, and any arguments to that method, separated
	by commas, spaces or by multiple --output or -o options, .

	Default is the "format" method, which prints a table using the
	Data::ShowTable, which of course must be installed to work.

	The write() method is another alternative.  With no arguments, it
	will write to STDOUT (and may be redirected to a file or other
	script). With a single argument, it will write to a file by that
	name.  Multiple arguments are processed as named-parameter
	arguments; and any documented named-parameter option to
	Data::CTable::write() may be specified this way.

	Note: the default delimiter character for write() is comma.  To
	get tab-delimited output, see the --tabs option below.

	--output=write
	-o=write,foo.txt
	-o=write,_FileName,foo.txt,_LineEnding,mac,HeaderRow,0

	Shortcut to specify using the write method to write to STDOUT.
	This is equivalent to "-o=write".

	--write
	-w

	Specify tab-delimited output.  This forces the "write" method
	instead of the "format" method to be used to output the table.

	This is equivalent to specifying '--output=write,_FDelimiter,"\t"'
	except it's briefer and easier to get your shell script to accept
	it.

	--tabs
	-ta

	Suppress a header row showing field names.  This forces the
	"write" method instead of the "format" method to be used to output
	the table.

	This is equivalent to specifying '--output=write,_HeaderRow,0'.

	--noheader
	-noh

	Specify line-endings.  Endings by default will be whatever "\n" is
	on the current system.  To force them, specify one of the
	following options.  These options force the "write" method and are
	equivalent to specifying equivalent to specifying
	'--output=write,_LineEnding,mac', ...unix, ...dos, etc.

	--mac
	-m
	--unix
	-u
	--dos
	-do

This script is part of the Data::CTable distribution.

Most of the script's work is done by the subclassed CTable object in
Data::CTable::Lister.

You can use or subclass Data::CTable::Lister directly if you'd like to
use any aspect of this script's functionality in your own perl tools.

See that module for detailed documentation of this script's behavior,
including the usage() message that prints when --help is requested.

Copyright (c) 1995-2002 Chris Thorman.  All rights reserved.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

See Data::CTable home page for further info:

	http://christhorman.com/projects/perl/Data-CTable/

END
{};
}

sub optionspec
{
	my $Class	= shift;

	my $Spec	= {(
					##### Common options from the parent class..

					%{$Class->SUPER::optionspec},

					##### Listed here for redundancy...

					## Common options
					"help"			=>	0 ,
					"verbose"		=>	0 ,

					## Filtd list
					"fields=s"		=>	[],

					## Sorting
					"sort=s"		=>	[],

					## Output method
					"output=s"		=>	[],

					##### Plus the following options unique to this script:

					## Data::CTable::Listing-specific options

					# Options controlling which files are listed
					"notop"				=>		0,
					"nochildren"		=>		0,
					"recurse"			=>		0,
					"type=s"			=>		"",

					# Options controlling which fields are shown
					"all"				=>		0,
					"localtime"			=>		0,
					"info"				=>		0,
					"base"				=>		0,
					"derived"			=>		0,
					"nopath"			=>		0,

					# Output options
					"write"				=>		0,
					"tabs"				=>		0,
					"noheader"			=>		0,
					"mac"				=>		0,
					"unix"				=>		0,
					"dos"				=>		0,

					)};

	return($Spec);
}

=pod

=head1 METHODS

	$Class->run()

Main entry point for the "tls" or "tls.pl" script included with the
Data::CTable distribution.

=cut
{};

sub run
{
	my $Class			= shift;
	my ($Opts)			= @_;

	use Data::CTable qw(path_info);

	## Create an empty options hash in case we didn't get one.
	$Opts	||= {};

	## Find the paths and create a new file table using them.
	my $this = $Class->make_file_table($Opts);

	## Run the appropriate output method.
	return($this->make_output());
}

=pod


	$Class->make_file_table()

Instantiates a table object, gets and inserts file listing and other
fields, processes user's arguments, and generates output.

=cut
{};

sub make_file_table
{
	my $Class			= shift;
	my ($Opts)	= @_;

	use Data::CTable qw(min max);

	## Make a table...
	##	Default sort order is by path
	##  Path sort is done as Text (case-insensitive)
	##  All other fields sorted (and justified) as Integer by default
	##  Max column width is max path length
	##  Silent sorting
	##  Path field is all paths specified
	##  Fields S00..S12 contain results of calling stat()

	my $t = $Class->new
	({
		(		_SortOrder			=>	[qw(Path)]),
		(		_SortSpecs			=>	{(	 (Path	=> {SortType=>'Text'  }),

											 (File	=> {SortType=>'String'}),
											 (Type	=> {SortType=>'String'}),

											 (Dir	=> {SortType=>'String'}),
											 (Base	=> {SortType=>'String'}),
											 (Ext	=> {SortType=>'String'}),

											 (Perms	=> {SortType=>'String'}),
											 (Owner	=> {SortType=>'String'}),
											 (Group	=> {SortType=>'String'}),

											 (RTime	=> {SortType=>'String'}),
											 (Stamp	=> {SortType=>'String'}),

											 )}),
		(		_DefaultSortType	=>	'Integer'),
		($Opts->{verbose} ? () :
		 (		_Progress			=>	0)),
		(		_Opts				=>	$Opts),
		(		Path				=>	[]),
	});

	## Print a progress mess that will be ignored unless we're in verbose mode.
	$t->progress("Searching...");

	## Expand/filter, etc. the caller's specified paths and/or glob
	## expressions.
	my $Paths = $Class->process_path_args($Opts);

	## Find longest file path.
	my $Longest; foreach (@$Paths) {$Longest = max($Longest, length)};

	## Set the MaxWidth to something that will accommodate all
	## possible fields (longer of path, RTime)

	$t->{_MaxWidth}			=	max(25, $Longest);	## 25 = allow for RTime field

	## Set the Path column
	$t->col(Path => $Paths);

	## Build the "stat" fields...
	foreach my $FNum (-1..$#$Paths)
	{
		## Get stats for the file...
		my $Stats = [stat($Paths->[$FNum])];
		foreach my $n ('00'..'12')
		{
			## First time through (and only time through if no records
			## present), just make the columns.
			$t->col("S$n"), next if $FNum == -1;

			## Fill stat values into pre-sized vectors in the table.
			$t->col("S$n")->[$FNum] = $Stats->[$n];
		}
	}

	## Fix the order of Path, S00..S12 fields.
	$t->fieldlist_freeze();

	## Change some field names.
	$t->col_rename(qw(	S00	Device
						S01	INode
						S02	Mode
						S03	NLink
						S04	UID
						S05	GID
						S06	RDev
						S07	Size
						S08	ATime
						S09	MTime
						S10	CTime
						S11	BlkSize
						S12	Blocks
						));

	## Build the "localtime" fields...
	my $Times = $t->col('MTime');
	foreach my $FNum (-1..$#$Times)
	{
		## Get stats for the file...
		my $TInfo = [localtime($Times->[$FNum])];
		foreach my $n ('00'..'08')
		{
			## First time through (and only time through if no records
			## present), just make the columns.
			$t->col("T$n"), next if $FNum == -1;

			## Fill stat values into pre-sized vectors in the table.
			$t->col("T$n")->[$FNum] = $TInfo->[$n];
		}
	}

	## Change some field names.
	$t->col_rename(qw(	T00	Sec
						T01	Min
						T02	Hour
						T03	Day
						T04	TMon
						T05	TYear
						T06	WDay
						T07	YDay
						T08	IsDST
						));

	## Build the "basename" fields...
	foreach my $FNum (-1..$#$Paths)
	{
		## Get stats for the file...
		use File::Basename qw(fileparse);
		my $FInfo = [(fileparse($Paths->[$FNum], '\.[^\.]+'))[1,0,2]]
			unless $FNum == -1;

		foreach my $n ('00'..'02')
		{
			## First time through (and only time through if no records
			## present), just make the columns.
			$t->col("F$n"), next if $FNum == -1;

			## Fill stat values into pre-sized vectors in the table.
			$t->col("F$n")->[$FNum] = $FInfo->[$n];
		}
	}

	## Change some field names.
	$t->col_rename(qw(	F00	Dir
						F01	Base
						F02	Ext
						));

	## Add a column showing the full file name.
	$t->col(File => $t->calc(sub{"$main::Base$main::Ext"}));
	$t->col(Type => $t->calc(sub{-d $main::Path ? "D" : "F"}));

	## Add a Perms field showing permission component of (stat)[2]
	## formatted as a 4-digit octal number.

	$t->col(Perms => [map {sprintf("%04o", $_ & 0777)} @{$t->col('Mode')}]);

	## Add columns translating the UID and GID into their string form.

	$t->col(Owner => [map {((eval{getpwuid($_)})[0])   } @{$t->col('UID' )}]);
	$t->col(Group => [map {((eval{getgrgid($_)})[0])   } @{$t->col('GID' )}]);

	## Add a column showing the full file name.
	$t->col(Mon  => $t->calc(sub{$main::TMon  +    1}));
	$t->col(Year => $t->calc(sub{$main::TYear + 1900}));

	## Add some time stamps -- one human-readable and one computer-sortable.
	$t->col(RTime => $t->calc(sub{localtime($main::MTime).""}));
	use POSIX;
	$t->col(Stamp => $t->calc(sub{strftime("%Y%m%d%H%M%S", localtime($main::MTime))}));

	return($t);
}

=pod

	$Class->process_path_args()

Generates the file listing by interpreting the file-related
command-line options.

=cut
{};

sub process_path_args
{
	my $Class			= shift;
	my ($Opts)			= @_;

	## Get the paths option.
	my $Paths = $Opts->{args};

	## Get details about paths on the current platform
	my ($Sep, $Up, $Cur) = @{path_info()}{qw(sep up cur)};

	## Default file list is the current directory.
	$Paths	= [$Cur] unless (ref($Paths) eq 'ARRAY') && @$Paths;

	## Glob the paths to support shell-like wildcards on all
	## platforms or when calling from a script.

	$Paths = [map {my $x=[glob $_]; @$x ? @$x : $_} @$Paths];

	## Validate / canonicalize path arguments.
	$Paths = [map
			  {
				  ## Ensure trailing $Sep on dir names
				  ($_) =~ s{([^\Q$Sep\E])$ }{$1$Sep}ox if -d;

				  ## Filter/warn re: existence of items we're going to list
				  (-e $_ ?
				   $_ :
				   do{$Class->warn("No such file or directory '$_'"); ()});

			  } @$Paths];

	my $Recurse		= $Opts->{recurse};
	my $NoTop		= $Opts->{notop};
	my $NoChildren	= $Opts->{nochildren} && !$Recurse;
	my $Type		= $Opts->{type};

	## Expand directory paths into their constituent components.
	$Paths	= [map
			   {
				   my $Path = $_;
				   (-d $Path ?

					## Get a listing with $Path prepended to each element
					@{$Class->list_dir($Path, $Sep, $Cur, $Recurse, $NoTop, $NoChildren)} :

					## Otherwise it's just a bare file name.
					$Path
					);
			   } @$Paths];

	$Paths	= [grep {-d} @$Paths] if $Type eq 'd';
	$Paths	= [grep {-f} @$Paths] if $Type eq 'f';

	return($Paths);
}

=pod

	$t->make_output()

Parses and processes the sorting, fieldlist, and output options, then
calls the appropriate output method.  Returns the scalar buffer
reference returned by that method, if any; otherwise a ref to an empty
buffer.

=cut
{};

sub make_output
{
	my $this			= shift;

	## Assume parsed Opts have been stored in the object in the _Opts slot.
	my $Opts			= $this->{_Opts}	|| {};

	## Retrieve various output options
	my $Write		= $Opts->{write};
	my $Tabs		= $Opts->{tabs};
	my $Mac			= $Opts->{mac}	&& 'mac';
	my $Unix		= $Opts->{unix}	&& 'unix';
	my $Dos			= $Opts->{dos}	&& 'dos';
	my $NoHeader	= $Opts->{noheader};

	## Retrieve the output --fields and --sort fields requested by the user.
	my $Fields	  		= $Opts->{fields}	|| [];
	my $Sorts	  		= $Opts->{sort  }	|| [];

	## First extract the specified sort directions into a hash so we can pull them in later.
	my $SortDirs		= {}; @$SortDirs{map {(/(\w+)/)[0]} @$Sorts} = map {(/\w+(\W)/)[0]} @$Sorts;
	my $Sorts			= [map {(/(\w+)/)[0]} @$Sorts];

	## Allow for weird casing in the user's field lists...
	my $FieldsAll		= $this->fieldlist_all();
	my $FieldCaseMap	= {}; @$FieldCaseMap {map {lc} @$FieldsAll} = @$FieldsAll;

	## Allow for shortened but unambiguous forms of field names to be used.
	foreach my $Field (@$FieldsAll)
	{
		foreach (1..length($Field) - 1)
		{
			my $Str = lc(substr($Field, 0, $_));
			(exists($FieldCaseMap->{$Str}) ?
			 (delete $FieldCaseMap->{$Str}) :		## Existing therefore ambiguous; disallow
			 (       $FieldCaseMap->{$Str} = $Field));	## Not existing; add.
		}
	}

	## Map all the field names...
	$Fields	= [map {(exists($FieldCaseMap->{lc($_)}) ?
					 $FieldCaseMap->{lc($_)} :
					 do{$this->warn("Unrecognized output field name (ignored): $_"); ()})} @$Fields];

	## Map all the sort field names...
	$Sorts	= [map {(exists($FieldCaseMap->{lc($_)}) ?
					 $FieldCaseMap->{lc($_)} :
					 do{$this->warn("Unrecognized sort field name (ignored): $_"); ()})} @$Sorts];

	@$SortDirs{@$FieldCaseMap{keys %$SortDirs}} = values %$SortDirs;

	## Add additional fields as requested.

	my $InfoFields = [qw(	Device
							INode
							Mode
							NLink
							UID
							GID
							RDev
							Size
							ATime
							MTime
							CTime
							BlkSize
							Blocks
							)];

	my $TimeFields = [qw(	Sec
							Min
							Hour
							Day
							TMon
							TYear
							WDay
							YDay
							IsDST
							)];

	my $BaseFields = [qw(	Dir
							Base
							Ext)];

	my $DervFields = [qw(	File
							Type
							Perms
							Owner
							Group
							Mon
							Year
							RTime
							Stamp
							)];

	push @$Fields, @$InfoFields												if $Opts->{info};
	push @$Fields, @$TimeFields												if $Opts->{localtime};
	push @$Fields, @$BaseFields												if $Opts->{base};
	push @$Fields, @$DervFields												if $Opts->{derived};
	push @$Fields, (@$InfoFields, @$TimeFields, @$BaseFields, @$DervFields)	if $Opts->{all};

	## If the field list is empty, populate it.
	$Fields	= [($Opts->{nopath} ? () : 'Path'), qw(Owner Group Size RTime)] unless @$Fields;

	## If the field list doesn't include "Path" already, then prepend
	## it unless --nopath was specified
	unshift @$Fields, 'Path' unless ((grep {$_ eq 'Path'} @$Fields) || (@$Fields && $Opts->{nopath}));

	## After adding in the above field groups, remove any duplicates
	my $Fs = {}; $Fields = [grep {$Fs->{$_}++ ? () : $_} @$Fields];

	## If the sort list doesn't include "Path" already, then append it.
	push @$Sorts, 'Path' unless grep {$_ eq 'Path'} @$Sorts;

	## Add a sort-direction specifier to the table for each field
	## based on the + signs we got or didn't get in the --sort fields
	## list.

	foreach my $Field (@$Sorts)
	{
		$this->sortspec($Field, {%{$this->sortspec($Field)},
								 SortDirection =>
									 ($SortDirs->{$Field} eq '+' ? -1 : 1)});
	}

	## die $this->dump($Sorts, $FieldCaseMap, $SortDirs, $this->sortspecs());

	## Sort the table.
	$this->sortorder($Sorts);
	$this->sort();

	## Set the field list for output.
	$this->fieldlist($Fields);

	## Process the output method
	my $OutputArgs	= $Opts->{output};	## Already an array ref
	my $Method		= shift @$OutputArgs || "format";

	## If "write" was specified, then we're going to force the "write"
	## method.  The FileName "-" (meaning STDOUT) will override any
	## other name that may have been redundantly specified with
	## -o=write.

	if ($Write)
	{
		$Method		= "write";
		unshift @$OutputArgs, "_FileName" if @$OutputArgs == 1;
		push @$OutputArgs, (_FileName => "-");
	}

	## If "tabs" was specified, then we're going to force the "write" method
	if ($Tabs)
	{
		$Method		= "write";
		unshift @$OutputArgs, "_FileName" if @$OutputArgs == 1;
		push @$OutputArgs, (_FDelimiter => "\t");
	}

	if ($NoHeader)
	{
		$Method		= "write";
		unshift @$OutputArgs, "_FileName" if @$OutputArgs == 1;
		push @$OutputArgs, (_HeaderRow => 0);
	}

	if ($Mac || $Unix || $Dos)
	{
		$Method		= "write";
		unshift @$OutputArgs, "_FileName" if @$OutputArgs == 1;
		push @$OutputArgs, (_LineEnding => ($Mac || $Unix || $Dos));
	}

	## Do the output.
	my $Result		= $this->$Method(@$OutputArgs);


	return(ref($Result) eq 'SCALAR' ? $Result : \ '');
}

=pod

	## Class-level utility method
	$Class->list_dir($Path, $Sep, $Cur, $Recurse, $NoTop, $NoChildren)

Platform-neutral recursive directory lister routine.

Caller must supply $Sep (platform's separator character) and $Cur
(platform's string meaning "current directory").

If $Dir is empty/undef, then $Cur will be used as the starting point.

$Recurse means recurse to list subdirectories.

$NoTop means don't include $Dir itself in the listing.

$NoChildren means don't include children of $Dir.  This option is
ignored if $Recurse is true.

=cut

sub list_dir
{
	my $Class												= shift;
	my ($Dir, $Sep, $Cur, $Recurse, $NoTop, $NoChildren)	= @_;

	my $Names	= [];

	## Ensure trailing $Sep on path given by user.
	($Dir ||= $Cur) =~ s{([^\Q$Sep\E])$ }{$1$Sep}ox;

	my $D		= \*DIR;	## We like file handle references.

	opendir($D, $Dir)
		or $Class->warn("Can't open directory $Dir: $!"), goto done;

	$Names		= [($NoTop		? () : $Dir),	## Include $Dir itself in listing.
				   ($NoChildren	? () :
					map  {my  $Sub = "$Dir$_";
						  (-d $Sub ?
						   ("$Sub$Sep",
							($Recurse ?
							 @{$Class->list_dir($Sub, $Sep, $Cur, $Recurse, 'NoTop')} :
							 ())) :
						   $Sub)}
					grep {!/^\.\.?$/} 	## Omit . and .. entries.
					readdir($D))];
	closedir $D;

  done:
	return($Names);
}

1;