source/pidl/lib/Parse/Pidl/Ethereal/Conformance.pm

   1 ###################################################
   2 # parse an ethereal conformance file
   3 # Copyright jelmer@samba.org 2005
   4 # released under the GNU GPL
   5
   6 package Parse::Pidl::Ethereal::Conformance;
   7
   8 require Exporter;
   9
  10 @ISA = qw(Exporter);
  11 @EXPORT_OK = qw(ReadConformance);
  12
  13 use strict;
  14
  15 use Parse::Pidl::Util qw(has_property);
  16
  17 sub handle_type($$$$$$$$)
  18 {
  19         my ($data,$name,$dissectorname,$ft_type,$base_type,$mask,$valsstring,$alignment) = @_;
  20
  21         $data->{types}->{$name} = {
  22                 NAME => $name,
  23                 DISSECTOR_NAME => $dissectorname,
  24                 FT_TYPE => $ft_type,
  25                 BASE_TYPE => $base_type,
  26                 MASK => $mask,
  27                 VALSSTRING => $valsstring,
  28                 ALIGNMENT => $alignment
  29         };
  30 }
  31
  32 sub handle_hf_rename($$$)
  33 {
  34         my ($data,$old,$new) = @_;
  35         $data->{hf_renames}{$old} = $new;
  36 }
  37
  38 sub handle_param_value($$$)
  39 {
  40         my ($data,$dissector_name,$value) = @_;
  41
  42         $data->{dissectorparams}->{$dissector_name} = $value;
  43 }
  44
  45 sub handle_hf_field($$$$$$$$$)
  46 {
  47         my ($data,$index,$name,$filter,$ft_type,$base_type,$valsstring,$mask,$blurb) = @_;
  48
  49         $data->{header_fields}->{$index} = {
  50                 INDEX => $index,
  51                 NAME => $name,
  52                 FILTER => $filter,
  53                 FT_TYPE => $ft_type,
  54                 BASE_TYPE => $base_type,
  55                 VALSSTRING => $valsstring,
  56                 MASK => $mask,
  57                 BLURB => $blurb
  58         };
  59 }
  60
  61 sub handle_strip_prefix($$)
  62 {
  63         my ($data,$x) = @_;
  64
  65         push (@{$data->{strip_prefixes}}, $x);
  66 }
  67
  68 sub handle_noemit($$)
  69 {
  70         my ($data) = shift;
  71         my $type;
  72
  73         $type = shift if ($#_ == 1);
  74
  75         if (defined($type)) {
  76             $data->{noemit}->{$type} = 1;
  77         } else {
  78             $data->{noemit_dissector} = 1;
  79         }
  80 }
  81
  82 sub handle_protocol($$$$$)
  83 {
  84         my ($data, $name, $longname, $shortname, $filtername) = @_;
  85
  86         $data->{protocols}->{$name} = {
  87                 LONGNAME => $longname,
  88                 SHORTNAME => $shortname,
  89                 FILTERNAME => $filtername
  90         };
  91 }
  92
  93 sub handle_fielddescription($$$)
  94 {
  95         my ($data,$field,$desc) = @_;
  96
  97         $data->{fielddescription}->{$field} = $desc;
  98 }
  99
 100 sub handle_import
 101 {
 102         my $data = shift @_;
 103         my $dissectorname = shift @_;
 104
 105         $data->{imports}->{$dissectorname} = join(' ', @_);
 106 }
 107
 108 my %field_handlers = (
 109         TYPE => \&handle_type,
 110         NOEMIT => \&handle_noemit,
 111         PARAM_VALUE => \&handle_param_value,
 112         HF_FIELD => \&handle_hf_field,
 113         HF_RENAME => \&handle_hf_rename,
 114         STRIP_PREFIX => \&handle_strip_prefix,
 115         PROTOCOL => \&handle_protocol,
 116         FIELD_DESCRIPTION => \&handle_fielddescription,
 117         IMPORT => \&handle_import
 118 );
 119
 120 sub ReadConformance($$)
 121 {
 122         my ($f,$data) = @_;
 123
 124         $data->{override} = "";
 125
 126         my $incodeblock = 0;
 127
 128         open(IN,"<$f") or return undef;
 129
 130         my $ln = 0;
 131
 132         foreach (<IN>) {
 133                 $ln++;
 134                 next if (/^#.*$/);
 135                 next if (/^$/);
 136
 137                 s/[\r\n]//g;
 138
 139                 if ($_ eq "CODE START") {
 140                         $incodeblock = 1;
 141                         next;
 142                 } elsif ($incodeblock and $_ eq "CODE END") {
 143                         $incodeblock = 0;
 144                         next;
 145                 } elsif ($incodeblock) {
 146                         $data->{override}.="$_\n";
 147                         next;
 148                 }
 149
 150                 my @fields = split(/ /);
 151
 152                 my $cmd = $fields[0];
 153
 154                 shift @fields;
 155
 156                 if (not defined($field_handlers{$cmd})) {
 157                         print "$f:$ln: Warning: Unknown command `$cmd'\n";
 158                         next;
 159                 }
 160
 161                 $field_handlers{$cmd}($data, @fields);
 162         }
 163
 164         close(IN);
 165 }
 166
 167 1;