ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra/res2pm
(Generate patch)

Comparing deliantra/Deliantra/res2pm (file contents):
Revision 1.2 by root, Wed Feb 22 21:20:19 2006 UTC vs.
Revision 1.13 by elmex, Fri Mar 19 21:38:14 2010 UTC

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

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines