ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra/res2pm
Revision: 1.1
Committed: Wed Feb 22 20:33:05 2006 UTC (18 years, 2 months ago) by root
Branch: MAIN
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 #!/opt/bin/perl
2    
3     # usage: res2pm >Crossfire/Data.pm
4    
5     print <<EOF;
6     =head1 NAME
7    
8     Crossfire::Data - various data structures useful for understanding archs and objects
9    
10     =head1
11    
12     THIS FILE IS AUTOGENERATED, DO NOT EDIT!
13    
14     It's a translation of the following files:
15    
16     res/spells.xml
17     res/types.xml
18     res/typenumbers.xml
19    
20     See F<res/README> for more info.
21    
22     =cut
23    
24     EOF
25    
26     use Data::Dumper;
27     use XML::Parser::Grove;
28    
29     sub dump_hash {
30     my ($name, $ref) = @_;
31     require Data::Dumper;
32     $d = new Data::Dumper ([$ref], ["*$name"]);
33     $d->Terse (1);
34     $d->Indent (1);
35     $d->Quotekeys (0);
36     $d->Useqq (1);
37     $d->Sortkeys (sub {
38     [sort {
39     $a > 0 && $b > 0 ? $a <=> $b
40     : $a cmp $b
41     } keys %{+shift}]
42     });
43     my $d = $d->Dump;
44     $d =~ s/^ /\t\t/gm;
45     $d =~ s/^ /\t/gm;
46     $d =~ s/\s+$//;
47     print "our %$name = $d;\n\n";
48     }
49    
50     my $type = XML::Parser->new (Style => 'grove')->parsefile ("res/types.xml");
51    
52     my %bitmask;
53     my %list;
54     my %type;
55     my $attr;
56     my %ignore_list;
57     my %default_attr;
58    
59     sub string($) {
60     local $_ = join "", @{shift->contents};
61     $_ =~ s/^\s+//;
62     $_ =~ s/\s+$//;
63     $_ =~ s/\s+/ /g;
64     $_
65     }
66    
67     sub parse_attr {
68     my ($e, $sect) = @_;
69    
70     $sect->{$e->attr ("arch") || $e->attr("arch_begin")} = {
71     name => $e->attr ("editor"),
72     type => $e->attr ("type"),
73     desc => string $e,
74     $e->attr("arch_begin") ? (end => $e->attr("arch_end")) : (),
75     };
76     }
77    
78     sub parse_type {
79     my ($e, $type) = @_;
80    
81     for my $e (grep ref, @{$e->contents}) {
82     if ($e->name eq "required") {
83     for my $i (grep ref, @{$e->contents}) {
84     $type->{required}{$i->attr ("arch")} = $i->attr ("value");
85     }
86     } elsif ($e->name eq "attribute") {
87     parse_attr $e, $type->{attr}{Main} ||= {};
88     } elsif ($e->name eq "ignore") {
89     for my $i (grep ref, @{$e->contents}) {
90     if ($i->name eq "ignore_list") {
91     push @{$type->{ignore}}, $ignore_list{$i->attr ("name")} ||= [];
92     } elsif ($i->name eq "attribute") {
93     push @{$type->{ignore}}, $i->attr ("arch");
94     }
95     }
96     } elsif ($e->name eq "import_type") {
97     push @{$type->{import}}, $xtype{$e->attr ("name")} ||= {};
98     } elsif ($e->name eq "use") {
99     $type->{use} = string $e;
100     } elsif ($e->name eq "description") {
101     $type->{desc} = string $e;
102     } elsif ($e->name eq "section") {
103     for my $i (grep ref, @{$e->contents}) {
104     parse_attr $i, $type->{attr}{$e->attr ("name")} ||= {};
105     }
106     # $type->{desc} = string $e;
107     } else {
108     warn "unknown types subelement ", $e->name;
109     }
110     }
111    
112     $type
113     }
114    
115     for my $e (grep ref, @{$type->root->contents}) {
116     if ($e->name eq "bitmask") {
117     my $bm = $bitmask{$e->attr ("name")} = {};
118     for my $b (grep ref, @{$e->contents}) {
119     $bm->{$b->attr ("bit")} = $b->attr ("name");
120     }
121     } elsif ($e->name eq "list") {
122     my $list = $list{$e->attr ("name")} = {};
123     for my $b (grep ref, @{$e->contents}) {
124     $list->{$b->attr ("value")} = $b->attr ("name");
125     }
126     } elsif ($e->name eq "ignore_list") {
127     my $list = $ignore_list{$e->attr ("name")} ||= [];
128     for my $b (grep ref, @{$e->contents}) {
129     push @$list, $b->attr ("arch");
130     }
131     } elsif ($e->name eq "default_type") {
132     parse_type $e, \%default_attr;
133     } elsif ($e->name eq "type") {
134     my $type = $attr{$e->attr ("name")} ||= {};
135     parse_type $e, $type;
136     unshift @{$type->{import}}, \%default_attr;
137     $type{$e->attr ("number")}{type}{$e->attr ("name")} = $type;
138    
139     } else {
140     warn "unknown types element ", $e->name;
141     }
142     }
143    
144     my $type = XML::Parser->new (Style => 'grove')->parsefile ("res/typenumbers.xml");
145    
146     for (grep ref, @{$type->root->contents}) {
147     $type{$_->attr ("number")}{name} = $_->attr ("name");
148     }
149    
150     dump_hash "TYPE", \%type;
151    
152     dump_hash "LIST", \%list;
153     dump_hash "BITMASK", \%bitmask;
154    
155     my $spell = XML::Parser->new (Style => 'grove')->parsefile ("res/spells.xml")
156     or die;
157    
158     my %spell;
159    
160     for (grep ref, @{$spell->root->contents}) {
161     $spell{$_->attr ("id")} = $_->attr ("name");
162     }
163    
164     dump_hash "SPELL", \%spell;
165    
166     print <<EOF;
167    
168     =head1 AUTHOR
169    
170     Marc Lehmann <schmorp@schmorp.de>
171     http://home.schmorp.de/
172    
173     The source files are part of the CFJavaEditor.
174    
175     =cut
176    
177     1
178     EOF
179