bugfix
[hband-tools.git] / tabdata / td-trans-ls
blobafb0a2448f37181fe5be5fb2a97515085d51007b
1 #!/usr/bin/env perl
3 =pod
5 =head1 NAME
7 td-trans-ls - Transform ls(1) output into fix number of TAB-delimited columns.
9 =head1 USAGE
11 ls -l | td-trans-ls
13 =head1 DETAILS
15 Supported ls(1) options which affect its output format:
17 =over 4
19 =item --human-readable
21 =item --inode
23 =item --recursive
25 =item --time-style={iso,long-iso,full-iso}
27 =back
29 Unsupported options:
31 =over 4
33 =item --author
35 =item -g
37 =item -o
39 =item --time-style=locale
41 =back
43 =cut
45 no if ($] >= 5.018), 'warnings' => 'experimental::smartmatch';
46 do '/usr/lib/tool/perl5/tabdata/common.pl' or die "$@";
48 $recursive_mode = 0;
49 $first_line = <STDIN>;
50 if($first_line !~ /^\S+ \d+$/)
52 $recursive_mode = 1;
53 $first_line =~ /^(.+):$/;
54 $current_directory = $1;
55 # skip the "total 123" line
56 <STDIN>;
59 @Headers = qw/INODE MODE LINKS OWNER GROUP SIZE MAJOR MINOR DATETIME NAME SYMLINKTARGET/;
60 push @Headers, 'DIRECTORY' if $recursive_mode;
62 print join($FS, @Headers).$/;
64 $mode_links_owner_group = qr/(\S+)\s+(\S+)\s+(\S+)\s+(\S+)/;
66 # update supported --time-style options in the documentation
67 $datetime = qr/((?:\d\d\d\d-)?\d\d-\d\d \d\d:\d\d(?::\d\d(?:\.\d+)? [\d+-]+)?)/;
69 sub parse_error
71 die "can not parse: $_[0]\n";
74 while(<STDIN>)
76 my @Fields;
77 my $inode;
79 if($recursive_mode)
81 if(/^$/)
83 $_ = <STDIN>;
84 /^(.+):$/ or die "a directory introduction expected, not this: $_\n";
85 $current_directory = $1;
86 # skip the next "total 123" line
87 <STDIN>;
88 next;
92 if(s/^(\d+)\s+//)
94 $inode = $1;
97 if(/^[cb]/)
99 @Fields = /^$mode_links_owner_group\s+()([^,]+),\s*(\S+)\s+$datetime\s+(.+)()$/ or parse_error $_;
101 elsif(/^l/)
103 @Fields = /^$mode_links_owner_group\s+(\S+)()()\s+$datetime\s+(.+?) -> (.+)$/ or parse_error $_;
105 else
107 @Fields = /^$mode_links_owner_group\s+(\S+)()()\s+$datetime\s+(.+)()$/ or parse_error $_;
110 unshift @Fields, $inode;
111 push @Fields, $current_directory if $recursive_mode;
113 print join($FS, @Fields).$RS;