view release on metacpan or  search on metacpan

bin/ls  view on Meta::CPAN

		*{'Getgrgid'} = sub { ($_[1], 0) };
		*{'Getpwuid'} = sub { ($_[1], 0) };
		}
	}

sub my_exit {
	my( $class, $code ) = @_;
	CORE::exit $code;
	}

sub warn_fh { \*STDERR }
sub my_warn {
	my( $class, $message, $prepend ) = @_;
	$prepend = 1 unless defined $prepend;
	$message = PROGRAM . ": " . $message if $prepend;
	print { $class->warn_fh } $message;
	}

sub output_fh { \*STDOUT }
sub output {
	my( $class, @messages ) = @_;
	print { $class->output_fh } @messages;
	}

sub _opts_string {
	#  macOS only                          *                  *
	#                  1ABCFGHILOPRSTUWabcdefghiklmnopqrstuvwxy%
	my $opts_string = '1A CF   L  RST Wa cd fg iklmnopqrstu wx';
	$opts_string =~ s/\s+//g;
	$opts_string;
	}

sub process_options {
	require Getopt::Std;

	my( $class, @args ) = @_;

	my $Options = {};

	my $Supported = $class->_supported_options;

	my %original_positions;
	foreach my $i ( 0 .. $#args ) {
		my $arg = $args[$i];
		last unless $arg =~ /\A-/;
		last if $arg eq '--';
		( my $letter = $arg ) =~ s/\A--?//;
		$original_positions{$letter} = $i;
		}

	return $class->VERSION_MESSAGE if exists $original_positions{'version'};
	return $class->usage(
		-verbose => 2,
		-output  => $class->error_fh,
		) if exists $original_positions{'help'};

	my $opts_string = $class->_opts_string;

	local $Getopt::Std::STANDARD_HELP_VERSION = 1;

	local @ARGV = @args;
	unless( Getopt::Std::getopts($opts_string, $Options) ) {
		$class->my_warn( "usage: " . PROGRAM . " [-$opts_string] [file ...]", 0 );
		$class->my_exit( EX_FAILURE );
		}
	@args = @ARGV;

	my %Defaults = ( w => $class->get_columns );

	foreach my $key ( keys %Defaults ) {
		next if defined $Options->{$key};
		$Options->{$key} = $Defaults{$key};
		}

	$Options->{'a'} = 1 if $Options->{'f'};

	unless( -t *STDOUT ) {
		$Options->{'1'} = 1 unless -t *STDOUT;
		}

	delete $Options->{'w'} if( defined $Options->{'w'} and  $Options->{'w'} == 0 );

=pod

The -1, -C, -x, and -l options all override each other; the last
one specified determines the format used.

The -c, -u, and -U options all override each other; the last one
specified determines the file time used.

The -S and -t options override each other; the last one specified
determines the sort order used.

The -B, -b, -w, and -q options all override each other; the last
one specified determines the format used for non-printable
characters.

The -H, -L and -P options all override each other (either
partially or fully); they are applied in the order specified.

=cut

	my @overrides = (
		[ qw(1 C x l) ],
		[ qw(c u U) ],   # -U not supported
		[ qw(S t) ],
		# [ qw(B b w q) ], # -B -b -w not supported
		# [ qw(H L P) ],   # -H -P not supported
		);

	@overrides = map {
		my @opts = @$_;
		[ grep { exists $Supported->{$_} } @opts ],
		} @overrides;

	foreach my $row ( @overrides ) {
		my @order =
			sort { $original_positions{$a} <=> $original_positions{$b} }
			grep { exists $Options->{$_} }
			@$row;
		my $last = $order[-1];