#!/usr/bin/perl 

########## Confixx(R) 3.0 Professional ############
####### Copyright SWsoft, Inc. 2004-2005 ##########
#### http://www.sw-soft.com - info@sw-soft.com ####


use locale;
use File::Basename;
use Getopt::Long;

$root = '/home/www/confixx1';

my @optsConf = (
  'sort|s=s',
  'rev|r',
  'all|a',
  'dbg|d'
);

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 = $args{'sort'} || '';
if($sort){
  if($sort=~/none/i){
	$sort='none';
  }elsif($sort=~/ext/i){
	$sort='ext';
  }else{
	$sort='';
  }
}  
my $rev = exists($args{'rev'})?1:0;
my $all  = ($args{'all'} || (defined $ARGV[1]) && ($ARGV[1] ne ""))?1:0;
my $debug = $args{'dbg'}||0;


if($ARGV[0] =~ /\.\./){
  exit 1;
}

$ARGV[0]=~s/\/+$//;      ## delete last slashes
$ARGV[0]=~s/^\/+//;      ## delete first slashes

my @list;

#
# get list of dir
#
if(($ARGV[0] ne "") && (-d "$root/$ARGV[0]") && (&checkSymLink($root, "$root/$ARGV[0]"))){

  unless(opendir(DIR, "$root/$ARGV[0]")){
	print STDERR "Error: unable to open dir: $root/$ARGV[0]: $!\n" if $debug;
	exit 1;
  } 
  
  while (defined($file = readdir(DIR))){
    if($file ne "." && $file ne ".."){
      if($all){
        if(-d "$root/$ARGV[0]/$file"){
          push @list,"d$file";
        }
        else{
          push @list,"f$file";
        }
      }
      else{
        if(-d "$root/$ARGV[0]/$file"){
          push @list,$file;
        }
      }
    }
  }
  closedir(DIR);
#
# sorting
#
  my ($aext,$bext,$ret,$aname,$bname,$abase,$bbase);
  @list = sort {
	if ($all && (substr($a,0,1) ne substr($b,0,1))){
	  $a cmp $b;   ## dirs first 
	}else{
	  unless ($sort eq 'none'){

		if($a=~/^(.*)(\.[^.]+)$/){
		  $aname=$1;
		  $aext=$2;
		}else{
		  $aname=$a;
		  $aext='';  
		}

		if($b=~/^(.*)(\.[^.]+)$/){
		  $bname=$1;
		  $bext=$2;
		}else{
		  $bname=$b;
	  	  $bext='';  
		}


		if ($sort eq 'ext'){

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

		}else{
		  if($aname eq $bname){
			$ret = $aext cmp $bext;          ## sort in a name
		  }else{	
			$ret = $aname cmp $bname;        ## sort by name
		  }
		}
		if($rev){
		  $ret = -$ret;                      ## reverse sorting
		}
		$ret;                                ## return
	  }
	}  
  } @list;
  
#
# output results
#
  foreach my $item (@list){
	print $item,"\n";
  }
#
#
#  
}
else{
  unless(-d "$root/$ARGV[0]"){
	print "Error: $root/$ARGV[0] is not dir\n" if $debug;
  }
  exit 1;
}


sub checkSymLink{
my ($base, $file) = @_;
  while("$file" ne "$base"){
    if(-l "$file"){
      exit 1;
    }
    $file = dirname($file);
  }
  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
}
