Changeset e6cec01

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]

Files:

• perl/lib/BarnOwl/Completion/Util.pm (modified) (2 diffs)
• t/completion.t (modified) (1 diff)

perl/lib/BarnOwl/Completion/Util.pm

@@ -5 +5 @@
 
 use base qw(Exporter);
-our @EXPORT_OK = qw(complete_flags);
+our @EXPORT_OK = qw(complete_flags complete_file);
 
 use Getopt::Long;
+use Cwd qw(abs_path);
+use File::Basename qw(dirname basename);
+
 
 sub complete_flags {
@@ -67 +70 @@
     }
 }
+
+sub expand_tilde {
+    # Taken from The Perl Cookbook, recipe 7.3
+    my $path = shift;
+    $path =~ s{ ^ ~ ( [^/]* ) }
+                { $1
+                  ? (getpwnam($1))[7]
+                  : ( $ENV{HOME} || $ENV{LOGDIR}
+                      || (getpwuid($>))[7]
+                     )
+              }ex;
+    return $path;
+}
+
+sub splitfile {
+    my $path = shift;
+    if ($path =~ m{^(.*/)([^/]*)$}) {
+        return ($1, $2);
+    } else {
+        return ('', $path);
+    }
+}
+
+sub complete_file {
+    my $string = shift;
+
+    return ['~/', '~/', 0] if $string eq '~';
+
+    my $path = abs_path(expand_tilde($string));
+    my $dir;
+    if ($string =~ m{/$} || $string eq '' || basename($string) eq '.') {
+        $dir = $path;
+    } else {
+        $dir = dirname($path);
+    }
+    return unless -d $dir;
+
+    my ($pfx, $base) = splitfile($string);
+    
+    opendir(my $dh, $dir) or return;
+    my @dirs = readdir($dh);
+    close($dh);
+
+    my @out;
+    for my $d (@dirs) {
+        # Skip dotfiles unless explicitly requested
+        if($d =~ m{^[.]} && $base !~ m{^[.]}) {
+            next;
+        }
+        
+        my ($text, $value, $done) = ($d, "${pfx}${d}", 1);
+
+        if (-d "$dir/$d") {
+            $text .= "/";
+            $value .= "/";
+            $done = 0;
+        }
+        push @out, [$text, $value, $done];
+    }
+    return @out;
+}

t/completion.t

@@ -289 +289 @@
               \&complete_filter_expr);
 
+# Test complete_files
+use BarnOwl::Completion::Util qw(complete_file);
+use File::Temp;
+use File::Path qw(mkpath);
+
+my $tmpdir = File::Temp::tempdir(CLEANUP => 1);
+
+# Make sure $tmpdir does not have a trailing /
+$tmpdir =~ s{/$}{};
+$ENV{HOME} = $tmpdir;
+
+sub touch {
+    my $path = shift;
+    system("touch", "$path");
+}
+
+mkpath("$tmpdir/.owl/",
+       "$tmpdir/.owl/modules/",
+       "$tmpdir/Public/",
+       "$tmpdir/Private/",
+       "$tmpdir/.ours",
+       "$tmpdir/www");
+touch("$tmpdir/.zephyr.subs");
+touch("$tmpdir/wheee");
+touch("$tmpdir/.owl/startup");
+
+sub completion_value {
+    my $c = shift;
+    return $c unless ref($c) eq 'ARRAY';
+    return $c->[1];
+}
+
+sub test_file {
+    my $spec  = shift;
+    my $pfx   = shift;
+    my $dirs  = shift;
+    my $files = shift;
+
+    my $expect = [ sort {$a->[1] cmp $b->[1]} 
+        ((map {["$_/", defined($pfx)?"$pfx/$_/":"$_/", 0]} @$dirs),
+         (map {["$_",  defined($pfx)?"$pfx/$_" :$_   , 1]} @$files))
+       ];
+
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+
+    my @got = complete_file($spec);
+
+    @got = grep {completion_value($_) =~ m{^\Q$spec\E}} @got;
+    @got = sort {completion_value($a) cmp completion_value($b)} @got;
+
+    use Data::Dumper;
+    is_deeply(\@got, $expect);
+}
+
+is_deeply([complete_file("~")], [["~/", "~/", 0]]);
+
+chdir($tmpdir);
+test_file("$tmpdir/", $tmpdir,
+          [qw(Public Private www)],
+          [qw(wheee)]);
+
+test_file("./", ".",
+          [qw(Public Private www)],
+          [qw(wheee)]);
+
+test_file("", undef, [qw(Public Private www)], [qw(wheee)]);
+
+test_file("./.owl/", "./.owl",
+          [qw(modules)],
+          [qw(startup)]);
+
+test_file("~/", "~",
+          [qw(Public Private www)],
+          [qw(wheee)]);
+
+test_file("P", undef, [qw(Public Private)], []);
+
+test_file("$tmpdir/.", $tmpdir,
+          [qw(. .. .owl .ours)],
+          [qw(.zephyr.subs)]);
 1;