Changeset e6cec01 for perl


Ignore:
Timestamp:
Dec 28, 2009, 12:03:29 AM (14 years ago)
Author:
Nelson Elhage <nelhage@mit.edu>
Branches:
master, release-1.10, release-1.6, release-1.7, release-1.8, release-1.9
Children:
dc8f6e0
Parents:
880311d
git-author:
Nelson Elhage <nelhage@mit.edu> (12/27/09 23:48:30)
git-committer:
Nelson Elhage <nelhage@mit.edu> (12/28/09 00:03:29)
Message:
Completion: Add a helper function to complete paths.

Add tests as well.

[Thanks to davidben@mit.edu for bug reports and helping to clarify the
 $dir vs $pfx distinction in the code]
File:
1 edited

Legend:

Unmodified
Added
Removed
  • perl/lib/BarnOwl/Completion/Util.pm

    r69c27e6 re6cec01  
    55
    66use base qw(Exporter);
    7 our @EXPORT_OK = qw(complete_flags);
     7our @EXPORT_OK = qw(complete_flags complete_file);
    88
    99use Getopt::Long;
     10use Cwd qw(abs_path);
     11use File::Basename qw(dirname basename);
     12
    1013
    1114sub complete_flags {
     
    6770    }
    6871}
     72
     73sub expand_tilde {
     74    # Taken from The Perl Cookbook, recipe 7.3
     75    my $path = shift;
     76    $path =~ s{ ^ ~ ( [^/]* ) }
     77                { $1
     78                  ? (getpwnam($1))[7]
     79                  : ( $ENV{HOME} || $ENV{LOGDIR}
     80                      || (getpwuid($>))[7]
     81                     )
     82              }ex;
     83    return $path;
     84}
     85
     86sub splitfile {
     87    my $path = shift;
     88    if ($path =~ m{^(.*/)([^/]*)$}) {
     89        return ($1, $2);
     90    } else {
     91        return ('', $path);
     92    }
     93}
     94
     95sub complete_file {
     96    my $string = shift;
     97
     98    return ['~/', '~/', 0] if $string eq '~';
     99
     100    my $path = abs_path(expand_tilde($string));
     101    my $dir;
     102    if ($string =~ m{/$} || $string eq '' || basename($string) eq '.') {
     103        $dir = $path;
     104    } else {
     105        $dir = dirname($path);
     106    }
     107    return unless -d $dir;
     108
     109    my ($pfx, $base) = splitfile($string);
     110   
     111    opendir(my $dh, $dir) or return;
     112    my @dirs = readdir($dh);
     113    close($dh);
     114
     115    my @out;
     116    for my $d (@dirs) {
     117        # Skip dotfiles unless explicitly requested
     118        if($d =~ m{^[.]} && $base !~ m{^[.]}) {
     119            next;
     120        }
     121       
     122        my ($text, $value, $done) = ($d, "${pfx}${d}", 1);
     123
     124        if (-d "$dir/$d") {
     125            $text .= "/";
     126            $value .= "/";
     127            $done = 0;
     128        }
     129        push @out, [$text, $value, $done];
     130    }
     131    return @out;
     132}
Note: See TracChangeset for help on using the changeset viewer.