From: Graham B. <gb...@po...> - 2000-08-24 17:07:30
|
This is great and I will add it in. However given Benchmark: timing 1000 iterations of load, parse, storable... load: 28 wallclock secs (28.29 usr + 0.19 sys = 28.48 CPU) parse: 123 wallclock secs (122.90 usr + 0.06 sys = 122.96 CPU) storable: 4 wallclock secs ( 3.97 usr + 0.16 sys = 4.13 CPU) It seems like it could be worth using storable. But is takes 0.02 to loas Storable, so the benefit is lost. However I am thinking, is this really worth it ? According to the above the parse is taking 0.122 seconds and the load takes 0.028 a saving of 0.1 seconds at startup time. Even you times only said it saved 0.24, is this extra maintenance (ie any change to the parse tree will need to be accounted for) really woth that extra 0.24 seconds ? Graham. On Mon, Aug 21, 2000 at 12:44:05AM +0100, John Berthels wrote: > > OK - here is the second cut of the Convert::ASN1 save/load. I've reworked > it in the light of Graham's comments. (Including those on recursion :-) > > Attached is a gzipped tar with the patch for Convert/ASN1.pm, an > 'ldap.asn' file and an 'Net/LDAP/ASN.pm.new' which you need to use the > ->load method when you start Net::LDAP. Patch is against version 0.07 of > ASN1.pm (i.e. the current CPAN rather than the current CVS). > > The fastest load time for this I've seen is 0.31s, against a fastest load > time of 0.55s for the current code. (This is looking at 'time > -MNet::LDAP::ASN -e exit'). > > Using '-d:DProf' and looking at the CumulS column: The new ->load function > takes ~0.07s and the old ->prepare function takes ~0.31s. These > measurements seem to agree with the 'time' method and suggest a nice > speedup. > > The format of the ldap.asn file should now be more obvious to humans. > > The empty tag bug should be fixed. > > It tests out OK with my test app here. YMMV. > > regards, > > jb > --- /usr/lib/perl5/site_perl/5.005/Convert/ASN1.pm Tue May 30 10:00:01 2000 > +++ Convert/ASN1.pm Mon Aug 21 00:09:19 2000 > @@ -7,6 +7,7 @@ > use strict; > use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS @opParts @opName $AUTOLOAD); > use Exporter; > +#se Data::Dumper; > > BEGIN { > @ISA = qw(Exporter); > @@ -138,6 +139,219 @@ > $self->{tree} = _pack_struct($tree); > $self->{script} = (values %$tree)[0]; > $self; > +} > + > +# > +# Here we provide for dumping and reloading the ASN.1 tree from a file. > +# Essentially this allows us to skip the 'prepare' method by doing a 'load' > +# instead. > +# > +sub save { > + my $self = shift; > + my $file = shift; > + > + open( OUT, "> $file" ) or die( "Can't write to file [$file] : $!" ); > +# Data::Dumper version > +# print OUT Data::Dumper->Dump( [$self], [ '$asn' ] ); > +# close OUT; > +# return 1; > + my $tree = $self->{tree}; > + my %seen; # Avoid writing same ref twice > + my( $name, $base ); > + while( ( $name, $base ) = each %$tree ) { > + # Start a new ASN.1 type definition > + print OUT $name, ":", _ref_to_name( $base ), "\n"; > + foreach my $op ( @$base ) { > + _write_op_tree( \*OUT, $base, \%seen ) > + or die( "Unable to write op for [$name] : $!" ); > + } > + print OUT "\n"; # End of type > + } > + close OUT; > + > + return 1; > +} > + > +# > +# We have two kinds of reference. An 'op' which has an ASN.1 tag > +# and a plain array reference (AR). OPs may have an AR references as their > +# cCHILD parameter and ARs contain OPs. > +# Since we label each reference, the order we write out in does not matter. > +# > +sub _write_op_tree { > + my $fh = shift; > + my $base = shift; > + my $seen = shift; > + > + my @ars = ( $base ); # List of array refs to write > + my @ops; # List of ops to write > + while( @ars || @ops) { > + if( @ars ) { > + my $array = shift @ars; > + next if $seen->{$array}; # Already written, so skip > + _write_ar( $fh, $array ) # Do the output > + or return undef; > + $seen->{$array}++; # Remember > + push @ops, @$array; # And remember the contents > + } > + if( @ops ) { > + my $op = shift @ops; > + next if $seen->{$op}; > + _write_op( $fh, $op ) > + or return undef; > + $seen->{$op}++; > + if( ref $op->[cCHILD] eq "ARRAY" ) { > + push @ars, $op->[cCHILD]; > + } > + } > + } > + > + return 1; > +} > + > +sub _write_ar { > + my $fh = shift; > + my $array = shift; > + > + my $name = _ref_to_name( $array ); > + print $fh $name, "["; > + print $fh join( ",", map { _ref_to_name( $_ ) } @$array ); > + print $fh "]\n"; > + > + return 1; > +} > + > + > +sub _write_op { > + my $fh = shift; > + my $op = shift; > + > +# cTAG cTYPE cVAR cLOOP cOPT cCHILD > + > + my $name = _ref_to_name( $op ); > + print $fh $name, ":"; > + my @line; > + push @line, defined( $op->[cTAG] ) > + ? ($op->[cTAG] eq '') > + ? '' > + : ord $op->[cTAG] > + : "_"; > + push @line, $op->[cTYPE]; > + push @line, defined( $op->[cVAR] ) ? $op->[cVAR] : "_"; > + push @line, defined( $op->[cLOOP] ) ? $op->[cLOOP] : "_"; > + push @line, defined( $op->[cOPT] ) ? $op->[cOPT] : "_"; > + > + if( ref $op->[cCHILD] eq "ARRAY" ) { > + push @line, _ref_to_name( $op->[cCHILD] ); > + } > + else { > + push @line, "_"; > + } > + print $fh join( ",", @line ), "\n"; > + > + return 1; > +} > + > +# We could use nice names here. At the moment, just use address. This > +# is techically naughty since we assume something about their structure. > +# A cleaner way would be to remember which we have seen and assign unique > +# ids. > +sub _ref_to_name { > + my $name = shift; > + return "_" unless defined $name; > + $name =~ s/^.*\(//; > + $name =~ s/\).*$//; > + return $name; > +} > + > +# > +# Read in the output of a 'save'. Here we overwrite the 'tree' and the > +# 'script' in $self, just as if prepare had been called. Could probably > +# share a few lines with ->prepare here and/or add some automagic to the > +# args its args to take a saved file instead. > +# > +sub load { > + my $self = shift; > + my $file = shift; > + > +# Data::Dumper version > +# my $asn; > +# require $file or die( "Can't load file : $!" ); > +# $self = $asn; > +# return 1; > + > + my $tree = {}; # This is the structure we are building > + my %refs; # And here we map ID -> array reference > + > + open( IN, "< $file" ) or die( "Unable to open file [$file] : $!" ); > + > + my $at_start = 1; > + my $line; > + while( $line = <IN> ) { > + chomp $line; > + > + unless( $line ) { > + $at_start = 1; > + next; > + } > + > + if( $at_start ) { > + my( $name, $id ) = split( /:/, $line, 2 ); > + die( "Invalid record start line [$line]" ) unless $name && $id; > + $tree->{$name} = _id2ref( $id, \%refs ); > + $at_start = 0; > + next; > + } > + > + my( $id, $line ) = split( /[:[]/, $line, 2 ); > + die( "Invalid input line [$line]" ) unless $id && $line; > + > + # Get or create + store ref for this ID > + my $ref = _id2ref( $id, \%refs ); > + > + if( $line =~ /]$/ ) { > + # This is an array of IDs. Store in @$ref. > + # Create them if neccesary. > + $line =~ s/\]$//; > + my @ids = split( /,/, $line ); > + foreach my $child_id ( @ids ) { > + die( "Invalid id [$line]" ) unless $child_id; > + push @$ref, _id2ref( $child_id, \%refs ); > + } > + } > + else { > + # This is a tag definition - cTAG cTYPE cVAR cLOOP cOPT cCHILD > +# $line =~ s/^.//; > + > + my @bits = split( /,/, $line ); > + my $tag = shift @bits; > + push @$ref, ($tag eq "_") ? undef > + : ($tag eq '') ? '' > + : chr $tag; > + my $val; > + while( $val = shift @bits ) { > + push @$ref, ($val eq "_") ? undef : $val; > + } > + # > + # If last val was an id. Map it to a ref. > + # > + $ref->[cCHILD] = _id2ref( $ref->[cCHILD], \%refs ) > + if( defined $ref->[cCHILD] ); > + } > + } > + close IN; > + > + $self->{tree} = $tree; > + $self->{script} = (values %$tree)[0]; > + > + return 1; > +} > + > +sub _id2ref { > + my $id = shift; > + my $refs = shift; > + > + return ( $refs->{$id} ||= [] ); > } > > # In XS the will convert the tree between perl and C structs |