[ViewVC] Annotation of: cvs/deliantra/Deliantra/res2pm

#!/opt/bin/perl

# usage: res2pm

open STDOUT, ">:utf8", "Deliantra/Data.pm"
   or die "Deliantra/Data.pm: $!";

print <<EOF;
=head1 NAME

Deliantra::Data - various data structures useful for understanding archs and objects

=head1

THIS FILE IS AUTOGENERATED, DO NOT EDIT!

It's a translation of the following files:

 res/spells.xml
 res/types.xml
 res/typenumbers.xml

See F<res/README> for more info.

=cut

package Deliantra::Data;

EOF

use Data::Dumper;
use XML::Grove::Builder;
use XML::Parser::PerlSAX;


sub dump_hash {
   my ($names, $refs) = @_;

   $d = new Data::Dumper ($refs, [map "*$_", @$names]);
   $d->Terse (1);
   $d->Indent (1);
   $d->Quotekeys (0);
   $d->Useqq (0);
   $d->Useperl(1);
   $d->Sortkeys (sub {
      [sort {
         $a > 0 && $b > 0 ? $a <=> $b
                          : $a cmp $b
      } keys %{+shift}]
   });

   my @vals = $d->Dump;

   while (@vals) {
      my $v = shift @vals;
      $v =~ s/^                /\t\t/gm;
      $v =~ s/^        /\t/gm;
      $v =~ s/\s+$//;

      my $name = shift @$names;
      my $ref = shift @$refs;

      my $sigil = ref $ref eq "ARRAY" ? '@' : '%';

      print "our $sigil$name = $v;\n\n";
   }
}

my $grove_builder = XML::Grove::Builder->new;
my $parser = XML::Parser::PerlSAX->new ( Handler => $grove_builder );
my $type = $parser->parse ( Source => { SystemId => "res/types.xml" } );

my %bitmask;
my %list;
my %type;
my %typename;
my @attr0;
my %attr;
my %ignore_list;
my %default_attr;
my %spell;

sub string($) {
   local $_ = join "", map $_->{Data}, @{shift->{Contents}};
   $_ =~ s/^\s+//;
   $_ =~ s/\s+$//;
   $_ =~ s/\s+/ /g;
   $_
}

sub parse_attr {
   my ($e, $sect) = @_;

   my $arch = {
      type => $e->{Attributes}->{type},
      name => $e->{Attributes}->{editor},
      desc => string $e,
      $e->{Attributes}->{arch_begin} ? (end => $e->{Attributes}->{arch_end}) : (),
   };

   delete $arch->{name} unless defined $arch->{name};
   delete $arch->{desc} unless length  $arch->{desc};

   if ($arch->{type} =~ s/^(bitmask)_(.*)/$1/) {
      $arch->{value} = $bitmask{$2} ||= {};
   } elsif ($arch->{type} =~ s/^(list)_(.*)/$1/) {
      $arch->{value} = $list{$2} ||= {};
   } elsif ($arch->{type} eq "fixed") {
      $arch->{value} = $e->{Attributes}->{value};
   } elsif ($arch->{type} =~ s/^bool_special$/bool/) {
      $arch->{value} = [$e->{Attributes}->{false}, $e->{Attributes}->{true}];
   }

   push @$sect, [$e->{Attributes}->{arch} || $e->{Attributes}->{arch_begin}, $arch];
}

sub parse_type {
   my ($e, $type) = @_;

   my %main;

   for my $e (grep { $_->isa ('XML::Grove::Element') } @{$e->{Contents}}) {
      if ($e->{Name} eq "required") {
         # not used
         #for my $i (grep $_->isa ('XML::Grove::Element'), @{$e->{Contents}}) {
         #   $type->{required}{$i->{Attributes}->{arch}} = $i->{Attributes}->{value};
         #}
      } elsif ($e->{Name} eq "attribute") {
         parse_attr $e, $type->{attr} ||= [];
      } elsif ($e->{Name} eq "ignore") {
         for my $i (grep $_->isa ('XML::Grove::Element'), @{$e->{Contents}}) {
            if ($i->{Name} eq "ignore_list") {
               push @{$type->{ignore}}, $ignore_list{$i->{Attributes}->{name}} ||= [];
            } elsif ($i->{Name} eq "attribute") {
               push @{$type->{ignore}}, $i->{Attributes}->{arch};
            }
         }
      } elsif ($e->{Name} eq "import_type") {
         #push @{$type->{import}}, $type{$e->{Attributes}->{name}} ||= {};
         push @{$type->{import}}, $e->{Attributes}->{name};
      } elsif ($e->{Name} eq "use") {
         $type->{use} = string $e;
      } elsif ($e->{Name} eq "description") {
         $type->{desc} = string $e;
      } elsif ($e->{Name} eq "section") {
         my @attr;
         for my $i (grep $_->isa ('XML::Grove::Element'), @{$e->{Contents}}) {
            parse_attr $i, \@attr;
         }
         push @{ $type->{section} }, [$e->{Attributes}->{name} => \@attr];
      } else {
         warn "unknown types subelement ", $e->{Name};
      }
   }

   $type
}

for my $e (grep $_->isa ('XML::Grove::Element'), @{$type->root->{Contents}}) {
   if ($e->{Name} eq "bitmask") {
      my $bm = $bitmask{$e->{Attributes}->{name}} ||= {};
      for my $b (grep $_->isa ('XML::Grove::Element'), @{$e->{Contents}}) {
         $bm->{$b->{Attributes}->{bit}} = $b->{Attributes}->{name};
      }
   } elsif ($e->{Name} eq "list") {
      my $list = $list{$e->{Attributes}->{name}} ||= {};
      for my $b (grep $_->isa ('XML::Grove::Element'), @{$e->{Contents}}) {
         $list->{$b->{Attributes}->{value}} = $b->{Attributes}->{name};
      }
   } elsif ($e->{Name} eq "ignore_list") {
      my $list = $ignore_list{$e->{Attributes}->{name}} ||= [];
      for my $b (grep $_->isa ('XML::Grove::Element'), @{$e->{Contents}}) {
         push @$list, $b->{Attributes}->{arch};
      }
   } elsif ($e->{Name} eq "default_type") {
      parse_type $e, \%default_attr;
   } elsif ($e->{Name} eq "type") {
      my $type = $type{$e->{Attributes}->{name}} ||= {};

      $type->{name} = $e->{Attributes}->{name};

      parse_type $e, $type;

      if ($e->{Attributes}->{number} > 0) {
         $attr{$e->{Attributes}->{number}} = $type;
      } elsif ($e->{Attributes}->{name} eq "Misc") {
         delete $type->{required};
      } else {
         push @attr0, $type;
      }

   } else {
      warn "unknown types element ", $e->{Name};
   }
}

my $type = $parser->parse ( Source => { SystemId => "res/typenumbers.xml" } );

for (grep $_->isa ('XML::Grove::Element'), @{$type->root->{Contents}}) {
   $typename{$_->{Attributes}->{number}} = $_->{Attributes}->{name};
}

my $spell = $parser->parse ( Source => { SystemId => "res/spells.xml" } )
   or die;

for (grep $_->isa ('XML::Grove::Element'), @{$spell->root->{Contents}}) {
   $spell{$_->{Attributes}->{id}} = $_->{Attributes}->{name};
}

dump_hash ["BITMASK", "LIST", "IGNORE_LIST", "DEFAULT_ATTR", "TYPE", "ATTR", "TYPENAME", "SPELL"],
          [\%bitmask, \%list, \%ignore_list, \%default_attr, \%type, \%attr, \%typename, \%spell];

print <<EOF;

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

 The source files are part of the CFJavaEditor.

=cut

1
EOF

Revision:	1.12
Committed:	Wed Dec 26 18:26:15 2007 UTC (16 years, 4 months ago) by root
Branch:	MAIN
CVS Tags:	rel-1_222, rel-1_221, rel-1_2, rel-1_29, rel-1_24, rel-1_25, rel-1_22, rel-1_23
Changes since 1.11:	+4 -4 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	#!/opt/bin/perl
2
3	root	1.2	# usage: res2pm
4
5	root	1.12	open STDOUT, ">:utf8", "Deliantra/Data.pm"
6			or die "Deliantra/Data.pm: $!";
7	root	1.1
8			print <<EOF;
9			=head1 NAME
10
11	root	1.12	Deliantra::Data - various data structures useful for understanding archs and objects
12	root	1.1
13			=head1
14
15			THIS FILE IS AUTOGENERATED, DO NOT EDIT!
16
17			It's a translation of the following files:
18
19			res/spells.xml
20			res/types.xml
21			res/typenumbers.xml
22
23			See F<res/README> for more info.
24
25			=cut
26
27	root	1.12	package Deliantra::Data;
28	root	1.5
29	root	1.1	EOF
30
31			use Data::Dumper;
32	elmex	1.11	use XML::Grove::Builder;
33			use XML::Parser::PerlSAX;
34
35	root	1.1
36			sub dump_hash {
37	root	1.3	my ($names, $refs) = @_;
38
39			$d = new Data::Dumper ($refs, [map "*$_", @$names]);
40	root	1.1	$d->Terse (1);
41			$d->Indent (1);
42			$d->Quotekeys (0);
43	root	1.3	$d->Useqq (0);
44			$d->Useperl(1);
45	root	1.1	$d->Sortkeys (sub {
46			[sort {
47			$a > 0 && $b > 0 ? $a <=> $b
48			: $a cmp $b
49			} keys %{+shift}]
50			});
51	root	1.3
52			my @vals = $d->Dump;
53
54			while (@vals) {
55			my $v = shift @vals;
56			$v =~ s/^ /\t\t/gm;
57			$v =~ s/^ /\t/gm;
58			$v =~ s/\s+$//;
59
60			my $name = shift @$names;
61			my $ref = shift @$refs;
62
63			my $sigil = ref $ref eq "ARRAY" ? '@' : '%';
64
65			print "our $sigil$name = $v;\n\n";
66			}
67	root	1.1	}
68
69	elmex	1.11	my $grove_builder = XML::Grove::Builder->new;
70			my $parser = XML::Parser::PerlSAX->new ( Handler => $grove_builder );
71			my $type = $parser->parse ( Source => { SystemId => "res/types.xml" } );
72	root	1.1
73			my %bitmask;
74			my %list;
75			my %type;
76	root	1.3	my %typename;
77			my @attr0;
78			my %attr;
79	root	1.1	my %ignore_list;
80			my %default_attr;
81	root	1.3	my %spell;
82	root	1.1
83			sub string($) {
84	elmex	1.11	local $_ = join "", map $_->{Data}, @{shift->{Contents}};
85	root	1.1	$_ =~ s/^\s+//;
86			$_ =~ s/\s+$//;
87			$_ =~ s/\s+/ /g;
88			$_
89			}
90
91			sub parse_attr {
92			my ($e, $sect) = @_;
93
94	root	1.2	my $arch = {
95	elmex	1.11	type => $e->{Attributes}->{type},
96			name => $e->{Attributes}->{editor},
97	root	1.1	desc => string $e,
98	elmex	1.11	$e->{Attributes}->{arch_begin} ? (end => $e->{Attributes}->{arch_end}) : (),
99	root	1.1	};
100	root	1.2
101	root	1.3	delete $arch->{name} unless defined $arch->{name};
102			delete $arch->{desc} unless length $arch->{desc};
103
104	root	1.2	if ($arch->{type} =~ s/^(bitmask)_(.*)/$1/) {
105	root	1.3	$arch->{value} = $bitmask{$2} \|\|= {};
106			} elsif ($arch->{type} =~ s/^(list)_(.*)/$1/) {
107			$arch->{value} = $list{$2} \|\|= {};
108	root	1.7	} elsif ($arch->{type} eq "fixed") {
109	elmex	1.11	$arch->{value} = $e->{Attributes}->{value};
110	root	1.3	} elsif ($arch->{type} =~ s/^bool_special$/bool/) {
111	elmex	1.11	$arch->{value} = [$e->{Attributes}->{false}, $e->{Attributes}->{true}];
112	root	1.2	}
113
114	elmex	1.11	push @$sect, [$e->{Attributes}->{arch} \|\| $e->{Attributes}->{arch_begin}, $arch];
115	root	1.1	}
116
117			sub parse_type {
118			my ($e, $type) = @_;
119
120	root	1.5	my %main;
121
122	elmex	1.11	for my $e (grep { $_->isa ('XML::Grove::Element') } @{$e->{Contents}}) {
123			if ($e->{Name} eq "required") {
124	root	1.9	# not used
125	elmex	1.11	#for my $i (grep $_->isa ('XML::Grove::Element'), @{$e->{Contents}}) {
126			# $type->{required}{$i->{Attributes}->{arch}} = $i->{Attributes}->{value};
127	root	1.9	#}
128	elmex	1.11	} elsif ($e->{Name} eq "attribute") {
129	root	1.8	parse_attr $e, $type->{attr} \|\|= [];
130	elmex	1.11	} elsif ($e->{Name} eq "ignore") {
131			for my $i (grep $_->isa ('XML::Grove::Element'), @{$e->{Contents}}) {
132			if ($i->{Name} eq "ignore_list") {
133			push @{$type->{ignore}}, $ignore_list{$i->{Attributes}->{name}} \|\|= [];
134			} elsif ($i->{Name} eq "attribute") {
135			push @{$type->{ignore}}, $i->{Attributes}->{arch};
136	root	1.1	}
137			}
138	elmex	1.11	} elsif ($e->{Name} eq "import_type") {
139			#push @{$type->{import}}, $type{$e->{Attributes}->{name}} \|\|= {};
140			push @{$type->{import}}, $e->{Attributes}->{name};
141			} elsif ($e->{Name} eq "use") {
142	root	1.1	$type->{use} = string $e;
143	elmex	1.11	} elsif ($e->{Name} eq "description") {
144	root	1.1	$type->{desc} = string $e;
145	elmex	1.11	} elsif ($e->{Name} eq "section") {
146	root	1.8	my @attr;
147	elmex	1.11	for my $i (grep $_->isa ('XML::Grove::Element'), @{$e->{Contents}}) {
148	root	1.8	parse_attr $i, \@attr;
149	root	1.1	}
150	elmex	1.11	push @{ $type->{section} }, [$e->{Attributes}->{name} => \@attr];
151	root	1.1	} else {
152	elmex	1.11	warn "unknown types subelement ", $e->{Name};
153	root	1.1	}
154			}
155
156			$type
157			}
158
159	elmex	1.11	for my $e (grep $_->isa ('XML::Grove::Element'), @{$type->root->{Contents}}) {
160			if ($e->{Name} eq "bitmask") {
161			my $bm = $bitmask{$e->{Attributes}->{name}} \|\|= {};
162			for my $b (grep $_->isa ('XML::Grove::Element'), @{$e->{Contents}}) {
163			$bm->{$b->{Attributes}->{bit}} = $b->{Attributes}->{name};
164	root	1.1	}
165	elmex	1.11	} elsif ($e->{Name} eq "list") {
166			my $list = $list{$e->{Attributes}->{name}} \|\|= {};
167			for my $b (grep $_->isa ('XML::Grove::Element'), @{$e->{Contents}}) {
168			$list->{$b->{Attributes}->{value}} = $b->{Attributes}->{name};
169	root	1.1	}
170	elmex	1.11	} elsif ($e->{Name} eq "ignore_list") {
171			my $list = $ignore_list{$e->{Attributes}->{name}} \|\|= [];
172			for my $b (grep $_->isa ('XML::Grove::Element'), @{$e->{Contents}}) {
173			push @$list, $b->{Attributes}->{arch};
174	root	1.1	}
175	elmex	1.11	} elsif ($e->{Name} eq "default_type") {
176	root	1.1	parse_type $e, \%default_attr;
177	elmex	1.11	} elsif ($e->{Name} eq "type") {
178			my $type = $type{$e->{Attributes}->{name}} \|\|= {};
179	root	1.6
180	elmex	1.11	$type->{name} = $e->{Attributes}->{name};
181	root	1.6
182	root	1.1	parse_type $e, $type;
183	root	1.3
184	elmex	1.11	if ($e->{Attributes}->{number} > 0) {
185			$attr{$e->{Attributes}->{number}} = $type;
186			} elsif ($e->{Attributes}->{name} eq "Misc") {
187	root	1.3	delete $type->{required};
188			} else {
189			push @attr0, $type;
190			}
191	root	1.1
192			} else {
193	elmex	1.11	warn "unknown types element ", $e->{Name};
194	root	1.1	}
195			}
196
197	elmex	1.11	my $type = $parser->parse ( Source => { SystemId => "res/typenumbers.xml" } );
198	root	1.1
199	elmex	1.11	for (grep $_->isa ('XML::Grove::Element'), @{$type->root->{Contents}}) {
200			$typename{$_->{Attributes}->{number}} = $_->{Attributes}->{name};
201	root	1.1	}
202
203	elmex	1.11	my $spell = $parser->parse ( Source => { SystemId => "res/spells.xml" } )
204	root	1.1	or die;
205
206	elmex	1.11	for (grep $_->isa ('XML::Grove::Element'), @{$spell->root->{Contents}}) {
207			$spell{$_->{Attributes}->{id}} = $_->{Attributes}->{name};
208	root	1.1	}
209
210	root	1.9	dump_hash ["BITMASK", "LIST", "IGNORE_LIST", "DEFAULT_ATTR", "TYPE", "ATTR", "TYPENAME", "SPELL"],
211			[\%bitmask, \%list, \%ignore_list, \%default_attr, \%type, \%attr, \%typename, \%spell];
212	root	1.1
213			print <<EOF;
214
215			=head1 AUTHOR
216
217			Marc Lehmann <schmorp@schmorp.de>
218			http://home.schmorp.de/
219
220			The source files are part of the CFJavaEditor.
221
222			=cut
223
224			1
225			EOF
226