1 |
#!/usr/bin/env perl |
2 |
|
3 |
use strict; |
4 |
use warnings; |
5 |
|
6 |
sub usage { |
7 |
return "Usage: perl arch2xml <arches>\n\n" |
8 |
." arches the root directory of the arch files you want to put into XML\n"; |
9 |
} |
10 |
|
11 |
die usage unless @ARGV; |
12 |
|
13 |
my $root = $ARGV[0]; |
14 |
opendir TMP, $root or die "$root: $!\n"; |
15 |
closedir TMP; |
16 |
|
17 |
#-------------------------------------------------- |
18 |
# use File::Find; |
19 |
# |
20 |
# my @arches = (); |
21 |
# |
22 |
# sub recurse { |
23 |
# my ($top_level_dir) = @_; |
24 |
# finddepth(\&isarc, $top_level_dir); |
25 |
# } |
26 |
# |
27 |
# sub isarc { |
28 |
# if (-f && /\.arc$/) { |
29 |
# push @arches, $File::Find::name, chomp $/; |
30 |
# } |
31 |
# } |
32 |
#-------------------------------------------------- |
33 |
|
34 |
sub arch2xml { |
35 |
# recurse '.'; |
36 |
my ($root) = @_; |
37 |
my @arches = split /\n/, `find $root -type f -name \*.arc`; |
38 |
my @faces = split /\n/, `find $root -type f -name \*.png`; |
39 |
|
40 |
my $xml = ""; |
41 |
for my $file (@arches) { |
42 |
my @arch = do { open my $fh, "<$file" or die "$file: $!"; <$fh> }; |
43 |
|
44 |
my $msg = ""; |
45 |
my $ismsg = 0; |
46 |
my $anim = ""; |
47 |
my $isanim = 0; |
48 |
|
49 |
for my $line (@arch) { |
50 |
chomp $line; |
51 |
|
52 |
next if ($line =~ /^#/ or $line =~ /^(\s+)?$/); |
53 |
|
54 |
if ($line eq "endmsg") { |
55 |
$xml .= "\t\t<msg>$msg</msg>\n"; |
56 |
$msg = ""; |
57 |
$ismsg = 0; |
58 |
} |
59 |
if ($ismsg) { |
60 |
$msg .= "$line "; |
61 |
next; |
62 |
} |
63 |
|
64 |
if ($line eq "mina") { |
65 |
$xml .= "\t\t<anim>\n\t\t$anim</anim>\n"; |
66 |
$anim = ""; |
67 |
$isanim = 0; |
68 |
} |
69 |
if ($isanim) { |
70 |
$anim .= "\t<face>$line</face>\n\t\t"; |
71 |
next; |
72 |
} |
73 |
|
74 |
if ($line =~ /object/) { |
75 |
$line =~ s/^object //; |
76 |
$xml .= "\t<object>\n"; |
77 |
$xml .= "\t\t<arch>$line</arch>\n"; |
78 |
} elsif ($line =~ /^end$/) { |
79 |
$xml .= "\t</object>\n"; |
80 |
} elsif ($line eq "msg") { |
81 |
$ismsg = 1; |
82 |
} elsif ($line eq "anim") { |
83 |
$isanim = 1; |
84 |
} elsif ($line eq "more") { |
85 |
# handle "more" |
86 |
} elsif ($line eq "mina") { |
87 |
# handled above |
88 |
} elsif ($line eq "endmsg") { |
89 |
# handled above |
90 |
} elsif ($line =~ /^face .+/) { |
91 |
$line =~ s/^face (.+)\.(...)$/$1.base.$2.png/; |
92 |
my @face = grep (/$line/, @faces); |
93 |
my $face = @face ? $face[0] : "$root/system/blank.base.x11.png"; |
94 |
$xml .= "\t\t<face>$root/$face</face>\n"; |
95 |
} else { |
96 |
my ($tag, $data) = split / /, $line, 2; |
97 |
$xml .= "\t\t<$tag>$data</$tag>\n"; |
98 |
} |
99 |
} |
100 |
} |
101 |
|
102 |
return $xml; |
103 |
} |
104 |
|
105 |
print "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"; |
106 |
print "<?xml-stylesheet type=\"text/xsl\" href=\"arches.xsl\"?>\n"; |
107 |
print "<arches>\n"; |
108 |
print arch2xml $root; |
109 |
print "</arches>\n"; |