source4/build/pidl/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(EmitProhibited);
  12
  13 use strict;
  14
  15 use Parse::Pidl::Util qw(has_property);
  16
  17 sub handle_union_tag_size($$)
  18 {
  19         #FIXME
  20 }
  21
  22 sub handle_type($$$$$$$)
  23 {
  24         my ($name,$dissectorname,$ft_type,$base_type,$mask,$valsstring,$alignment) = @_;
  25         #FIXME
  26 }
  27
  28 my %hf_renames = ();
  29
  30 sub handle_hf_rename($$)
  31 {
  32         my ($old,$new) = @_;
  33         $hf_renames{$old} = $new;
  34 }
  35
  36 sub handle_param_value($$)
  37 {
  38         my ($dissector_name,$value) = @_;
  39
  40 }
  41
  42 sub handle_hf_field($$$$$$$$)
  43 {
  44         my ($hf,$title,$filter,$ft_type,$base_type,$valsstring,$mask,$blub) = @_;
  45
  46 }
  47
  48 sub handle_strip_prefix($)
  49 {
  50         #FIXME
  51 }
  52
  53 my @noemit = ();
  54
  55 sub handle_noemit($)
  56 {
  57         my $type = shift;
  58
  59         push (@noemit, $type);
  60 }
  61
  62 my %field_handlers = (
  63         UNION_TAG_SIZE => \&handle_union_tag_size,
  64         TYPE => \&handle_type,
  65         NOEMIT => \&handle_noemit,
  66         PARAM_VALUE => \&handle_param_value,
  67         HF_FIELD => \&handle_hf_field,
  68         HF_RENAME => \&handle_hf_rename,
  69         STRIP_PREFIX => \&handle_strip_prefix
  70 );
  71
  72 sub Parse($)
  73 {
  74         my $f = shift;
  75
  76         open(IN,$f) or return undef;
  77
  78         foreach (<IN>) {
  79                 next if (/^#.*$/);
  80                 next if (/^$/);
  81
  82                 my @fields = split(/ /);
  83
  84                 $field_handlers{$fields[0]}(@fields);
  85         }
  86
  87         close(IN);
  88 }
  89
  90 sub EmitProhibited($)
  91 {
  92         my $type = shift;
  93
  94         return 1 if (grep(/$type/,@noemit));
  95
  96         return 0;
  97 }
  98
  99 1;