Skip Menu |
 

This queue is for tickets about the Net-DNS CPAN distribution.

Report information
The Basics
Id: 67570
Status: resolved
Priority: 0/
Queue: Net-DNS

People
Owner: Nobody in particular
Requestors: WolfSage [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Important
Broken in: 0.66
Fixed in: (no value)



Subject: wire2presentation performance enhancements [patches]
Download (untitled) / with headers
text/plain 1.9k
The wire2presentation method is somewhat slow. Attached is a patch against 0.66 that includes a rewrite of it that I believe is correct. If the patch won't apply, the replacement method is included in wire2presentation.txt. 'make test' passes with this patch. My benchmarks against it show that in the cases I've tried, the new code is significantly faster: mhorsfall@Fireforge:~/Development/NetDNS$ ./bm_w2p.pl STRING: a Benchmark: timing 1000000 iterations of new, old... new: 2 wallclock secs ( 1.09 usr + 0.00 sys = 1.09 CPU) @ 917431.19/s (n=1000000) old: 3 wallclock secs ( 3.01 usr + 0.00 sys = 3.01 CPU) @ 332225.91/s (n=1000000) STRING: www Benchmark: timing 1000000 iterations of new, old... new: 0 wallclock secs ( 1.09 usr + 0.00 sys = 1.09 CPU) @ 917431.19/s (n=1000000) old: 6 wallclock secs ( 5.66 usr + 0.02 sys = 5.68 CPU) @ 176056.34/s (n=1000000) STRING: mail Benchmark: timing 1000000 iterations of new, old... new: 0 wallclock secs ( 1.13 usr + 0.01 sys = 1.14 CPU) @ 877192.98/s (n=1000000) old: 6 wallclock secs ( 6.95 usr + 0.01 sys = 6.96 CPU) @ 143678.16/s (n=1000000) STRING: exampleoflongerlabel Benchmark: timing 1000000 iterations of new, old... new: 2 wallclock secs ( 1.47 usr + 0.00 sys = 1.47 CPU) @ 680272.11/s (n=1000000) old: 27 wallclock secs (26.62 usr + 0.07 sys = 26.69 CPU) @ 37467.22/s (n=1000000) STRING: t.is.@$(asdf)blah"meh Benchmark: timing 1000000 iterations of new, old... new: 9 wallclock secs ( 8.74 usr + 0.03 sys = 8.77 CPU) @ 114025.09/s (n=1000000) old: 27 wallclock secs (26.59 usr + 0.07 sys = 26.66 CPU) @ 37509.38/s (n=1000000) STRING: ! ~abcd^?^@ Benchmark: timing 1000000 iterations of new, old... new: 6 wallclock secs ( 6.70 usr + -0.00 sys = 6.70 CPU) @ 149253.73/s (n=1000000) old: 14 wallclock secs (13.08 usr + 0.04 sys = 13.12 CPU) @ 76219.51/s (n=1000000) I've included the benchmark code as well. Hope this one helps too :)
Subject: wire2presentation.patch.txt
Only in Net-DNS-0.66: blib Only in Net-DNS-0.66: DNS.bs Only in Net-DNS-0.66: DNS.c Only in Net-DNS-0.66: DNS.o diff -u -r Net-DNS-0.66/lib/Net/DNS.pm Net-DNS-0.66-fast/lib/Net/DNS.pm --- Net-DNS-0.66/lib/Net/DNS.pm 2009-12-30 06:01:39.000000000 -0500 +++ Net-DNS-0.66-fast/lib/Net/DNS.pm 2011-04-18 21:26:14.000000000 -0400 @@ -1,4 +1,3 @@ - package Net::DNS; # # $Id: DNS.pm 829 2009-12-23 15:39:59Z olaf $ @@ -424,43 +423,16 @@ sub wire2presentation { - my $wire=shift; - my $presentation=""; - my $length=length($wire); - # There must be a nice regexp to do this.. but since I failed to - # find one I scan the name string until I find a '\', at that time - # I start looking forward and do the magic. + my $presentation=shift; # Really wire... - my $i=0; - - while ($i < $length ){ - my $char=unpack("x".$i."C1",$wire); - if ( $char < 33 || $char > 126 ){ - $presentation.= sprintf ("\\%03u" ,$char); - }elsif ( $char == ord( "\"" )) { - $presentation.= "\\\""; - }elsif ( $char == ord( "\$" )) { - $presentation.= "\\\$"; - }elsif ( $char == ord( "(" )) { - $presentation.= "\\("; - }elsif ( $char == ord( ")" )) { - $presentation.= "\\)"; - }elsif ( $char == ord( ";" )) { - $presentation.= "\\;"; - }elsif ( $char == ord( "@" )) { - $presentation.= "\\@"; - }elsif ( $char == ord( "\\" )) { - $presentation.= "\\\\" ; - }elsif ( $char==ord (".") ){ - $presentation.= "\\." ; - }else{ - $presentation.=chr($char) ; - } - $i++; - } + # Prepend these with a backslash + $presentation =~ s/(["$();@.\\])/\\$1/g; + + # Convert < 33 and > 126 to \x<\d\d\d> + $presentation =~ s/([^\x21-\x7E])/sprintf("\\%03u", ord($1))/eg; return $presentation; - + } Only in Net-DNS-0.66: Makefile Only in Net-DNS-0.66-fast/: Makefile.old Only in Net-DNS-0.66: netdns.a Only in Net-DNS-0.66: netdns.o Only in Net-DNS-0.66: pm_to_blib Only in Net-DNS-0.66-fast/: presentation2wire.txt Only in Net-DNS-0.66/t: online.enabled Only in Net-DNS-0.66-fast/: wire2presentation.txt
Subject: wire2presentation.txt
sub wire2presentation { my $presentation=shift; # Really wire... # Prepend these with a backslash $presentation =~ s/(["$();@.\\])/\\$1/g; # Convert < 33 and > 126 to \x<\d\d\d> $presentation =~ s/([^\x21-\x7E])/sprintf("\\%03u", ord($1))/eg; return $presentation; }
Subject: bm_w2p.pl
Download bm_w2p.pl
text/x-perl 1.7k
#!/usr/bin/perl use strict; use warnings; use Data::Dumper; use Benchmark qw(timethese); my @strings = qw( a www mail exampleoflongerlabel t.is.@$(asdf)blah"meh ); push @strings, join('', map { chr(hex($_)) } (qw(21 20 7E 61 62 63 64 7F 00))); for my $string (@strings) { print "\nSTRING: $string\n"; timethese(1_000_000, { 'old' => sub { my $f = old($string); }, 'new' => sub { my $f = new($string); }, }); } sub old { my $wire=shift; my $presentation=""; my $length=length($wire); # There must be a nice regexp to do this.. but since I failed to # find one I scan the name string until I find a '\', at that time # I start looking forward and do the magic. my $i=0; while ($i < $length ){ my $char=unpack("x".$i."C1",$wire); if ( $char < 33 || $char > 126 ){ $presentation.= sprintf ("\\%03u" ,$char); }elsif ( $char == ord( "\"" )) { $presentation.= "\\\""; }elsif ( $char == ord( "\$" )) { $presentation.= "\\\$"; }elsif ( $char == ord( "(" )) { $presentation.= "\\("; }elsif ( $char == ord( ")" )) { $presentation.= "\\)"; }elsif ( $char == ord( ";" )) { $presentation.= "\\;"; }elsif ( $char == ord( "@" )) { $presentation.= "\\@"; }elsif ( $char == ord( "\\" )) { $presentation.= "\\\\" ; }elsif ( $char==ord (".") ){ $presentation.= "\\." ; }else{ $presentation.=chr($char) ; } $i++; } return $presentation; } sub new { my $presentation=shift; # Really wire... # Prepend these with a backslash $presentation =~ s/(["$();@.\\])/\\$1/g; # Convert < 33 and > 126 to \x<\d\d\d> $presentation =~ s/([^\x21-\x7E])/sprintf("\\%03u", ord($1))/eg; return $presentation; }
Download (untitled) / with headers
text/plain 419b
Hi Wolfsage, The patch looks very solid and it passes all the tests (notably t/11-escapedchart.t) on my system. However I am not completely sure the regexps are always evaluated on bytes and not characters. I wish to do a bit more experimentation on different systems to be fully convinced it is always safe. Your patches are therefore scheduled for the 0.68 release and not the upcoming 0.67. Okay? Thanks, -- Willem
Download (untitled) / with headers
text/plain 694b
On Wed Oct 19 16:48:09 2011, WILLEM wrote: Show quoted text
> Hi Wolfsage, > > The patch looks very solid and it passes all the tests (notably > t/11-escapedchart.t) on my system. However I am not completely sure the > regexps are always evaluated on bytes and not characters. I wish to do a > bit more experimentation on different systems to be fully convinced it > is always safe. Your patches are therefore scheduled for the 0.68 > release and not the upcoming 0.67. Okay? > Thanks, > > -- Willem
Hey Willem, it looks like this still hasn't gone out. Is this still under test/review? If it's solid I'd love to see the performance enhancement make it out. Thanks, -- Matthew Horsfall (alh) http://dyn.com
Download (untitled) / with headers
text/plain 344b
On Wed 15 Aug 2012 14:04:00, WOLFSAGE wrote: Show quoted text
> Hey Willem, it looks like this still hasn't gone out. Is this still > under test/review? If it's solid I'd love to see the performance > enhancement make it out.
Hi Matthew, Your contribution is in current trunk (sice february the 27th) and will thus be in the next release. Cheers, -- Willem


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.