#!/usr/bin/perl 

########## Confixx(R) 3.2 Professional ############
####### Copyright SWsoft, Inc. 2004-2006 ##########
##### http://www.swsoft.com - info@swsoft.com #####

use File::Basename;
use Cwd;
use Getopt::Long;

use locale;
no utf8;

$root = '/var/www';


$root =~ s/\/$//;

my @optsConf = (
								'path|p=s',
								'sort|s=s',
								'rev|r',
								'all|a',
								'dbg|d',
								'check-dir|cd'
							 );

my %args;

Getopt::Long::Configure('prefix_pattern=--|-','ignore_case');

unless( &GetOptions( \%args, @optsConf ) ){
  warn("Error in command line found. Use the format described beow.\n");
  print STDERR &printHelp();
}

my $sort = lc($args{'sort'}) || '';
$sort = 'name' unless $sort =~ /^(name|ext|none)$/;

  
my $rev = exists($args{'rev'})?1:0;
my $all  = ($args{'all'} || (defined $ARGV[1]) && ($ARGV[1] ne ""))?1:0;
my $debug = $args{'dbg'}||0;

my $path = $args{'path'} || $ARGV[0];

if( $path =~ /\.\./ ){
	exit 1;
}

$path =~ s/\/+$//;      ## delete last slashes
$path =~ s/^\/+//;      ## delete first slashes

unless( $path ){
	exit 1;
}

my @list;

#
# get list of dir
#
my $realPath = "$root/$path";

if( exists( $args{'check-dir'} ) ){
	exit &checkDir( $realPath, $root );
}

unless( -d $realPath ){
	print "Error: $realPath is not dir\n" if $debug;
	exit 1;
}

unless( &checkSymLink( $root, $realPath ) ){
	exit 1;
}

my $cwd = getcwd();

unless( opendir( DIR, $realPath ) ){
	print STDERR "Error: unable to open dir: $realPath: $!\n" if $debug;
	exit 1;
}

chdir( $realPath );

while( defined( $file = readdir( DIR ) ) ){
	next if $file =~ /^\.\.?$/;
	if( $all ){
		if( -d $file ){
			push @list, 'd'.$file;
		} else {
			push @list, 'f'.$file;
		}
	}else{
		if( -d $file ){
			push @list, $file;
		}
	}
}

closedir(DIR);
#
# sorting
#
my ($aext,$bext,$ret,$aname,$bname,$atype,$btype, %cache);

@list = sort {

	if( exists $cache{$a} ){ ## there is in cache
		( $atype, $aname, $aext ) = @{ $cache{$a} };

	}else{
		$atype = ( -d $a )?0:1;
		if( $a =~ /^(.*)(\.[^.]+)$/ ){
			$aname = $1;
			$aext = $2;
		}else{
			$aname = $a;
			$aext = '';
		}
# store into cache
		$cache{$a} = [ $atype, $aname, $aext ];
	}

	if( exists $cache{$b} ){ ## there is in cache
		( $btype, $bname, $bext ) = @{ $cache{$b} };

	}else{
		$btype = ( -d $b )?0:1;
		if( $b =~ /^(.*)(\.[^.]+)$/ ){
			$bname = $1;
			$bext = $2;
		}else{
			$bname = $b;
			$bext = '';
		}
# store into cache
		$cache{$b} = [ $btype, $bname, $bext ];
	}

	if( $atype == $btype ){ ## dir <-> dir or file <-> file

		if( $sort eq 'ext' ){
			if( $aext eq $bext ){
				$ret = $aname cmp $bname;        ## sort in an extansion 
			}else{
				$ret = $aext cmp $bext;          ## sort by extension
			}

		}elsif( $sort eq 'name' ){
			if( $aname eq $bname ){
				$ret = $aext cmp $bext;          ## sort in a name
			}else{	
				$ret = $aname cmp $bname;        ## sort by name
			}

		}else{ ## none - without sorting
			$ret = 0;
		}

		$ret -= $ret if $rev; ## reverse sorting

	}else{
		$ret = $atype <=> $btype; ## dirs first
	}

	$ret; ## return result

} @list;

chdir $cwd;
  
#
# output results
#
foreach my $item (@list){
	print $item,"\n";
}
#
#
# 

exit 0;

#
#
#==========================================================
#
#

sub checkDir{
	my( $dir, $base ) = @_;
	if( -l $dir ){
		return 2; ## a link
	}
	if( -d $dir ){
		return 0; ## OK 
	}
	if( -e $dir ){
		return 2; ## it is not a dir
	}

	my( $parent, $ret );
	$ret = 1;
	while( $dir ne $base ){
		if( -l $dir ){ ## link
			$ret = 2;
			last;
		}
		if( -d $dir ){ ## dir - can make
			last;
		}
		if( -e $dir ){ ## not dir - can't make
			$ret = 2;
			last;
		}
		$parent = dirname( $dir );
		if( $parent eq $dir ){ ## loop
			last;
		}else{
			$dir = $parent;
		}
	}
	return $ret;
}

sub checkSymLink{
my ($base, $file) = @_;
	my ($dir);
  while( $file ne $base ){
    if( -l $file ) {
      exit 1; ## symlink is found
    }
    $dir = dirname( $file );
		if( $dir eq $file ){ ## root dir
			last;				
		} else {
			$file = $dir; ## go to parent			
		}
  }
  return 1;
}


sub printHelp{
  return <<HELP;

lsdir.pl - get list of directory

usage: lsdir.pl <path> [all] [<options>]

options:
         -a|--all             - files & dirs. First char is 'f' or 'd'.	
         -s|--sort=[none,ext] - sorting mode. Default by name.
         -r|--rev             - reverse order while sorting  		        

HELP
}