From eaec24b90ef3975b2196ba57498346e05ba1db2f Mon Sep 17 00:00:00 2001 From: minima Date: Sun, 4 Jun 2006 17:30:52 +0000 Subject: [PATCH] add some data::dumper tidying up. --- perl/DXUser.pm | 7 ++----- perl/DXUtil.pm | 32 +++++++++++++++++++++++--------- perl/DXXml.pm | 8 ++++---- 3 files changed, 29 insertions(+), 18 deletions(-) diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 413d56a6..bca3b1da 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -329,11 +329,7 @@ sub decode sub asc_encode { my $self = shift; - my $dd = new Data::Dumper([$self]); - $dd->Indent(0); - $dd->Terse(1); - $dd->Quotekeys($] < 5.005 ? 1 : 0); - return $dd->Dumpxs; + return dd($self); } # @@ -343,6 +339,7 @@ sub asc_decode { my $s = shift; my $ref; + $s =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg; eval '$ref = ' . $s; if ($@) { LogDbg('err', $@); diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index db52ad81..b329f51b 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -16,8 +16,10 @@ use Data::Dumper; use strict; use vars qw($VERSION $BRANCH); - -main::mkver($VERSION = q$Revision$) if main->can('mkver'); +$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); +$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); +$main::build += $VERSION; +$main::branch += $BRANCH; use vars qw(@month %patmap @ISA @EXPORT); @@ -28,7 +30,7 @@ require Exporter; filecopy ptimelist print_all_fields cltounix unpad is_callsign is_latlong is_qra is_freq is_digits is_pctext is_pcflag insertitem deleteitem - is_prefix + is_prefix dd ); @@ -132,6 +134,22 @@ sub yesno return $n ? $main::yes : $main::no; } +# provide a data dumpered version of the object passed +sub dd +{ + my $value = shift; + my $dd = new Data::Dumper([$value]); + $dd->Indent(0); + $dd->Terse(1); + $dd->Quotekeys($] < 5.005 ? 1 : 0); + $value = $dd->Dumpxs; + $value =~ s/([\r\n\t])/sprintf("%%%02X", ord($1))/eg; + $value =~ s/^\s*\[//; + $value =~ s/\]\s*$//; + + return $value; +} + # format a prompt with its current value and return it with its privilege sub promptf { @@ -143,12 +161,7 @@ sub promptf 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(0); - $value = $dd->Dumpxs; - $value =~ s/([\r\n\t])/sprintf("%%%02X", ord($1))/eg; + $value = dd($value); } $prompt = sprintf "%15s: %s", $prompt, $value; return ($priv, $prompt); @@ -366,6 +379,7 @@ sub is_prefix { return $_[0] =~ m!^(?:[A-Z]{1,2}\d+ | \d[A-Z]{1,2}\d+)!x # basic prefix } + # check that a PC protocol field is valid text sub is_pctext diff --git a/perl/DXXml.pm b/perl/DXXml.pm index 21a2c165..6bf1fa59 100644 --- a/perl/DXXml.pm +++ b/perl/DXXml.pm @@ -225,11 +225,11 @@ sub route $via ||= $self->{'-via'} || $self->{to}; unless ($via) { - dbg("XML: no route specified (" . $self->toxml . ")") if isdbg('chanerr'); + dbg("XML: no route specified (" . dd($self) . ")") if isdbg('chanerr'); return; } if (ref $fromdxchan && $via && $fromdxchan->call eq $via) { - dbg("XML: Trying to route back to source (" . $self->toxml . ")") if isdbg('chanerr'); + dbg("XML: Trying to route back to source (" . dd($self) . ")") if isdbg('chanerr'); return; } @@ -258,12 +258,12 @@ sub route } if ($fromdxchan->call eq $via) { - dbg("XML: Trying to route back to source (" . $self->toxml . ")") if isdbg('chanerr'); + dbg("XML: Trying to route back to source (" . dd($self) . ")") if isdbg('chanerr'); return; } if ($dxchan == $main::me) { - dbg("XML: Trying to route to me (" . $self->toxml . ")") if isdbg('chanerr'); + dbg("XML: Trying to route to me (" . dd($self) . ")") if isdbg('chanerr'); return; } -- 2.43.0