Mailing-List: contact commits-help@harmony.apache.org; run by ezmlm
Precedence: bulk
Reply-To: dev@harmony.apache.org
Content-Type: text/plain; charset="utf-8"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Subject: svn commit: r767492 [3/3] - in /harmony/standard/tools/jdwpdump: ./
 jdwp-dump jdwp-spec
Date: Wed, 22 Apr 2009 12:38:55 -0000
To: commits@harmony.apache.org
From: hindessm@apache.org
Message-Id: <20090422123855.4AF8E2388BA1@eris.apache.org>

Propchange: harmony/standard/tools/jdwpdump/jdwp-dump
------------------------------------------------------------------------------
    svn:executable = *

Added: harmony/standard/tools/jdwpdump/jdwp-spec
URL: http://svn.apache.org/viewvc/harmony/standard/tools/jdwpdump/jdwp-spec?rev=767492&view=auto
==============================================================================
--- harmony/standard/tools/jdwpdump/jdwp-spec (added)
+++ harmony/standard/tools/jdwpdump/jdwp-spec Wed Apr 22 12:38:54 2009
@@ -0,0 +1,330 @@
+#!/usr/bin/perl -w
+#
+# <@LICENSE>
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements.  See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to you under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License.  You may obtain a copy of the License at:
+#
+#     http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+# </@LICENSE>
+
+=head1 NAME
+
+jdwp-spec - Perl script for parsing JDWP spec HTML
+
+=head1 SYNOPSIS
+
+  # fetch the HTML
+  wget http://java.sun.com/javase/6/docs/platform/jpda/jdwp/jdwp-protocol.html
+
+  # necessary step to make the HTML more compliant/easier-to-parse
+  tidy -i jdwp-protocol.html  >jdwp-protocol.tidy.html
+
+  # produce the Perl data structure
+  jdwp-spec jdwp-protocol.tidy.html  >spec.pl
+
+  # optionally, tidy up the Perl data structure
+  perltidy -i=2 spec.pl
+
+  # now append spec.pl.tdy after the __DATA__ in jdwp-dump
+
+=head1 DESCRIPTION
+
+This script parses the JDWP specification HTML to produce a perl data
+structure for use by L<jdwp-dump>.  The HTML must be preprocessed by
+tidy (http://tidy.sf.net/) in order to produce supported HTML.
+
+=cut
+
+use strict;
+use YAML;
+use HTML::TreeBuilder;
+my $file = shift;
+my $root = HTML::TreeBuilder->new_from_file($file);
+#print $root->as_HTML,"\n";exit;
+
+print '#' x 61, "\n";
+print '##', ' ' x 57, "##\n";
+print "## THIS STRUCTURE WAS AUTOMATICALLY GENERATED BY jdwp-spec ##\n";
+print '##', ' ' x 57, "##\n";
+print '#' x 61, "\n";
+my $glob;
+my $spec = {};
+foreach my $section ($root->look_down(_tag => 'h4',
+                                      sub { $_[0]->as_text =~ / Constants/ })) {
+  my $section_name = clean_text($section->as_text);
+  $section_name =~ s/ Constants//;
+  my $type = lc $section_name;
+  print STDERR "Constants for $type\n";
+  my $table;
+  my @right = $section->right;
+  my $count = 0;
+  foreach my $right ($section->right) {
+    $count++ <= 3 or last;
+    next unless ($right && ref $right);
+    last if ($right->tag eq 'h4');
+    next unless ($right->tag eq 'table');
+    $table = $right;
+    last;
+  }
+  unless ($table) {
+    warn "No table in $section_name section?\n";
+    next;
+  }
+  $spec->{$type} = {};
+  foreach my $tr ($table->look_down(_tag => 'tr')) {
+    my @td = $tr->look_down(_tag => 'td') or next;
+    my ($name, $code, $desc) = map { clean_text($_) } @td;
+    $code =~ s/0x([A-Fa-f0-9]+)/hex($1)/e;
+    $glob->{$type}->{$name} = $code;
+    $spec->{$type}->{$code} =
+      {
+       name => $name,
+       desc => $desc,
+      };
+  }
+}
+
+$spec->{cmd_set} = {};
+foreach my $section ($root->look_down(_tag => 'h4',
+                                      sub {
+                                        $_[0]->as_text =~ / Command Set/
+                                      })) {
+  my $section_name = clean_text($section->as_text);
+  $section_name =~ s/\s+Command Set\s+\((\d+)\)//;
+  my $cmd_set_id = $1;
+  my $cmd_set_name = $section_name;
+  print STDERR "Commands for $cmd_set_name $cmd_set_id\n";
+  my $spec_cmd_set = $spec->{cmd_set}->{$cmd_set_id} =
+    {
+     name => $cmd_set_name,
+     cmd => {},
+    };
+  my $spec_cmd_hash = $spec_cmd_set->{cmd}; # shortcut to save typing
+  my $table;
+  my @right = $section->right;
+  while (@right) {
+    my $right = shift @right;
+    next unless ($right && ref $right);
+    last if ($right->tag eq 'h4');
+    #print "R: ", $right->tag, "\n";
+    next unless ($right->tag eq 'h5');
+    my $head_name = clean_text($right->as_text);
+    $head_name =~ s/(?:\s+Command)?\s+\((\d+)\)//;
+    my $cmd_id = $1;
+    my $cmd_name = $head_name;
+    my $our_spec = $spec_cmd_hash->{$cmd_id} = {};
+    $our_spec->{name} = $cmd_name;
+    while (@right) {
+      my $right = shift @right;
+      next unless ($right && ref $right);
+      if ($right->tag eq 'h5' or $right->tag eq 'h4') {
+        unshift @right, $right;
+        last;
+      }
+      #print "SR: ", $right->tag, "\n";
+      if ($right->tag eq 'dl') {
+        if ($cmd_set_id == 64 && $cmd_id == 100) {
+          parse_dl_event_composite($right, $our_spec);
+        } else {
+          parse_dl($right, $our_spec);
+        }
+      }
+    }
+  }
+}
+use Data::Dumper;
+$Data::Dumper::Quotekeys = 0;
+$Data::Dumper::Sortkeys = 1;
+print Data::Dumper->Dump([$spec],[qw/spec/]);
+
+exit;
+
+sub parse_dl {
+  my ($dl, $spec) = @_;
+  my $dt = $dl->look_down(_tag => 'dt', sub { $_[0]->as_text =~ /Out Data/i });
+  parse_dd(out => scalar $dt->right, $spec);
+  $dt = $dl->look_down(_tag => 'dt',
+                       sub { $_[0]->as_text =~ /Reply Data/i });
+  parse_dd(reply => scalar $dt->right, $spec);
+  $dt = $dl->look_down(_tag => 'dt',
+                       sub { $_[0]->as_text =~ /Error Data/i });
+  parse_dd_error(scalar $dt->right, $spec);
+}
+
+sub parse_dl_event_composite {
+  my ($dl, $spec) = @_;
+  my $dt = $dl->look_down(_tag => 'dt',
+                          sub { $_[0]->as_text =~ /Event Data/i });
+  parse_dd(out => scalar $dt->right, $spec);
+}
+
+sub parse_dd {
+  my ($type, $dd, $spec) = @_;
+  my $repeat;
+  my $sub;
+  unless ($dd && $dd->tag eq 'dd') {
+    print STDERR "No $type data?";
+    return;
+  }
+  my @list = ();
+  $spec->{$type} = \@list;
+  return if ($dd->as_text eq '(None)');
+
+  foreach my $tr ($dd->look_down(_tag => 'tr')) {
+    my @td = $tr->look_down(_tag => 'td') or next;
+
+    if ($td[0]->attr('colspan') eq '1' &&
+        $td[1]->attr('colspan') eq '4') {
+      # first level repeat item
+      my ($type,$name,$desc) = map { clean_text($_) } @td[1..3];
+      push @$repeat,
+        {
+         type => $type,
+         name => $name,
+         desc => $desc,
+        };
+      next;
+    }
+    if ($td[0]->attr('colspan') eq '2' &&
+        $td[1]->attr('colspan') eq '3') {
+      # second level repeat/case item
+      my ($type,$name,$desc) = map { clean_text($_) } @td[1..3];
+      push @{$sub},
+        {
+         type => $type,
+         name => $name,
+         desc => $desc,
+        };
+      next;
+    }
+    undef $sub;
+    if ($td[0]->attr('colspan') eq '1' &&
+        $td[1]->attr('colspan') eq '6') {
+      # start of second level repeat
+      my $subrepeat = $td[1]->look_down(_tag => 'i');
+      if ($subrepeat) {
+        my @sublist = ();
+        push @$repeat,
+          {
+           type => 'repeat',
+           name => clean_text($subrepeat->as_text),
+           items => \@sublist,
+          };
+        $sub = \@sublist;
+      } else {
+        print STDERR "          'unknown subrepeat?',\n";
+      }
+      next;
+    }
+    if ($td[0]->attr('colspan') eq '1' &&
+        $td[1]->attr('colspan') eq '5') {
+      # start of second level case
+      my $subcase = $td[1]->look_down(_tag => 'i');
+      if ($subcase) {
+        my $val;
+        if ($td[1]->as_text =~ /is (\w+):/) {
+          $val = $1;
+        } elsif ($td[1]->as_text =~ /is JDWP\.EventKind\.(\w+):/) {
+          $val = $glob->{eventkind}->{$1} or die "No code for $1\n";
+        } else {
+          die "Failed to match case description\n";
+        }
+        my @list = ();
+        push @$repeat,
+          {
+           type => 'case',
+           name => clean_text($subcase->as_text),
+           value => $val,
+           items => \@list,
+          };
+        $sub = \@list;
+      } else {
+        print STDERR "          'unknown subcase?',\n";
+      }
+      next;
+    }
+    undef $repeat if ($repeat);
+    if ($td[0]->attr('colspan') eq '5') {
+      # top-level basic item
+      my ($type,$name,$desc) = map { clean_text($_) } @td;
+      push @list,
+        {
+         type => $type,
+         name => $name,
+         desc => $desc,
+        };
+    } elsif ($td[0]->attr('colspan') eq '7') {
+      # start of first level repeat
+      my $repeat_elt = $td[0]->look_down(_tag => 'i');
+      if ($repeat_elt) {
+        my @repeat_list = ();
+        push @list,
+          {
+           type => 'repeat',
+           name => clean_text($repeat_elt->as_text),
+           items => \@repeat_list,
+          };
+        $repeat = \@repeat_list;
+      } else {
+        print STDERR "        'unknown repeat?',\n";
+      }
+    } else {
+      print STDERR "        'other',\n";
+    }
+  }
+}
+
+sub parse_dd_error {
+  my ($dd, $spec) = @_;
+  unless ($dd && $dd->tag eq 'dd') {
+    print STDERR "No error data?";
+    return;
+  }
+  my %error = ();
+  $spec->{error} = \%error;
+  unless ($dd->as_text eq '(None)') {
+    foreach my $tr ($dd->look_down(_tag => 'tr')) {
+      my @td = $tr->look_down(_tag => 'td') or next;
+      my ($name, $desc) = map { clean_text($_) } @td;
+      my $code = $glob->{error}->{$name} or die "No code for $name\n";
+      $error{$code} = $desc;
+    }
+  }
+}
+
+sub clean_text {
+  $_[0] = $_[0]->as_text if (ref $_);
+  $_[0] =~ s/\r?\n/ /g;
+  $_[0] =~ s/[^ -~]//g;
+  $_[0] =~ s/\s+$//;
+  $_[0] =~ s/^\s+//;
+  $_[0];
+}
+
+=head1 SEE ALSO
+
+Net::Pcap(3), tcpdump(8)
+
+=head1 BUGS
+
+If you find some (and it shouldn't be difficult), then please let me know.
+
+=head1 AUTHOR
+
+Mark Hindess, E<lt>mark.hindess@googlemail.comE<gt>
+
+=head1 COPYRIGHT
+
+Apache License, Version 2.0, see http://www.apache.org/licenses/LICENSE-2.0
+
+=cut

Propchange: harmony/standard/tools/jdwpdump/jdwp-spec
------------------------------------------------------------------------------
    svn:executable = *