#!/usr/bin/perl
my
$Program
= basename($0);
my
@perms
=
qw(--- --x -w- -wx r-- r-x rw- rwx)
;
my
@ftype
=
qw(. p c ? d ? b ? - ? l ? s ? ? ?)
;
$ftype
[0] =
''
;
sub
get_columns {
my
@methods
=
qw(windows unix default)
;
foreach
my
$m
(
@methods
) {
my
$cols
= __PACKAGE__->can(
$m
)->();
next
unless
defined
$cols
;
return
$cols
;
}
}
sub
windows {
return
unless
$^O eq
'MSWin32'
;
my
@lines
= `powershell -command
"&{(get-host).ui.rawui.WindowSize;}"
`;
while
(
my
$l
=
shift
@lines
) {
last
if
$l
=~ /\A-----/ }
return
$lines
[0] =~ m/\A\s*(\d+)/ ? $1 : ();
}
sub
unix {
return
if
$^O eq
'MSWin32'
;
my
$c
=
do
{
if
(
has
(
'tput'
) ) { `tput cols` }
elsif
(
has
(
'ssty'
) ) { `stty size | cut -d
' '
-f 2` }
else
{
undef
};
};
chomp
$c
;
return
$c
;
}
sub
default
{ 80 }
sub
has
{
my
$program
=
shift
;
foreach
my
$dir
(
split
/\Q
$Config
{path_sep}/,
$ENV
{PATH} ) {
next
unless
-x catfile(
$dir
,
$program
);
return
1;
}
return
;
}
sub
format_mode {
my
$mode
=
shift
;
my
%opts
=
@_
;
my
$setids
= (
$mode
& 07000)>>9;
my
@permstrs
=
@perms
[(
$mode
&0700)>>6, (
$mode
&0070)>>3,
$mode
&0007];
my
$ftype
=
$ftype
[(
$mode
& 0170000)>>12];
if
(
$setids
) {
if
(
$setids
& 01) {
$permstrs
[2] =~ s/([-x])$/$1 eq
'x'
?
't'
:
'T'
/e;
}
if
(
$setids
& 04) {
$permstrs
[0] =~ s/([-x])$/$1 eq
'x'
?
's'
:
'S'
/e;
}
if
(
$setids
& 02) {
$permstrs
[1] =~ s/([-x])$/$1 eq
'x'
?
's'
:
'S'
/e;
}
}
join
''
,
$ftype
,
@permstrs
;
}
my
$Arg
=
""
;
my
$ArgCount
= 0;
my
$Attributes
=
""
;
my
%Attributes
= ();
my
%DirEntries
= ();
my
$Getgrgid
=
""
;
my
$Getpwuid
=
""
;
my
@Dirs
= ();
my
@Files
= ();
my
$First
= 1;
my
$Maxlen
= 1;
my
$Now
=
time
;
my
%Options
= ();
my
$SixMonths
=
60*60*24*(365/2);
my
$VERSION
=
'0.70'
;
my
$WinCols
;
eval
{
my
$dummy
=
""
;
$dummy
= (
getpwuid
(0))[0] };
if
($@) {
$Getpwuid
=
sub
{
return
(
$_
[0], 0); };
$Getgrgid
=
sub
{
return
(
$_
[0], 0); };
}
else
{
$Getpwuid
=
sub
{
return
getpwuid
(
$_
[0]); };
$Getgrgid
=
sub
{
return
getgrgid
(
$_
[0]); };
}
sub
DirEntries {
my
$Options
=
shift
;
my
$dh
;
my
%Attributes
= ();
my
@Entries
= ();
my
$Name
=
""
;
if
(!
opendir
(
$dh
,
$_
[0]) ||
exists
(
$Options
{
'd'
})) {
if
(-e
$_
[0]) {
closedir
(
$dh
)
if
(
defined
(
$dh
));
push
(
@Entries
,
$_
[0]);
$Attributes
{
$_
[0]} =
stat
(
$_
[0]);
push
(
@Entries
, \
%Attributes
);
return
@Entries
;
}
warn
"$Program: can't access '$_[0]': $!\n"
;
return
();
}
while
(
$Name
=
readdir
(
$dh
)) {
next
if
(!
exists
(
$Options
->{
'a'
}) &&
$Name
=~ m/^\./o);
push
(
@Entries
,
$Name
);
$Attributes
{
$Name
} =
stat
( File::Spec->catfile(
$_
[0],
$Name
) );
}
closedir
(
$dh
);
push
(
@Entries
, \
%Attributes
);
return
@Entries
;
}
sub
EntryFormat {
my
$Options
=
shift
;
my
$Attributes
=
shift
;
my
$Entry
=
shift
;
my
$Blocks
= 0;
my
$BlockSize
=
exists
(
$Options
->{
'k'
}) ? 2 : 1;
my
$DateStr
=
""
;
my
$Gid
= -1;
my
$Mode
=
""
;
my
@Month
= (
"Jan"
,
"Feb"
,
"Mar"
,
"Apr"
,
"May"
,
"Jun"
,
"Jul"
,
"Aug"
,
"Sep"
,
"Oct"
,
"Nov"
,
"Dec"
);
my
$Time
= 0;
my
$Uid
= -1;
my
$sec
= 0;
my
$min
= 0;
my
$hour
= 0;
my
$mday
= 0;
my
$mon
= 0;
my
$year
= 0;
my
$wday
= 0;
my
$yday
= 0;
my
$isdst
= 0;
if
(
exists
(
$Options
->{
'i'
})) {
if
(
defined
(
$Attributes
->{
$Entry
})) {
printf
(
"%10d "
,
$Attributes
->{
$Entry
}->ino);
}
else
{
print
"_________ "
;
}
}
if
(
exists
(
$Options
->{
's'
})) {
if
(
defined
(
$Attributes
->{
$Entry
})) {
$Blocks
=
$Attributes
->{
$Entry
}->blocks;
if
(
$Blocks
eq
''
) {
$Blocks
= 0;
}
printf
(
"%4d "
,
$Blocks
/
$BlockSize
+
((
$Blocks
%
$BlockSize
)
> 0));
}
else
{
print
"____ "
;
}
}
if
(!
exists
(
$Options
->{
'l'
})) {
print
"$Entry\n"
;
}
else
{
if
(!
defined
(
$Attributes
->{
$Entry
})) {
print
<<UNDEFSTAT;
__________ ___ ________ ________ ________ ___ __ _____
UNDEFSTAT
}
else
{
$Mode
=
format_mode(
$Attributes
->{
$Entry
}->mode);
print
"$Mode "
;
printf
(
"%3d "
,
$Attributes
->{
$Entry
}->nlink);
if
(
exists
(
$Options
->{
'n'
})) {
printf
(
"%-8d "
,
$Attributes
->{
$Entry
}->uid);
}
else
{
$Uid
=
&$Getpwuid
(
$Attributes
->{
$Entry
}->uid);
if
(
defined
(
$Uid
)) {
printf
(
"%-8s "
,
$Uid
);
}
else
{
printf
(
"%-8d "
,
$Attributes
->{
$Entry
}->uid);
}
}
if
(
exists
(
$Options
->{
'n'
})) {
printf
(
"%-8d "
,
$Attributes
->{
$Entry
}->gid);
}
else
{
$Gid
=
&$Getgrgid
(
$Attributes
->{
$Entry
}->gid);
if
(
defined
(
$Gid
)) {
printf
(
"%-8s "
,
$Gid
);
}
else
{
printf
(
"%-8d "
,
$Attributes
->{
$Entry
}->gid);
}
}
if
(
$Attributes
->{
$Entry
}->mode & 0140000) {
printf
(
"%9d "
,
$Attributes
->{
$Entry
}->size);
}
else
{
printf
(
"%4x,%4x "
,
((
$Attributes
->{
$Entry
}->dev
& 0xFFFF000) > 16),
$Attributes
->{
$Entry
}->dev
& 0xFFFF);
}
$Time
=
$Attributes
->{
$Entry
}->mtime;
if
(
exists
(
$Options
->{
'c'
})) {
$Time
=
$Attributes
->{
$Entry
}->ctime;
}
if
(
exists
(
$Options
->{
'u'
})) {
$Time
=
$Attributes
->{
$Entry
}->atime;
}
(
$sec
,
$min
,
$hour
,
$mday
,
$mon
,
$year
,
$wday
,
$yday
,
$isdst
) =
localtime
(
$Time
);
print
$Month
[
$mon
];
if
(
$mday
< 10) {
print
" $mday "
;
}
else
{
print
" $mday "
;
}
if
(
$Now
-
$Time
<=
$SixMonths
) {
printf
(
"%02d:%02d"
,
$hour
,
$min
);
}
else
{
printf
(
" %04d"
,
$year
+ 1900);
}
}
print
" $Entry\n"
;
}
}
sub
List {
my
$Name
=
shift
;
my
$Options
=
shift
;
my
$is_dir
=
shift
;
my
$Expand
=
shift
;
my
$Attributes
=
""
;
my
$BlockSize
=
exists
(
$Options
->{
'k'
}) ? 2 : 1;
my
$Cols
= 0;
my
$Entry
=
""
;
my
@Dirs
= ();
my
$Mask
=
""
;
my
$Mylen
= 0;
my
$Path
=
""
;
my
$Piece
=
""
;
my
@SortedEntries
= ();
my
$Rows
= 0;
my
$Target
= 0;
my
$TotalBlocks
= 0;
my
$elt
= 0;
$Attributes
=
pop
(
@_
);
foreach
(
@_
) {
$TotalBlocks
+=
(!
defined
(
$Attributes
->{
$_
}) ||
(
$Attributes
->{
$_
}->blocks eq
''
)) ?
0:
$Attributes
->{
$_
}->blocks;
$Mylen
=
length
(
$_
);
if
(
$Mylen
>
$Maxlen
) {
$Maxlen
=
$Mylen
;
}
}
$Maxlen
+= 1;
if
(
exists
(
$Options
->{
'R'
})) {
print
"$Name:\n"
if
$is_dir
;
}
if
(
exists
(
$Options
->{
'l'
}) ||
exists
(
$Options
->{
's'
})) {
print
"total $TotalBlocks\n"
if
$is_dir
;
}
@SortedEntries
= Order(\
%Options
,
$Attributes
,
@_
);
if
(
defined
(
$Options
->{
'1'
}) ||
exists
(
$Options
->{
'l'
}) ||
exists
(
$Options
->{
's'
}) ||
exists
(
$Options
->{
'i'
})) {
for
my
$Entry
(
@SortedEntries
) {
EntryFormat(\
%Options
,
$Attributes
,
$Entry
);
}
}
else
{
$Cols
=
int
(
$WinCols
/
$Maxlen
) || 1;
$Rows
=
int
((
$#_
+
$Cols
) /
$Cols
);
$Mask
=
sprintf
(
"%%-%ds "
,
$Maxlen
);
for
(
$elt
= 0;
$elt
<
$Rows
*
$Cols
;
$elt
++) {
$Target
= (
$elt
%
$Cols
) *
$Rows
+
int
((
$elt
/
$Cols
));
$Piece
=
sprintf
(
$Mask
,
$Target
< (
$#SortedEntries
+ 1) ?
$SortedEntries
[
$Target
] :
""
);
$Piece
=~ s/\s+$//
if
((
$elt
+1) %
$Cols
== 0);
print
$Piece
;
print
"\n"
if
((
$elt
+1) %
$Cols
== 0);
}
print
"\n"
if
((
$elt
+1) %
$Cols
== 0);
}
if
(
exists
(
$Options
->{
'R'
})) {
print
"\n"
;
}
if
(!
exists
(
$Options
{
'd'
}) &&
(
$Expand
||
exists
(
$Options
->{
'R'
}))) {
for
my
$Entry
(Order(\
%Options
,
$Attributes
,
@_
)) {
next
if
(
$Entry
eq
"."
||
$Entry
eq
".."
);
if
(
defined
(
$Attributes
->{
$Entry
}) &&
$Attributes
->{
$Entry
}->mode & 0040000) {
$Path
= File::Spec->canonpath(File::Spec->catdir(
$Name
,
$Entry
));
@Dirs
= DirEntries(\
%Options
,
$Path
);
List(
$Path
, \
%Options
, 1, 0,
@Dirs
);
}
}
}
}
sub
Order {
my
$Options
=
shift
;
my
$Attributes
=
shift
;
my
@Entries
=
@_
;
if
(
exists
(
$Options
->{
'S'
})) {
if
(
exists
(
$Options
->{
'r'
})) {
@Entries
=
sort
{
$Attributes
->{
$a
}->size <=>
$Attributes
->{
$b
}->size }
@Entries
;
}
else
{
@Entries
=
sort
{
$Attributes
->{
$b
}->size <=>
$Attributes
->{
$a
}->size }
@Entries
;
}
}
elsif
(
exists
(
$Options
->{
't'
}) ||
exists
(
$Options
->{
'c'
}) ||
exists
(
$Options
->{
'u'
})) {
if
(
exists
(
$Options
->{
'r'
})) {
if
(
exists
(
$Options
->{
'u'
})) {
@Entries
=
sort
{
$Attributes
->{
$a
}->atime <=>
$Attributes
->{
$b
}->atime }
@Entries
;
}
elsif
(
exists
(
$Options
->{
'c'
})) {
@Entries
=
sort
{
$Attributes
->{
$a
}->ctime <=>
$Attributes
->{
$b
}->ctime }
@Entries
;
}
else
{
@Entries
=
sort
{
$Attributes
->{
$a
}->mtime <=>
$Attributes
->{
$b
}->mtime }
@Entries
;
}
}
else
{
if
(
exists
(
$Options
->{
'u'
})) {
@Entries
=
sort
{
$Attributes
->{
$b
}->atime <=>
$Attributes
->{
$a
}->atime }
@Entries
;
}
elsif
(
exists
(
$Options
->{
'c'
})) {
@Entries
=
sort
{
$Attributes
->{
$b
}->ctime <=>
$Attributes
->{
$a
}->ctime }
@Entries
;
}
else
{
@Entries
=
sort
{
$Attributes
->{
$b
}->mtime <=>
$Attributes
->{
$a
}->mtime }
@Entries
;
}
}
}
elsif
(!
exists
(
$Options
->{
'f'
})) {
if
(
exists
(
$Options
->{
'r'
})) {
@Entries
=
sort
{
$b
cmp
$a
}
@Entries
;
}
else
{
@Entries
=
sort
{
$a
cmp
$b
}
@Entries
;
}
}
return
@Entries
;
}
unless
(getopts(
'1ACFLRSTWacdfgiklmnopqrstux'
, \
%Options
)) {
warn
"usage: $Program [-1RSacdfiklnrstu] [file ...]\n"
;
exit
EX_FAILURE;
}
if
(
$Options
{
'f'
}) {
$Options
{
'a'
} = 1;
}
$WinCols
= get_columns();
$Attributes
=
stat
(
*STDOUT
);
if
(
$Attributes
->mode & 0140000) {
$Options
{
'1'
} =
'1'
;
}
if
(
$#ARGV
< 0) {
List(
'.'
, \
%Options
, 1, 0, DirEntries(\
%Options
,
"."
));
}
else
{
$ArgCount
= -1;
for
my
$Arg
(
@ARGV
) {
if
(!
exists
(
$Options
{
'd'
}) && -d
$Arg
) {
$ArgCount
++;
push
(
@Dirs
,
$Arg
);
}
else
{
$ArgCount
+= 2;
push
(
@Files
,
$Arg
);
}
}
for
my
$Arg
(
@Files
) {
$Attributes
{
$Arg
} =
stat
(
$Arg
);
}
for
my
$Arg
(Order(\
%Options
, \
%Attributes
,
@Files
)) {
$First
= 0;
List(
$Arg
, \
%Options
, 0, 0,
DirEntries(\
%Options
,
$Arg
));
}
for
my
$Arg
(
@Dirs
) {
$Attributes
{
$Arg
} =
stat
(
$Arg
);
}
for
my
$Arg
(Order(\
%Options
, \
%Attributes
,
@Dirs
)) {
if
(!
exists
(
$Options
{
'R'
})) {
print
"\n"
if
(!
$First
);
$First
= 0;
print
"$Arg:\n"
if
(
$ArgCount
> 0);
}
List(
$Arg
, \
%Options
, 1, 0,
DirEntries(\
%Options
,
$Arg
));
}
}