From 647730580f6fe6ad14ee8445f0d5d583390cb130 Mon Sep 17 00:00:00 2001 From: minima Date: Sun, 29 Oct 2000 14:00:27 +0000 Subject: [PATCH] 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) --- Changes | 3 ++- perl/DXUtil.pm | 22 +++++++++++++++++++++- perl/Filter.pm | 49 ++++++++++--------------------------------------- 3 files changed, 33 insertions(+), 41 deletions(-) diff --git a/Changes b/Changes index 654c4847..d242d301 100644 --- 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 2c05372c..21ae3e23 100644 --- 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 2b30c8cd..d45f5096 100644 --- 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; -- 2.43.0