[a3a9eb7] | 1 | use strict; |
---|
| 2 | use warnings; |
---|
| 3 | |
---|
| 4 | # Helper completers for filters |
---|
| 5 | package BarnOwl::Complete::Filter; |
---|
| 6 | |
---|
| 7 | use base qw(Exporter); |
---|
| 8 | our @EXPORT_OK = qw(complete_filter_name complete_filter_expr); |
---|
| 9 | |
---|
| 10 | # Completes the name of a filter |
---|
| 11 | sub complete_filter_name { return @{BarnOwl::all_filters()}; } |
---|
| 12 | |
---|
| 13 | # Completes a filter expression |
---|
| 14 | sub complete_filter_expr { |
---|
| 15 | my $ctx = shift; |
---|
| 16 | |
---|
| 17 | my @completions = (); |
---|
| 18 | _complete_filter_expr($ctx, 0, \@completions); |
---|
| 19 | # Get rid of duplicates and sort |
---|
| 20 | my %hash = (); |
---|
| 21 | @hash{@completions} = (); |
---|
| 22 | @completions = sort keys %hash; |
---|
| 23 | return @completions; |
---|
| 24 | } |
---|
| 25 | |
---|
| 26 | ### Private |
---|
| 27 | |
---|
| 28 | my %filter_cmds = ( |
---|
| 29 | sender => \&BarnOwl::Complete::Zephyr::complete_user, |
---|
| 30 | recipient => \&BarnOwl::Complete::Zephyr::complete_user, |
---|
| 31 | class => \&BarnOwl::Complete::Zephyr::complete_class, |
---|
| 32 | instance => \&BarnOwl::Complete::Zephyr::complete_instance, |
---|
| 33 | opcode => \&BarnOwl::Complete::Zephyr::complete_opcode, |
---|
| 34 | realm => \&BarnOwl::Complete::Zephyr::complete_realm, |
---|
| 35 | body => undef, |
---|
| 36 | hostname => undef, |
---|
| 37 | type => sub { qw(zephyr aim admin); }, |
---|
| 38 | direction => sub { qw(in out none); }, |
---|
| 39 | login => sub { qw(login logout none); }, |
---|
| 40 | filter => \&complete_filter_name, |
---|
| 41 | perl => undef, |
---|
[a1d98e4] | 42 | deleted => sub { qw(true false); }, |
---|
[a3a9eb7] | 43 | ); |
---|
| 44 | |
---|
| 45 | # Returns: |
---|
| 46 | # - where to look next after pulling out an expression |
---|
| 47 | # - $INCOMPLETE if this cannot form a complete expression (or w/e) |
---|
| 48 | # - pushes to completion list as it finds valid completions |
---|
| 49 | |
---|
| 50 | my $INCOMPLETE = -1; |
---|
| 51 | sub _complete_filter_expr { |
---|
| 52 | # Takes as arguments context and the index into $ctx->words where the |
---|
| 53 | # filter expression starts |
---|
| 54 | my $ctx = shift; |
---|
| 55 | my $start = shift; |
---|
| 56 | my $o_comp = shift; |
---|
| 57 | my $end = $ctx->word; |
---|
| 58 | |
---|
| 59 | # Grab an expression; we don't allow empty |
---|
| 60 | my $i = $start; |
---|
| 61 | $i = _complete_filter_primitive_expr($ctx, $start, $o_comp); |
---|
[5fdc562] | 62 | return $INCOMPLETE if $i == $INCOMPLETE; |
---|
[a3a9eb7] | 63 | |
---|
| 64 | while ($i <= $end) { |
---|
| 65 | if ($i == $end) { |
---|
| 66 | # We could and/or another clause |
---|
| 67 | push @$o_comp, qw(and or); |
---|
| 68 | return $end; # Or we could let the parent do his thing |
---|
| 69 | } |
---|
| 70 | |
---|
| 71 | if ($ctx->words->[$i] ne 'and' && $ctx->words->[$i] ne 'or') { |
---|
| 72 | return $i; # We're done. Let the parent do his thing |
---|
| 73 | } |
---|
| 74 | |
---|
| 75 | # Eat the and/or |
---|
| 76 | $i++; |
---|
| 77 | |
---|
| 78 | # Grab an expression |
---|
| 79 | $i = _complete_filter_primitive_expr($ctx, $i, $o_comp); |
---|
| 80 | return $INCOMPLETE if $i == $INCOMPLETE; |
---|
| 81 | } |
---|
| 82 | |
---|
| 83 | return $i; # Well, it looks like we're happy |
---|
| 84 | # (Actually, I'm pretty sure this never happens...) |
---|
| 85 | } |
---|
| 86 | |
---|
| 87 | sub _complete_filter_primitive_expr { |
---|
| 88 | my $ctx = shift; |
---|
| 89 | my $start = shift; |
---|
| 90 | my $o_comp = shift; |
---|
| 91 | my $end = $ctx->word; |
---|
| 92 | |
---|
| 93 | if ($start >= $end) { |
---|
| 94 | push @$o_comp, "("; |
---|
| 95 | push @$o_comp, qw(true false not); |
---|
| 96 | push @$o_comp, keys %filter_cmds; |
---|
| 97 | return $INCOMPLETE; |
---|
| 98 | } |
---|
| 99 | |
---|
| 100 | my $word = $ctx->words->[$start]; |
---|
| 101 | if ($word eq "(") { |
---|
| 102 | $start = _complete_filter_expr($ctx, $start+1, $o_comp); |
---|
| 103 | return $INCOMPLETE if $start == $INCOMPLETE; |
---|
| 104 | |
---|
| 105 | # Now, we expect a ")" |
---|
| 106 | if ($start >= $end) { |
---|
| 107 | push @$o_comp, ")"; |
---|
| 108 | return $INCOMPLETE; |
---|
| 109 | } |
---|
| 110 | if ($ctx->words->[$start] ne ')') { |
---|
| 111 | # User is being confusing. Give up. |
---|
| 112 | return $INCOMPLETE; |
---|
| 113 | } |
---|
| 114 | return $start+1; # Eat the ) |
---|
| 115 | } elsif ($word eq "not") { |
---|
| 116 | # We just want another primitive expression |
---|
| 117 | return _complete_filter_primitive_expr($ctx, $start+1, $o_comp); |
---|
| 118 | } elsif ($word eq "true" || $word eq "false") { |
---|
| 119 | # No arguments |
---|
| 120 | return $start+1; # Eat the boolean. Mmmm, tasty. |
---|
| 121 | } else { |
---|
| 122 | # It's of the form 'CMD ARG' |
---|
| 123 | return $start+2 if ($start+1 < $end); # The user supplied the argument |
---|
| 124 | |
---|
| 125 | # complete the argument |
---|
| 126 | my $arg_func = $filter_cmds{$word}; |
---|
| 127 | push @$o_comp, ($arg_func ? ($arg_func->()) : ()); |
---|
| 128 | return $INCOMPLETE; |
---|
| 129 | } |
---|
| 130 | } |
---|