changed old filter be a hash with a name

data dumper all the references in the stat/chan etc type commands
(ie do this in promptf and displayallfields)

diff --git a/Changes b/Changes
index 654c48472301f8686840f8aa74c6ec9cf97b6201..d242d3014f4f94081df4c04e7b67ae918ac6970a 100644 (file)
--- a/Changes
+++ b/Changes
@@ -3,7 +3,8 @@
 shouldn't take steps to prevent echoing on node links, but it may help where
 (whatever you do) it still bloody echos! This is experimental.
 2. store dxchan and mynode as callsigns (and not references) in the routing 
-tables and do some checking in accessors to see if we can capture some errors. 
+tables and do some checking in accessors to see if we can capture some errors.
+3. tart up the stat/chan etc display to give more useful debugging info 
 28Oct00=======================================================================
 1. updated show/sun and show/moon from stuff sent by Steve Franke K9AN
 2. added show/call which queries jeifer.pineknot.com for any call in the 

diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm
index 2c05372c0f31b2d198a8959900ef8e2827b44817..21ae3e2354e620b7607e265adcf8c747cdb76ad0 100644 (file)
--- a/perl/DXUtil.pm
+++ b/perl/DXUtil.pm
@@ -130,6 +130,12 @@ sub promptf
        if ($action) {
                my $q = qq{\$value = $action(\$value)};
                eval $q;
+       } elsif (ref $value) {
+               my $dd = new Data::Dumper([$value]);
+               $dd->Indent(0);
+               $dd->Terse(1);
+               $dd->Quotekeys($] < 5.005 ? 1 : 0);
+               $value = $dd->Dumpxs;
        }
        $prompt = sprintf "%15s: %s", $prompt, $value;
        return ($priv, $prompt);
@@ -175,7 +181,21 @@ sub print_all_fields
        foreach $field (sort {$ref->field_prompt($a) cmp $ref->field_prompt($b)} @fields) {
                if (defined $ref->{$field}) {
                        my ($priv, $ans) = promptf($ref->field_prompt($field), $ref->{$field});
-                       push @out, $ans if ($self->priv >= $priv);
+                       my @tmp;
+                       if (length $ans > 79) {
+                               my ($p, $a) = split /: /, $ans;
+                               my $l = (length $p) + 2;
+                               my $al = 79 - $l;
+                               while (length $a > $al ) {
+                                       $a =~ s/^(.{$al})//;
+                                       push @tmp, "$p: $1";
+                                       $p = ' ' x ($l - 2);
+                               }
+                               push @tmp, "$p: $a" if length $a;
+                       } else {
+                               push @tmp, $ans;
+                       }
+                       push @out, @tmp if ($self->priv >= $priv);
                }
        }
        return @out;

diff --git a/perl/Filter.pm b/perl/Filter.pm
index 2b30c8cdea5c8484ca348e21442464cf50c9fe65..d45f5096ac8e0ab7ef2226ac7052c1dd133a6252 100644 (file)
--- a/perl/Filter.pm
+++ b/perl/Filter.pm
@@ -72,7 +72,9 @@ sub read_in
                my $s = readfilestr($fn);
                my $newin = eval $s;
                dbg('conn', "$@") if $@;
-               return bless [ @$in ], 'Filter::Old' if $in;
+               if ($in) {
+                       $newin = bless {filter => $in, name => "$flag$call.pl" }, 'Filter::Old'
+               }
                return $newin;
        }
        return undef;
@@ -83,44 +85,12 @@ sub read_in
 sub write
 {
        my $self = shift;
-       
-       my $sort = shift;
-       my $call = shift;
-       my $fn = "$filterbasefn/$sort";
-       
-       
-       # make the output directory
-       mkdir $fn, 0777 unless -e $fn;
-
-       # write out the file
-       $fn = "$fn/$call.pl";
-       unless (open FILTER, ">$fn") {
-               warn "can't open $fn $!" ;
-               return;
-       }
-
-       my $today = localtime;
-       print FILTER "#!/usr/bin/perl
-#
-# Filter for $call stored $today
-#
-\$in = [
-";
+}
 
-       my $ref;
-       for $ref (@_) {
-               my ($action, $field, $fieldsort, $comp, $actiondata) = @{$ref};
-               print FILTER "\t[ $action, $field, $fieldsort,";
-               if ($fieldsort eq 'n' || $fieldsort eq 'r') {
-                       print FILTER "[ ", join (',', $comp), " ],";
-               } elsif ($fieldsort eq 'a') {
-                       my $f = $comp;
-               print FILTER "'$f'";
-               }
-               print FILTER " ],\n";
-       }
-       print FILTER "];\n";
-       close FILTER;
+sub print
+{
+       my $self = shift;
+       return $self->{name};
 }
 
 package Filter::Old;
@@ -161,7 +131,8 @@ use vars qw(@ISA);
 #
 sub it
 {
-       my $filter = shift;            # this is now a bless ref of course but so what
+       my $self = shift;
+       my $filter = $self->{filter};            # this is now a bless ref of course but so what
        
        my ($action, $field, $fieldsort, $comp, $actiondata);
        my $ref;