source: perl/lib/BarnOwl/Completion/Util.pm @ fe03126

release-1.10release-1.6release-1.7release-1.8release-1.9
Last change on this file since fe03126 was e6cec01, checked in by Nelson Elhage <nelhage@mit.edu>, 14 years ago
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]
  • Property mode set to 100644
File size: 3.0 KB
Line 
1use strict;
2use warnings;
3
4package BarnOwl::Completion::Util;
5
6use base qw(Exporter);
7our @EXPORT_OK = qw(complete_flags complete_file);
8
9use Getopt::Long;
10use Cwd qw(abs_path);
11use File::Basename qw(dirname basename);
12
13
14sub complete_flags {
15    my $ctx     = shift;
16    my $no_args = shift;
17    my $args    = shift;
18    my $default = shift;
19
20    my %options = ();
21    %options = @_ if @_;
22
23    my $idx = 1;
24    my $flag = undef;
25
26    my $argct = 0;
27    my $optsdone = 0;
28
29    my %flags_seen;
30
31    while($idx < $ctx->word) {
32        my $word = $ctx->words->[$idx];
33        if($flag) {
34            undef $flag;
35        } elsif($word =~ m{^--}) {
36            if($word eq '--') {
37                $optsdone = 1;
38                $idx++;
39                last;
40            }
41            $flag = $word if(exists $args->{$word});
42        } elsif ($word =~ m{^-}) {
43            $word = "-" . substr($word, -1);
44            $flags_seen{$word} = 1; # record flag
45            $flag = $word if(exists $args->{$word});
46        } else {
47            $argct++;
48            if ($options{stop_at_nonflag}) {
49                $optsdone = 1;
50                $idx++;
51                last;
52            }
53        }
54        $idx++;
55    }
56    # Account for any words we skipped
57    $argct += $ctx->word - $idx;
58
59    if($flag) {
60        my $c = $args->{$flag};
61        if($c) {
62            return $c->($ctx);
63        }
64        return;
65    } else {
66        my @opts = $optsdone ? () : (@$no_args, keys %$args);
67        # filter out flags we've seen if needbe
68        @opts = grep {!$flags_seen{$_}} @opts unless $options{repeat_flags};
69        return (@opts, $default ? ($default->($ctx, $argct)) : ());
70    }
71}
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 TracBrowser for help on using the repository browser.