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

#!/opt/bin/perl

# usage: res2pm

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

print <<EOF;
=head1 NAME

Crossfire::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 Crossfire::Data;

EOF

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

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 $type = XML::Parser->new (Style => 'grove')->parsefile ("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 "", @{shift->contents};
   $_ =~ s/^\s+//;
   $_ =~ s/\s+$//;
   $_ =~ s/\s+/ /g;
   $_
}

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

   my $arch = {
      type => $e->attr ("type"),
      name => $e->attr ("editor"),
      desc => string $e,
      $e->attr("arch_begin") ? (end => $e->attr("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->attr ("value");
   } elsif ($arch->{type} =~ s/^bool_special$/bool/) {
      $arch->{value} = [$e->attr ("false"), $e->attr ("true")];
   }

   push @$sect, [$e->attr ("arch") || $e->attr("arch_begin"), $arch];
}

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

   my %main;

   for my $e (grep ref, @{$e->contents}) {
      if ($e->name eq "required") {
         # not used
         #for my $i (grep ref, @{$e->contents}) {
         #   $type->{required}{$i->attr ("arch")} = $i->attr ("value");
         #}
      } elsif ($e->name eq "attribute") {
         parse_attr $e, $type->{attr} ||= [];
      } elsif ($e->name eq "ignore") {
         for my $i (grep ref, @{$e->contents}) {
            if ($i->name eq "ignore_list") {
               push @{$type->{ignore}}, $ignore_list{$i->attr ("name")} ||= [];
            } elsif ($i->name eq "attribute") {
               push @{$type->{ignore}}, $i->attr ("arch");
            }
         }
      } elsif ($e->name eq "import_type") {
         push @{$type->{import}}, $type{$e->attr ("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 ref, @{$e->contents}) {
            parse_attr $i, \@attr;
         }
         push @{ $type->{section} }, [$e->attr ("name") => \@attr];
      } else {
         warn "unknown types subelement ", $e->name;
      }
   }

   $type
}

for my $e (grep ref, @{$type->root->contents}) {
   if ($e->name eq "bitmask") {
      my $bm = $bitmask{$e->attr ("name")} ||= {};
      for my $b (grep ref, @{$e->contents}) {
         $bm->{$b->attr ("bit")} = $b->attr ("name");
      }
   } elsif ($e->name eq "list") {
      my $list = $list{$e->attr ("name")} ||= {};
      for my $b (grep ref, @{$e->contents}) {
         $list->{$b->attr ("value")} = $b->attr ("name");
      }
   } elsif ($e->name eq "ignore_list") {
      my $list = $ignore_list{$e->attr ("name")} ||= [];
      for my $b (grep ref, @{$e->contents}) {
         push @$list, $b->attr ("arch");
      }
   } elsif ($e->name eq "default_type") {
      parse_type $e, \%default_attr;
   } elsif ($e->name eq "type") {
      my $type = $type{$e->attr ("name")} ||= {};

      $type->{name} = $e->attr ("name");

      parse_type $e, $type;

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

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

my $type = XML::Parser->new (Style => 'grove')->parsefile ("res/typenumbers.xml");

for (grep ref, @{$type->root->contents}) {
   $typename{$_->attr ("number")} = $_->attr ("name");
}

my $spell = XML::Parser->new (Style => 'grove')->parsefile ("res/spells.xml")
   or die;

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