From 647730580f6fe6ad14ee8445f0d5d583390cb130 Mon Sep 17 00:00:00 2001
From: minima <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