@perl -Swx %0 %*
@c:\a_cd.bat
@goto :eof

#!perl
# 
# Utility for quickly changing directory
# Named to "a.bat" in homage to Pr1mOS's change working directory comm
+and *a* (attach) ;-]
# 
# Syntax: 
#   a ,wi,ja,pa ===> cd \Windows\java\Packages
#   a ...\me    ===> cd \Windows\Media
#   a           ===> cd \Windows\Media\Microsoft Office 2000 *OR* a se
+lection of subdirectories
#   a /         ===> cd \
#   a mys,d,*
#   [a] /mysql/data/mysql/
#   [b] /mysql/data/tast/
#   [c] /mysql/data/test/
#   [d] /mysql/Docs/Flags/
#   select:
#
# if ambigous the correct target is selected with alpha keys /a .. zz/

#
# Versions:
# 0.2 2003-02-22 Cleanup
# 0.1 2003-01-31 First working
# 0.0 2003-01-15 Start of Coding
#

use strict;
use warnings;

use Cwd;

my $DEBUG = 0;
my $DELIM = qr{,|\\|\/};  ## Either "," or "/" or \" 
  
my @to = @ARGV ? split(/$DELIM/, $ARGV[0] ) : ();

my @cwd = split(/$DELIM/, cwd);
shift @cwd;  # Remove disk

unless ( @ARGV ) {
    push @to, @cwd, '*';
}
elsif ( $ARGV[0] =~ /^$DELIM/ and not @to ){ 
}
elsif ( $to[0] eq '' ) {
    shift @to;
}
else {
    unshift @to, @cwd;
}

## Lazy-dots
foreach my $part (0 .. $#to) {
    if ( $to[$part] =~ /\.(\.+)/ ) {
        $to[$part] = join('/',  ('..') x length($1));
    }
}

@to = split(/\//, join('/', @to));

## Rel2Abs
my @fixed;
for (@to) {
    if ($_ eq '..') {
        pop @fixed if @fixed;
    } elsif($_ eq '.') {
        ## Skip
    } else {
        push @fixed, $_
    }
}

my @choices = expand('/', @fixed);


my %hash;
my $enum = 'a';
my $choice = '';
if (1 == @choices) {    # Autoselect if only one item to choose
    $hash{a} = $choices[0];
    $choice = $enum;
} elsif(1 < @choices) {
    foreach my $c (@choices) {
        ($hash{$enum} = $c) ;
        print '[', $enum++, "] $c\n";
    }
    
    print "select: ";
    $choice = <STDIN>;
    chomp $choice;
}

# Create a batch file to change the directory in the shell.
open (CD, '>', 'C:/A_CD.BAT') or die "Failed to create CD bat file $!\
+n";
if ( defined $hash{$choice} ) {
    $hash{$choice} =~ s/\//\\/g; # Make windows happy
    print CD "\@CD \"$hash{$choice}\"\n";
} else {
    print CD "\@echo No match\n";
}
close CD;

sub expand {
    my ($bough, @twigs) = @_;

    return $bough unless @twigs; ## Looked it up in the thesaurus ;-]
    
    opendir(my $dh, $bough) || die "Can not check $bough for twigs due
+ to $!\n";
    my $regexp = shift @twigs;
    $regexp =~ s/\*/.*/;
    my @found;  
    foreach my $f ( grep { $_ =~ /^$regexp/i and $_ !~ /^\./}  readdir
+($dh) ) {
        push @found, expand("$bough$f/", @twigs) if (-d "$bough$f");
    }     
    closedir($dh) || die "Bad close for $bough $!\n";
    
    return @found;
}             

__END__