#!/usr/bin/perl

use warnings;
use strict;

use Fcntl;
use SDBM_File;

my $pathDats = ($ENV{QCD_DAT} || $ENV{HOME}) . "/.qcd";
#print "\$pathDats: $pathDats\n";

tie (my %DIRS, 'SDBM_File', $pathDats,
        O_RDWR|O_CREAT, 0666) || die $!;

if ( @ARGV ) {
        {
                ($ARGV[0] eq "-i") && do { # insert a path-entry
                        if ($ARGV[1]) {
                                $ARGV[1] = $ENV{PWD} if ($ARGV[1] eq "
+.");
                                #$ARGV[1] =~ s/(\s)/\\$1/g;
                                $DIRS{firstFreeIndex()} = $ARGV[1];
                        }
                        print ".\n";
                        exit};
                ($ARGV[0] eq "-d") && do { # delete a path-entry
                        delete $DIRS{$ARGV[1]};
                        print ".\n";
                        exit};
                ($ARGV[0] eq "-c") && do { # compress lists of path-en
+tries
                        compress();
                        print ".\n";
                        exit};
                ($ARGV[0] =~ /[1-9]+/ ) && do {
                        printPath($ARGV[0]);
                        exit};
        }
}

my $oldfh = select STDERR; $| = 1; select $oldfh;
                        #neccessary for usage on cygwin 
                        #Holy Scripture, 3rd Edition, P.803

(my @liste = sort keys %DIRS) || do {print ".\n"; exit};

my ($pat, $found, $wahlPfad) = ($ARGV[0] || "", 0);
foreach (@liste) {
        ($DIRS{$_} =~ /$pat/o) && do {
        $wahlPfad = $DIRS{$_};
        print STDERR "[$_] $wahlPfad\n";
                $found++;
        }
}

{
        ($found == 0) && do { print ".\n"; exit };
        $pat && ($found == 1) && do { print "$wahlPfad\n"; exit };
}

print STDERR "[#]> ";

my $input = <STDIN>;
chop($input);

printPath($input);

untie %DIRS;

sub printPath { #---------------------------------------------------

        my $sel = shift;
        if (exists $DIRS{$sel}) {
            print "$DIRS{$sel}\n";
        } else {
            print ".\n";
        }
}

sub firstFreeIndex { #----------------------------------------------

        my $i = 1;
        foreach (sort keys %DIRS) {
                last if ($i != $_);
                $i++;
        }
        $i;
}

sub compress { #----------------------------------------------------

        (my @liste = values %DIRS) || exit;
        %DIRS = ();
        my $i = 0;
        foreach (@liste) { $DIRS{++$i} = $_; }

}

__END__

=head1 NAME

qcd (quick change directory, a variation of M.Schillis cdbm)

=head1 SYNOPSIS

c path-item-index | path-item-pattern

c -i pathname | -d path-item-index | -c

=head1 DESCRIPTION

qcd is an interactive tool for cd-ing driven by menu. The desired path
+ can be selected by indexnumber directly or by choice.
Also a pattern can be the parameter for qcd. The matched path-items wi
+ll be displayed in the menu. If there remains only one a cd to this w
+ill be executed immediatly.

The B<implementation> is realized via perl-script qcd which is embedde
+d in the shell(bash)-function c or how you will ever name this functi
+on. 

The path-items are stored in ~/.qcd.pag if no explicit path is given v
+ia Env-Var QCD_DAT.

=head1 OPTIONS

=over 4

=item B<-c> 

compress the menu by eliminating gaps which were created by former pat
+h-item deletes

=item B<-d>

delete a path-item

=item B<-i>

insert/append a path-item

=back

=head1 PREREQUISITE

C<function c () { cd `qcd $1 $2`; pwd; }> which should be done in .bas
+hrc or something similar.

=head1 KNOWN BUGS

Pathnames which contains Blanks (a nasty Windows-property) can't be ha
+ndled with qcd. I tested with singlequotes and backslashes, nothing d
+id it. Perhaps someone has an helpful idea.

=head1 AUTHOR

tos <_tosch_@yahoo.com>

=head1 EXAMPLE

 tos@sys-5713 /cygdrive/c/WINDOWS/SYSTEM32/DRIVERS
 function c () { cd `perl "d:\tsp\lab\dvlp\tos\too\qcd" $1 $2`; }

 tos@sys-5713 /cygdrive/c/WINDOWS/SYSTEM32/DRIVERS
 # c
 [1] /home/tos/lab/dvlp/tos/too/picSort
 [2] /cygdrive/c/SapWorkDir
 [3] /cygdrive/c/WINDOWS/SYSTEM32/DRIVERS
 [#]> 1

 tos@sys-5713 ~/lab/dvlp/tos/too/picSort
 # c 3

 tos@sys-5713 /cygdrive/c/WINDOWS/SYSTEM32/DRIVERS
 # c Sap
 [2] /cygdrive/c/SapWorkDir

 tos@sys-5713 /cygdrive/c/SapWorkDir
 # c -i /cygdrive/d/perl/site/lib/HTML/Element

 tos@sys-5713 /cygdrive/c/SapWorkDir
 # c
 [1] /home/tos/lab/dvlp/tos/too/picSort
 [2] /cygdrive/c/SapWorkDir
 [3] /cygdrive/c/WINDOWS/SYSTEM32/DRIVERS
 [4] /cygdrive/d/perl/site/lib/HTML/Element
 [#]> 4

 tos@sys-5713 /cygdrive/d/perl/site/lib/HTML/Element

=head1 CREDITS

Michael Schilli 

http://perlmeister.com/scripts/cdbm-README.html

http://www.heise.de/ix/artikel/2001/01/179/ 

=cut
[download]