Article 5221 of comp.lang.perl:
Xref: feenix.metronet.com comp.lang.perl:5221
Newsgroups: comp.lang.perl
Path: feenix.metronet.com!news.utdallas.edu!convex!convex!convex!cnn.exu.ericsson.se!s10a10!exukenc
From: exukenc@exu.ericsson.se (Ken Corey,T/TF,75841)
Subject: Re: Name completion question
Message-ID: <1993Aug23.161539.2243@exu.ericsson.se>
Sender: news@exu.ericsson.se
Nntp-Posting-Host: s10a10.exu.ericsson.se
Reply-To: exukenc@exu.ericsson.se
Organization: Ericsson Network Systems
References: <CC25Cp.FH0@cunews.carleton.ca>
Date: Mon, 23 Aug 1993 16:15:39 GMT
X-Disclaimer: This article was posted by a user at Ericsson.
              Any opinions expressed are strictly those of the
              user and not necessarily those of Ericsson.
Lines: 85

In article FH0@cunews.carleton.ca, rstone@superior.carleton.ca (Ron Stone) writes:
>John Stoffel (john@sekrit.WPI.EDU) wrote:
>: Has anyone written some perl code to name completion? ...
>You should be able to use the complete.pl package in the distribution
>for this.

Here's a little ditty I cooked up once to do this.  (This is really non-perlish perl,
but it worked for all the cases I needed...8^)

---
exukenc == Ken Corey, 214/907-5841 : Speaking for the Americans...all of `em.

-------------------------snip--------------------------------
#!/usr/local/bin/perl
#  by Ken Corey, kenc@sol.acs.unt.edu @1992, you may give but not sell.
#  provides name completion in a cd command.
#  Format:
#    alias cd 'chdir `compcd \!*`'
#  Then, you can:
#
#    cd NewPathName
#
#  The format of the NewPathName argument is the same as that of any
#  regular CD command, with the exception that the first '-' in ANY
#  filename is removed, and the filename is handed verbatim to chdir.
#  
#  So:  cd  /scr/ke/cd         Will change into the /scratch/kenc/cd 
#				directory, unless there's some ambiguity
#       cd  /scr/-kenc/cd      Will change into the /scratch/kenc/cd
#				directory specifically, and not perform
#				completion on the 'kenc' part.
#
$newpathname = $ARGV[0];

$count = ($newpathname =~ s/\//\//g);

@path = split(/\//,$newpathname);

if ($#ARGV< 0) {
    print "$ENV{HOME}\n";
    exit 0;
}


#if ($path[0] == '') {
#  print "path[0] == ''\n";
#  chdir "/";
#  shift @path;
#  $count--;
#}

while ($count >= 0) {
#  print "path[0]=$path[0].\n";
  s/ $//g;
#  print "length of path = ".length($path[0])."\n";
  if ($path[0] =~ /^\.{1,2}$/) {
    $result = $result . "$path[0]/";
  } elsif ($path[0] =~ /^\-/) {
    $path[0] =~ s/-//;
    $result = $result . "$path[0]/";
  } else {
    if (length($path[0])==0) {
    } elsif (opendir(DIRHANDLE,'.')) {
      @file = grep(!/^\.{1,2}$/,grep(-d,readdir(DIRHANDLE)));  
      @file=grep(/^$path[0].{0,}/,@file);  
      closedir(DIRHANDLE);
      $path[0] = $file[0];
      $result = $result . "$file[0]/"; 
    } else { 
      print "Oops!  Couldn't open '.'.\n";  exit 1;  
    }
  } 
  if (length($path[0]) != 0) { 
    chdir $path[0];  
  } else { 
    print "/";
    chdir "/";  
  } 
  shift @path;  
  $count--; 
} 

print "$result\n";