+ my $name = shift || $self->{name};
+ my $sort = shift || $self->{sort};
+ my $flag = shift || "";
+ my @out;
+ $name =~ s/.pl$//;
+
+ push @out, join(' ', $name , ':', $sort, $flag);
+ my $filter;
+ my $key;
+ foreach $key (sort $self->getfilkeys) {
+ my $filter = $self->{$key};
+ if (exists $filter->{reject} && exists $filter->{reject}->{user}) {
+ push @out, ' ' . join(' ', $key, 'reject', $filter->{reject}->{user});
+ }
+ if (exists $filter->{accept} && exists $filter->{accept}->{user}) {
+ push @out, ' ' . join(' ', $key, 'accept', $filter->{accept}->{user});
+ }
+ }
+ return @out;
+}
+
+sub install
+{
+ my $self = shift;
+ my $remove = shift;
+ my $name = uc $self->{name};
+ my $sort = $self->{sort};
+ my $in = "";
+ $in = "in" if $name =~ s/^IN_//;
+ $name =~ s/.PL$//;
+
+ my $dxchan;
+ my @dxchan;
+ if ($name eq 'NODE_DEFAULT') {
+ @dxchan = DXChannel::get_all_nodes();
+ } elsif ($name eq 'USER_DEFAULT') {
+ @dxchan = DXChannel::get_all_users();
+ } else {
+ $dxchan = DXChannel::get($name);
+ push @dxchan, $dxchan if $dxchan;
+ }
+ foreach $dxchan (@dxchan) {
+ my $n = "$in$sort" . "filter";
+ my $i = $in ? 'IN_' : '';
+ my $ref = $dxchan->$n();
+ if (!$ref || ($ref && uc $ref->{name} eq "$i$name.PL")) {
+ $dxchan->$n($remove ? undef : $self);
+ }
+ }
+}
+
+sub delete
+{
+ my ($sort, $call, $flag, $fno) = @_;
+
+ # look for the file
+ my $fn = getfn($sort, $call, $flag);
+ my $filter = read_in($sort, $call, $flag);
+ if ($filter) {
+ if ($fno eq 'all') {
+ my $key;
+ foreach $key ($filter->getfilkeys) {
+ delete $filter->{$key};
+ }
+ } elsif (exists $filter->{"filter$fno"}) {
+ delete $filter->{"filter$fno"};
+ }
+
+ # get rid
+ if ($filter->{hops} || $filter->getfilkeys) {
+ $filter->install;
+ $filter->write;
+ } else {
+ $filter->install(1);
+ unlink $fn;
+ }
+ }
+}
+
+package Filter::Cmd;
+
+use strict;
+use DXVars;
+use DXUtil;
+use DXDebug;
+use vars qw(@ISA);
+@ISA = qw(Filter);
+
+# the general purpose command processor
+# this is called as a subroutine not as a method
+sub parse
+{
+ my ($self, $dxchan, $sort, $line) = @_;
+ my $ntoken = 0;
+ my $fno = 1;
+ my $filter;
+ my ($flag, $call);
+ my $s;
+ my $user;
+
+ # check the line for non legal characters
+ return ('ill', $dxchan->msg('e19')) if $line =~ /[^\s\w,_\-\*\/\(\)!]/;
+
+ # add some spaces for ease of parsing
+ $line =~ s/([\(\)])/ $1 /g;
+ $line = lc $line;
+
+ my @f = split /\s+/, $line;
+ my $conj = ' && ';
+ my $not = "";
+ while (@f) {
+ if ($ntoken == 0) {
+
+ if (@f && $dxchan->priv >= 8 && ((is_callsign(uc $f[0]) && DXUser::get(uc $f[0])) || $f[0] =~ /(?:node|user)_default/)) {
+ $call = shift @f;
+ if ($f[0] eq 'input') {
+ shift @f;
+ $flag++;
+ }
+ } else {
+ $call = $dxchan->call;
+ }
+
+ if (@f && $f[0] =~ /^\d$/) {
+ $fno = shift @f;
+ }
+
+ $filter = Filter::read_in($sort, $call, $flag);
+ $filter = Filter->new($sort, $call, $flag) if !$filter || $filter->isa('Filter::Old');
+
+ $ntoken++;
+ next;
+ }
+
+ # do the rest of the filter tokens
+ if (@f) {
+ my $tok = shift @f;
+ if ($tok eq '(') {
+ if ($s) {
+ $s .= $conj;
+ $user .= $conj;
+ $conj = "";
+ }
+ if ($not) {
+ $s .= $not;
+ $user .= $not;
+ $not = "";
+ }
+ $s .= $tok;
+ $user .= $tok;
+ next;
+ } elsif ($tok eq ')') {
+ $conj = ' && ';
+ $not ="";
+ $s .= $tok;
+ $user .= $tok;
+ next;
+ } elsif ($tok eq 'all') {
+ $s .= '1';
+ $user .= $tok;
+ last;
+ } elsif ($tok eq 'or') {
+ $conj = ' || ' if $conj ne ' || ';
+ next;
+ } elsif ($tok eq 'and') {
+ $conj = ' && ' if $conj ne ' && ';
+ next;
+ } elsif ($tok eq 'not' || $tok eq '!') {
+ $not = '!';
+ next;
+ }
+ if (@f) {
+ my $val = shift @f;
+ my @val = split /,/, $val;
+
+ if ($s) {
+ $s .= $conj ;
+ $user .= $conj;
+ $conj = ' && ';
+ }
+
+ if ($not) {
+ $s .= $not;
+ $user .= $not;
+ $not = '';
+ }
+
+ $user .= "$tok $val";
+
+ my $fref;
+ my $found;
+ foreach $fref (@$self) {
+
+ if ($fref->[0] eq $tok) {
+ if ($fref->[4]) {
+ my @nval;
+ for (@val) {
+ push @nval, split(',', &{$fref->[4]}($dxchan, $_));
+ }
+ @val = @nval;
+ }
+ if ($fref->[1] eq 'a') {
+ my @t;
+ for (@val) {
+ s/\*//g;
+ push @t, "\$r->[$fref->[2]]=~/$_/i";
+ }
+ $s .= "(" . join(' || ', @t) . ")";
+ } elsif ($fref->[1] eq 'c') {
+ my @t;
+ for (@val) {
+ s/\*//g;
+ push @t, "\$r->[$fref->[2]]=~/^\U$_/";
+ }
+ $s .= "(" . join(' || ', @t) . ")";
+ } elsif ($fref->[1] eq 'n') {
+ my @t;
+ for (@val) {
+ return ('num', $dxchan->msg('e21', $_)) unless /^\d+$/;
+ push @t, "\$r->[$fref->[2]]==$_";
+ }
+ $s .= "(" . join(' || ', @t) . ")";
+ } elsif ($fref->[1] =~ /^n[ciz]$/ ) { # for DXCC, ITU, CQ Zone
+ my $cmd = $fref->[1];
+ my @pre = Prefix::to_ciz($cmd, @val);
+ return ('numpre', $dxchan->msg('e27', $_)) unless @pre;
+ $s .= "(" . join(' || ', map {"\$r->[$fref->[2]]==$_"} @pre) . ")";
+ } elsif ($fref->[1] =~ /^ns$/ ) { # for DXCC, ITU, CQ Zone
+ my $cmd = $fref->[1];
+ my @pre = Prefix::to_ciz($cmd, @val);
+ return ('numpre', $dxchan->msg('e27', $_)) unless @pre;
+ $s .= "(" . "!\$USDB::present || grep \$r->[$fref->[2]] eq \$_, qw(" . join(' ' ,map {uc} @pre) . "))";
+ } elsif ($fref->[1] eq 'r') {
+ my @t;
+ for (@val) {
+ return ('range', $dxchan->msg('e23', $_)) unless /^(\d+)\/(\d+)$/;
+ push @t, "(\$r->[$fref->[2]]>=$1 && \$r->[$fref->[2]]<=$2)";
+ }
+ $s .= "(" . join(' || ', @t) . ")";
+ } elsif ($fref->[1] eq 't') {
+ my @t;
+ for (@val) {
+ s/\*//g;
+ push @t, "\$r->[$fref->[2]]=~/$_/i";
+ }
+ $s .= "(" . join(' || ', @t) . ")";
+ } else {
+ confess("invalid letter $fref->[1]");
+ }
+ ++$found;
+ last;
+ }
+ }
+ return ('unknown', $dxchan->msg('e20', $tok)) unless $found;
+ } else {
+ return ('no', $dxchan->msg('filter2', $tok));
+ }
+ }
+
+ }
+
+ # tidy up the user string
+ $user =~ s/\&\&/ and /g;
+ $user =~ s/\|\|/ or /g;
+ $user =~ s/\!/ not /g;
+ $user =~ s/\s+/ /g;
+
+ return (0, $filter, $fno, $user, "$s");
+}
+
+# a filter accept/reject command
+sub cmd
+{
+ my ($self, $dxchan, $sort, $type, $line) = @_;
+
+ return $dxchan->msg('filter5') unless $line;
+
+ my ($r, $filter, $fno, $user, $s) = $self->parse($dxchan, $sort, $line);
+ my $u = DXUser::get_current($user);
+ return (1, $dxchan->msg('isow', $user)) if $u && $u->isolate;
+ return (1, $filter) if $r;
+
+ my $fn = "filter$fno";
+
+ $filter->{$fn} = {} unless exists $filter->{$fn};
+ $filter->{$fn}->{$type} = {} unless exists $filter->{$fn}->{$type};
+
+ $filter->{$fn}->{$type}->{user} = $user;
+ $filter->{$fn}->{$type}->{asc} = $s;
+ $r = $filter->compile($fn, $type);
+ return (1,$r) if $r;
+
+ $r = $filter->write;
+ return (1,$r) if $r;
+
+ $filter->install;
+
+ return (0, $filter, $fno);