[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

EOF

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

sub dump_hash {
   my ($name, $ref) = @_;
   require Data::Dumper;
   $d = new Data::Dumper ([$ref], ["*$name"]);
   $d->Terse (1);
   $d->Indent (1);
   $d->Quotekeys (0);
   $d->Useqq (1);
   $d->Sortkeys (sub {
      [sort {
         $a > 0 && $b > 0 ? $a <=> $b
                          : $a cmp $b
      } keys %{+shift}]
   });
   my $d = $d->Dump;
   $d =~ s/^                /\t\t/gm;
   $d =~ s/^        /\t/gm;
   $d =~ s/\s+$//;
   print "our %$name = $d;\n\n";
}

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

my %bitmask;
my %list;
my %type;
my $attr;
my %ignore_list;
my %default_attr;

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

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

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

   if ($arch->{type} =~ s/^(bitmask)_(.*)/$1/) {
      $arch->{values} = $BITMASK{$2} ||= {};
   }

   $sect->{$e->attr ("arch") || $e->attr("arch_begin")} = $arch;
}

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

   for my $e (grep ref, @{$e->contents}) {
      if ($e->name eq "required") {
         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}{Main} ||= {};
      } 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}}, $xtype{$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") {
         for my $i (grep ref, @{$e->contents}) {
            parse_attr $i, $type->{attr}{$e->attr ("name")} ||= {};
         }
#         $type->{desc} = string $e;
      } 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 = $attr{$e->attr ("name")} ||= {};
      parse_type $e, $type;
      unshift @{$type->{import}}, \%default_attr;
      $type{$e->attr ("number")}{type}{$e->attr ("name")} = $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}) {
   $type{$_->attr ("number")}{name} = $_->attr ("name");
}

dump_hash "TYPE", \%type;

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

my %spell;

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

dump_hash "SPELL", \%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.2
Committed:	Wed Feb 22 21:20:19 2006 UTC (18 years, 2 months ago) by root
Branch:	MAIN
Changes since 1.1:	+13 -7 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			EOF
28
29			use Data::Dumper;
30			use XML::Parser::Grove;
31
32			sub dump_hash {
33			my ($name, $ref) = @_;
34			require Data::Dumper;
35			$d = new Data::Dumper ([$ref], ["*$name"]);
36			$d->Terse (1);
37			$d->Indent (1);
38			$d->Quotekeys (0);
39			$d->Useqq (1);
40			$d->Sortkeys (sub {
41			[sort {
42			$a > 0 && $b > 0 ? $a <=> $b
43			: $a cmp $b
44			} keys %{+shift}]
45			});
46			my $d = $d->Dump;
47			$d =~ s/^ /\t\t/gm;
48			$d =~ s/^ /\t/gm;
49			$d =~ s/\s+$//;
50			print "our %$name = $d;\n\n";
51			}
52
53			my $type = XML::Parser->new (Style => 'grove')->parsefile ("res/types.xml");
54
55			my %bitmask;
56			my %list;
57			my %type;
58			my $attr;
59			my %ignore_list;
60			my %default_attr;
61
62			sub string($) {
63			local $_ = join "", @{shift->contents};
64			$_ =~ s/^\s+//;
65			$_ =~ s/\s+$//;
66			$_ =~ s/\s+/ /g;
67			$_
68			}
69
70			sub parse_attr {
71			my ($e, $sect) = @_;
72
73	root	1.2	my $arch = {
74	root	1.1	name => $e->attr ("editor"),
75			type => $e->attr ("type"),
76			desc => string $e,
77			$e->attr("arch_begin") ? (end => $e->attr("arch_end")) : (),
78			};
79	root	1.2
80			if ($arch->{type} =~ s/^(bitmask)_(.*)/$1/) {
81			$arch->{values} = $BITMASK{$2} \|\|= {};
82			}
83
84			$sect->{$e->attr ("arch") \|\| $e->attr("arch_begin")} = $arch;
85	root	1.1	}
86
87			sub parse_type {
88			my ($e, $type) = @_;
89
90			for my $e (grep ref, @{$e->contents}) {
91			if ($e->name eq "required") {
92			for my $i (grep ref, @{$e->contents}) {
93			$type->{required}{$i->attr ("arch")} = $i->attr ("value");
94			}
95			} elsif ($e->name eq "attribute") {
96			parse_attr $e, $type->{attr}{Main} \|\|= {};
97			} elsif ($e->name eq "ignore") {
98			for my $i (grep ref, @{$e->contents}) {
99			if ($i->name eq "ignore_list") {
100			push @{$type->{ignore}}, $ignore_list{$i->attr ("name")} \|\|= [];
101			} elsif ($i->name eq "attribute") {
102			push @{$type->{ignore}}, $i->attr ("arch");
103			}
104			}
105			} elsif ($e->name eq "import_type") {
106			push @{$type->{import}}, $xtype{$e->attr ("name")} \|\|= {};
107			} elsif ($e->name eq "use") {
108			$type->{use} = string $e;
109			} elsif ($e->name eq "description") {
110			$type->{desc} = string $e;
111			} elsif ($e->name eq "section") {
112			for my $i (grep ref, @{$e->contents}) {
113			parse_attr $i, $type->{attr}{$e->attr ("name")} \|\|= {};
114			}
115			# $type->{desc} = string $e;
116			} else {
117			warn "unknown types subelement ", $e->name;
118			}
119			}
120
121			$type
122			}
123
124			for my $e (grep ref, @{$type->root->contents}) {
125			if ($e->name eq "bitmask") {
126	root	1.2	my $bm = $bitmask{$e->attr ("name")} \|\|= {};
127	root	1.1	for my $b (grep ref, @{$e->contents}) {
128			$bm->{$b->attr ("bit")} = $b->attr ("name");
129			}
130			} elsif ($e->name eq "list") {
131	root	1.2	my $list = $list{$e->attr ("name")} \|\|= {};
132	root	1.1	for my $b (grep ref, @{$e->contents}) {
133			$list->{$b->attr ("value")} = $b->attr ("name");
134			}
135			} elsif ($e->name eq "ignore_list") {
136			my $list = $ignore_list{$e->attr ("name")} \|\|= [];
137			for my $b (grep ref, @{$e->contents}) {
138			push @$list, $b->attr ("arch");
139			}
140			} elsif ($e->name eq "default_type") {
141			parse_type $e, \%default_attr;
142			} elsif ($e->name eq "type") {
143			my $type = $attr{$e->attr ("name")} \|\|= {};
144			parse_type $e, $type;
145			unshift @{$type->{import}}, \%default_attr;
146			$type{$e->attr ("number")}{type}{$e->attr ("name")} = $type;
147
148			} else {
149			warn "unknown types element ", $e->name;
150			}
151			}
152
153			my $type = XML::Parser->new (Style => 'grove')->parsefile ("res/typenumbers.xml");
154
155			for (grep ref, @{$type->root->contents}) {
156			$type{$_->attr ("number")}{name} = $_->attr ("name");
157			}
158
159			dump_hash "TYPE", \%type;
160
161			my $spell = XML::Parser->new (Style => 'grove')->parsefile ("res/spells.xml")
162			or die;
163
164			my %spell;
165
166			for (grep ref, @{$spell->root->contents}) {
167			$spell{$_->attr ("id")} = $_->attr ("name");
168			}
169
170			dump_hash "SPELL", \%spell;
171
172			print <<EOF;
173
174			=head1 AUTHOR
175
176			Marc Lehmann <schmorp@schmorp.de>
177			http://home.schmorp.de/
178
179			The source files are part of the CFJavaEditor.
180
181			=cut
182
183			1
184			EOF
185