libs/glibmm2/tools/pm/Object.pm

   1 package Object;
   2
   3 use strict;
   4 use warnings;
   5
   6 BEGIN {
   7      use Exporter   ();
   8      our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
   9
  10      # set the version for version checking
  11      $VERSION     = 1.00;
  12
  13      @ISA         = qw(Exporter);
  14      @EXPORT      = ( );
  15      %EXPORT_TAGS = ( );
  16
  17      # your exported package globals go here,
  18      # as well as any optionally exported functions
  19      @EXPORT_OK   = ( );
  20 }
  21 our @EXPORT_OK;
  22
  23 # class Object
  24 # {
  25 #   string name;
  26 #   string module;
  27 #   string parent;
  28 #   string c_name;
  29 #   string gtype_id;
  30 # }
  31
  32
  33 sub new
  34 {
  35   my ($def) = @_;
  36
  37   my $self = {};
  38   bless $self;
  39
  40   $def =~ s/^\(//;
  41   $def =~ s/\)$//;
  42
  43   # snarf down the fields
  44   $$self{name}     = $1 if($def =~ s/^define-object (\S+)//);
  45   $$self{module}   = $1 if($def =~ s/\(in-module "(\S+)"\)//);
  46   $$self{parent}   = $1 if($def =~ s/\(parent "(\S+)"\)//);
  47   $$self{c_name}   = $1 if($def =~ s/\(c-name "(\S+)"\)//);
  48   $$self{gtype_id} = $1 if($def =~ s/\(gtype-id "(\S+)"\)//);
  49
  50   if($def !~ /^\s*$/)
  51   {
  52     GtkDefs::error("Unhandled object def ($def) in $$self{module}\::$$self{name}\n")
  53   }
  54
  55   return $self;
  56 }
  57
  58
  59 sub dump($)
  60 {
  61   my ($self) = @_;
  62
  63   print "<object>\n";
  64
  65   foreach(keys %$self)
  66     { print "  <$_ value=\"$$self{$_}\"/>\n"; }
  67
  68   print "</object>\n\n";
  69 }
  70
  71
  72 1; # indicate proper module load.