#!/usr/bin/perl -w
# parser "DIR /S"
# Autor: Michał Mirosław   2003/11/13
use strict;
use IO::Handle;
use IO::File;

# uwaga - IO::Filter 0.01 ma błąd w funkcji getline

# sprawdzenie argumentów
if (@ARGV != 1) {
	print STDERR "$0 plik_ls-lR\n";
	if (eval { require IO::Filter; $IO::Filter::VERSION > 0.01; }) {
		print STDERR "obsługuje dekompresję zip (jeśli dostępny jest program 'unzip')\n";
	} else {
		print STDERR "brakuje modułu IO::Filter (pliki skompresowane nie będą obsługiwane)\n";
		print STDERR "lub moduł ten ma błąd wykluczający jego użycie\n";
	}
	exit (@ARGV > 0);
}

my $file = $ARGV[0];
my $io;

# otwieramy plik
if ($file eq '-') {
	$io = new IO::Handle;
	die "nie mogę otworzyć STDIN: $!" unless $io->fdopen(fileno(STDIN), 'r');
} else {
	$io = new IO::File($file, "r");
	die "nie mogę otworzyć pliku: $!" unless $io;

	if (eval { require IO::Filter; $IO::Filter::VERSION > 0.01; }) {
		if ($file =~ m/\.zip$/i) {
			require IO::Filter::External;
			$io = new IO::Filter::External($io, "r", qw"unzip -p", $file, "dir-s.txt", "DIR-S.TXT");
			die "nie mogę otworzyć filtra dekompresji zip: $!" unless $io;
		}
	}
}

# mamy już plik, teraz czas pohaczyć

use constant WANTDIR => 1;
use constant PARSEFILES => 2;

my $has_common_root = 1;
my $state = WANTDIR;
my $dir = undef;
my $rootdir = undef;
my $rootdir_len = 0;
my ($type, $date, $time, $size, $name, $tmp);

while (defined ($_ = $io->getline)) {
	chomp $_;
	chop $_ if "\r" eq substr $_, -1;
	$state = WANTDIR if ' ' eq substr $_, 0, 1;
	next if $_ eq '';
#	print "($state) -> $_\n";

	if ($state == WANTDIR) {
		next unless m/^ [^: ]+: (.*)$/;
		$dir = $1;
		($rootdir = $dir), ($rootdir_len = length $dir) unless defined $rootdir;
		$dir .= '\\';
		$tmp = substr($dir, 0, $rootdir_len, '');
		if ($tmp ne $rootdir) {
			if ($has_common_root) {
				$has_common_root = 0;
				warn "serwer nie ma jednego katalogu głównego - dane mogą być niepoprawne";
			}
			$dir = "$tmp$dir";
		}
		$dir =~ s/\\/\//g;
		$state = PARSEFILES;
		next;
	}

	# przetwarzanie właściwe
	# przykładowe linie z 'dir /s/-c' z WinXP,PL

# 2003-10-22  13:01    <DIR>          gry
# 2003-11-04  19:24           2012160 Dok1.doc

	# na szczęście dla nas, winda nie obsługuje dziwnych znaków w nazwach plików
	# FIXME: koniecznie poprawcie, jeśli to nie prawda
	# jeśli ktoś ma separator tysięczny jako spacja, to wszystko się wysypie
	# -> wina usera -> opcja "/-C"

	($date, $time, $size, $name) = split(/\s+/, $_, 4);
	next unless defined $name and $name ne '.' and $name ne '..';

	if ($size =~ m/^<DIR>$/i) {
		$size = 0;
		$name .= '/';
	} else {
		$size =~ s/[^0-9]//g;
	}

	print "$size\t$dir$name\n";
}