#!/usr/bin/perl
# Time-stamp: "2006-05-31 21:17:10 ADT"  sburke@cpan.org
# Puts subdirectory items into a decent filesystem order.
# Useful only for crazy applications that use the filesystem order at all!

@ARGV = grep length($_), @ARGV;
@ARGV = '.' unless @ARGV;

#use SMB::UniqueProc qw(sortdir);

use strict;
use warnings;
use constant DEBUG => 1;
my $temp = $ENV{'TEMP'}
  || do { (grep -e $_, '/tmp', 'c:/windows/temp', '/windows/temp')[0];}
  || die "where's temp?"
;
open LOG, ">$temp/sortdir.log" or die $!;

my $count = 0;
foreach my $dir (@ARGV) { sortdir($dir) }
exit;


sub sortdir {
  my $dir = $_[0];
  opendir(DIR, $dir) or die "Can't opendir $dir: $!";
  my @in =
    sort { lc($a) cmp lc($b) } 
    grep { $_ ne '.' and $_ ne '..' }
    readdir(DIR)
  ;
  closedir(DIR);
  DEBUG > 3 and print map("  $_\n", @in, '');
  my $rando = 'temp_'.rando();
  
  mkdir "$dir/../$rando" or die "Can't mkdir $dir/../$rando: $!";
  if(-e "$dir/$rando") {
    rmdir "$dir/../$rando" or die "I can't rmdir $rando!";
    die "I'm in a crazy place!";
  }
  
  foreach my $f (map "$dir/$_", @in) { sortdir($f) if -d $f }  # Recurse!
  
  {
    my( @undo,  $from, $to );
    foreach my $f (@in) {
      my($from, $to) = ("$dir/$f", "$dir/../$rando/$f");
      print LOG "$from\n\t$to\n";
      DEBUG > 2 and print "$from\n\t$to\n";
      if(rename $from, $to) {
        push @undo, $to, $from;
        ++$count;
      } else {
        print LOG "Can't rename $from to $to : $!\n";
        warn      "Can't rename $from to $to : $!\n";
      }
    }
    # now undo it all
    while( ($from, $to) = splice(@undo, 0, 2) ) {
      if(rename $from, $to) {
        # As planned.
      } else {
        print LOG "Can't back-rename $from to $to : $!\n";
        warn      "Can't back-rename $from to $to : $!\n";
      }
    }
  }
  print "$count items moved as of $dir\n";

  rmdir "$dir/../$rando" or do {
    print LOG "I can't rmdir $rando: $!\n";
    warn      "I can't rmdir $rando: $!\n";
  };
  
  return;
}



my %used;
sub rando {
  my $x;
  do { $x = join '', map sprintf('%04x', rand(0x10000)), 0 .. 3; }
   while exists $used{$x};
  $used{$x} = undef;
  #print $x;
  return $x;
}

__END__