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

Comparing deliantra/Deliantra/res2pm (file contents):
Revision 1.3 by root, Wed Feb 22 21:57:29 2006 UTC vs.
Revision 1.11 by elmex, Fri Aug 10 12:13:16 2007 UTC

… …
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 Crossfire::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 ($names, $refs) = @_; 37 my ($names, $refs) = @_;
34 38
35 $d = new Data::Dumper ($refs, [map "*$_", @$names]); 39 $d = new Data::Dumper ($refs, [map "*$_", @$names]);
… …
60 64
61 print "our $sigil$name = $v;\n\n"; 65 print "our $sigil$name = $v;\n\n";
62 } 66 }
63} 67}
64 68
65my $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" } );
66 72
67my %bitmask; 73my %bitmask;
68my %list; 74my %list;
69my %type; 75my %type;
70my %typename; 76my %typename;
… …
73my %ignore_list; 79my %ignore_list;
74my %default_attr; 80my %default_attr;
75my %spell; 81my %spell;
76 82
77sub string($) { 83sub string($) {
78 local $_ = join "", @{shift->contents}; 84 local $_ = join "", map $_->{Data}, @{shift->{Contents}};
79 $_ =~ s/^\s+//; 85 $_ =~ s/^\s+//;
80 $_ =~ s/\s+$//; 86 $_ =~ s/\s+$//;
81 $_ =~ s/\s+/ /g; 87 $_ =~ s/\s+/ /g;
82 $_ 88 $_
83} 89}
84 90
85sub parse_attr { 91sub parse_attr {
86 my ($e, $sect) = @_; 92 my ($e, $sect) = @_;
87 93
88 my $arch = { 94 my $arch = {
89 type => $e->attr ("type"), 95 type => $e->{Attributes}->{type},
90 name => $e->attr ("editor"), 96 name => $e->{Attributes}->{editor},
91 desc => string $e, 97 desc => string $e,
92 $e->attr("arch_begin") ? (end => $e->attr("arch_end")) : (), 98 $e->{Attributes}->{arch_begin} ? (end => $e->{Attributes}->{arch_end}) : (),
93 }; 99 };
94 100
95 delete $arch->{name} unless defined $arch->{name}; 101 delete $arch->{name} unless defined $arch->{name};
96 delete $arch->{desc} unless length $arch->{desc}; 102 delete $arch->{desc} unless length $arch->{desc};
97 103
98 if ($arch->{type} =~ s/^(bitmask)_(.*)/$1/) { 104 if ($arch->{type} =~ s/^(bitmask)_(.*)/$1/) {
99 $arch->{value} = $bitmask{$2} ||= {}; 105 $arch->{value} = $bitmask{$2} ||= {};
100 } elsif ($arch->{type} =~ s/^(list)_(.*)/$1/) { 106 } elsif ($arch->{type} =~ s/^(list)_(.*)/$1/) {
101 $arch->{value} = $list{$2} ||= {}; 107 $arch->{value} = $list{$2} ||= {};
108 } elsif ($arch->{type} eq "fixed") {
109 $arch->{value} = $e->{Attributes}->{value};
102 } elsif ($arch->{type} =~ s/^bool_special$/bool/) { 110 } elsif ($arch->{type} =~ s/^bool_special$/bool/) {
103 $arch->{value} = [$e->attr ("false"), $e->attr ("true")]; 111 $arch->{value} = [$e->{Attributes}->{false}, $e->{Attributes}->{true}];
104 } 112 }
105 113
106 $sect->{$e->attr ("arch") || $e->attr("arch_begin")} = $arch; 114 push @$sect, [$e->{Attributes}->{arch} || $e->{Attributes}->{arch_begin}, $arch];
107} 115}
108 116
109sub parse_type { 117sub parse_type {
110 my ($e, $type) = @_; 118 my ($e, $type) = @_;
111 119
112 for my $e (grep ref, @{$e->contents}) { 120 my %main;
121
122 for my $e (grep { $_->isa ('XML::Grove::Element') } @{$e->{Contents}}) {
113 if ($e->name eq "required") { 123 if ($e->{Name} eq "required") {
114 for my $i (grep ref, @{$e->contents}) { 124 # not used
115 $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};
116 } 127 #}
117 } elsif ($e->name eq "attribute") { 128 } elsif ($e->{Name} eq "attribute") {
118 parse_attr $e, $type->{attr}{Main} ||= {}; 129 parse_attr $e, $type->{attr} ||= [];
119 } elsif ($e->name eq "ignore") { 130 } elsif ($e->{Name} eq "ignore") {
120 for my $i (grep ref, @{$e->contents}) { 131 for my $i (grep $_->isa ('XML::Grove::Element'), @{$e->{Contents}}) {
121 if ($i->name eq "ignore_list") { 132 if ($i->{Name} eq "ignore_list") {
122 push @{$type->{ignore}}, $ignore_list{$i->attr ("name")} ||= []; 133 push @{$type->{ignore}}, $ignore_list{$i->{Attributes}->{name}} ||= [];
123 } elsif ($i->name eq "attribute") { 134 } elsif ($i->{Name} eq "attribute") {
124 push @{$type->{ignore}}, $i->attr ("arch"); 135 push @{$type->{ignore}}, $i->{Attributes}->{arch};
125 } 136 }
126 } 137 }
127 } elsif ($e->name eq "import_type") { 138 } elsif ($e->{Name} eq "import_type") {
128 push @{$type->{import}}, $type{$e->attr ("name")} ||= {}; 139 #push @{$type->{import}}, $type{$e->{Attributes}->{name}} ||= {};
140 push @{$type->{import}}, $e->{Attributes}->{name};
129 } elsif ($e->name eq "use") { 141 } elsif ($e->{Name} eq "use") {
130 $type->{use} = string $e; 142 $type->{use} = string $e;
131 } elsif ($e->name eq "description") { 143 } elsif ($e->{Name} eq "description") {
132 $type->{desc} = string $e; 144 $type->{desc} = string $e;
133 } elsif ($e->name eq "section") { 145 } elsif ($e->{Name} eq "section") {
134 for my $i (grep ref, @{$e->contents}) { 146 my @attr;
135 parse_attr $i, $type->{attr}{$e->attr ("name")} ||= {}; 147 for my $i (grep $_->isa ('XML::Grove::Element'), @{$e->{Contents}}) {
148 parse_attr $i, \@attr;
136 } 149 }
137# $type->{desc} = string $e; 150 push @{ $type->{section} }, [$e->{Attributes}->{name} => \@attr];
138 } else { 151 } else {
139 warn "unknown types subelement ", $e->name; 152 warn "unknown types subelement ", $e->{Name};
140 } 153 }
141 } 154 }
142 155
143 $type 156 $type
144} 157}
145 158
146for my $e (grep ref, @{$type->root->contents}) { 159for my $e (grep $_->isa ('XML::Grove::Element'), @{$type->root->{Contents}}) {
147 if ($e->name eq "bitmask") { 160 if ($e->{Name} eq "bitmask") {
148 my $bm = $bitmask{$e->attr ("name")} ||= {}; 161 my $bm = $bitmask{$e->{Attributes}->{name}} ||= {};
149 for my $b (grep ref, @{$e->contents}) { 162 for my $b (grep $_->isa ('XML::Grove::Element'), @{$e->{Contents}}) {
150 $bm->{$b->attr ("bit")} = $b->attr ("name"); 163 $bm->{$b->{Attributes}->{bit}} = $b->{Attributes}->{name};
151 } 164 }
152 } elsif ($e->name eq "list") { 165 } elsif ($e->{Name} eq "list") {
153 my $list = $list{$e->attr ("name")} ||= {}; 166 my $list = $list{$e->{Attributes}->{name}} ||= {};
154 for my $b (grep ref, @{$e->contents}) { 167 for my $b (grep $_->isa ('XML::Grove::Element'), @{$e->{Contents}}) {
155 $list->{$b->attr ("value")} = $b->attr ("name"); 168 $list->{$b->{Attributes}->{value}} = $b->{Attributes}->{name};
156 } 169 }
157 } elsif ($e->name eq "ignore_list") { 170 } elsif ($e->{Name} eq "ignore_list") {
158 my $list = $ignore_list{$e->attr ("name")} ||= []; 171 my $list = $ignore_list{$e->{Attributes}->{name}} ||= [];
159 for my $b (grep ref, @{$e->contents}) { 172 for my $b (grep $_->isa ('XML::Grove::Element'), @{$e->{Contents}}) {
160 push @$list, $b->attr ("arch"); 173 push @$list, $b->{Attributes}->{arch};
161 } 174 }
162 } elsif ($e->name eq "default_type") { 175 } elsif ($e->{Name} eq "default_type") {
163 parse_type $e, \%default_attr; 176 parse_type $e, \%default_attr;
164 } elsif ($e->name eq "type") { 177 } elsif ($e->{Name} eq "type") {
165 my $type = $type{$e->attr ("name")} ||= {}; 178 my $type = $type{$e->{Attributes}->{name}} ||= {};
179
180 $type->{name} = $e->{Attributes}->{name};
181
166 parse_type $e, $type; 182 parse_type $e, $type;
167 #unshift @{$type->{import}}, \%default_attr;
168 183
169 if ($e->attr ("number") > 0) { 184 if ($e->{Attributes}->{number} > 0) {
170 $attr{$e->attr ("number")} = $type; 185 $attr{$e->{Attributes}->{number}} = $type;
171 } elsif ($e->attr ("name") eq "Misc") { 186 } elsif ($e->{Attributes}->{name} eq "Misc") {
172 delete $type->{required}; 187 delete $type->{required};
173 } else { 188 } else {
174 push @attr0, $type; 189 push @attr0, $type;
175 } 190 }
176 191
177 } else { 192 } else {
178 warn "unknown types element ", $e->name; 193 warn "unknown types element ", $e->{Name};
179 } 194 }
180} 195}
181 196
182my $type = XML::Parser->new (Style => 'grove')->parsefile ("res/typenumbers.xml"); 197my $type = $parser->parse ( Source => { SystemId => "res/typenumbers.xml" } );
183 198
184for (grep ref, @{$type->root->contents}) { 199for (grep $_->isa ('XML::Grove::Element'), @{$type->root->{Contents}}) {
185 $typename{$_->attr ("number")} = $_->attr ("name"); 200 $typename{$_->{Attributes}->{number}} = $_->{Attributes}->{name};
186} 201}
187 202
188my $spell = XML::Parser->new (Style => 'grove')->parsefile ("res/spells.xml") 203my $spell = $parser->parse ( Source => { SystemId => "res/spells.xml" } )
189 or die; 204 or die;
190 205
191for (grep ref, @{$spell->root->contents}) { 206for (grep $_->isa ('XML::Grove::Element'), @{$spell->root->{Contents}}) {
192 $spell{$_->attr ("id")} = $_->attr ("name"); 207 $spell{$_->{Attributes}->{id}} = $_->{Attributes}->{name};
193} 208}
194 209
195dump_hash ["BITMASK", "LIST", "IGNORE_LIST", "DEFAULT_ATTR", "TYPE", "ATTR0", "ATTR", "TYPENAME", "SPELL"], 210dump_hash ["BITMASK", "LIST", "IGNORE_LIST", "DEFAULT_ATTR", "TYPE", "ATTR", "TYPENAME", "SPELL"],
196 [\%bitmask, \%list, \%ignore_list, \%default_attr, \%type, \@attr0, \%attr, \%typename, \%spell]; 211 [\%bitmask, \%list, \%ignore_list, \%default_attr, \%type, \%attr, \%typename, \%spell];
197 212
198print <<EOF; 213print <<EOF;
199 214
200=head1 AUTHOR 215=head1 AUTHOR
201 216

Diff Legend

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