| 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"; |
