1 |
#!/opt/bin/perl |
2 |
|
3 |
use utf8; |
4 |
use strict qw(vars subs); |
5 |
|
6 |
use Deliantra; |
7 |
use IO::AIO; |
8 |
use List::Util; |
9 |
|
10 |
Deliantra::load_archetypes; |
11 |
|
12 |
sub scan_files($$) { |
13 |
my ($path, $cb) = @_; |
14 |
|
15 |
aio_scandir $path, 3, sub { |
16 |
my ($dirs, $nondirs) = @_; |
17 |
|
18 |
scan_files("$path/$_", $cb) for @$dirs; |
19 |
|
20 |
for my $file (@$nondirs) { |
21 |
next unless $file =~ /\.arc$/; |
22 |
|
23 |
my $data; |
24 |
aio_load "$path/$file", $data, sub { |
25 |
$cb->("$path/$file", read_arch \$data); |
26 |
}; |
27 |
} |
28 |
}; |
29 |
} |
30 |
|
31 |
sub for_all_arc($) { |
32 |
scan_files $ENV{DELIANTRA_ARCHDIR} || ".", $_[0]; |
33 |
|
34 |
IO::AIO::flush; |
35 |
} |
36 |
|
37 |
sub extract { |
38 |
my (undef, $filter, @slots) = @ARGV; |
39 |
|
40 |
$filter =~ s/%(\w+)/\$_{$1}/g; |
41 |
$filter = eval "sub { $filter }" |
42 |
or die $@; |
43 |
|
44 |
my @res; |
45 |
|
46 |
unshift @slots, "_name"; |
47 |
|
48 |
my @widths = map s/\=(\d+)// && $1, @slots; |
49 |
my @big; |
50 |
|
51 |
local *_; |
52 |
for (sort keys %ARCH) { |
53 |
*_ = $ARCH{$_}; |
54 |
next unless &$filter; |
55 |
push @res, [@_{@slots}]; |
56 |
}; |
57 |
|
58 |
for my $row (@res) { |
59 |
for (0 .. $#$row) { |
60 |
$big[$_] =1 if $row->[$_] =~ /\n/; |
61 |
} |
62 |
} |
63 |
for my $i (0 .. $#widths) { |
64 |
$widths[$i] ||= List::Util::max map length $_->[$i], \@slots, @res; |
65 |
} |
66 |
|
67 |
for (0 .. $#big) { |
68 |
$widths[$_] = length $slots[$_] if $big[$_]; |
69 |
} |
70 |
|
71 |
my $format = join " ", map "%-${_}s", @widths; |
72 |
printf "$format\n", map "A$_", map $_ + 1, @widths; |
73 |
printf "$format\n", @slots; |
74 |
for my $row (@res) { |
75 |
print "\n" if @big; |
76 |
|
77 |
printf "$format\n", map $big[$_] ? "\x{fffc}" : $row->[$_], 0 .. $#$row; |
78 |
|
79 |
for (grep $big[$_], 0 .. $#big) { |
80 |
print "$row->[$_]%%\n"; |
81 |
} |
82 |
} |
83 |
} |
84 |
|
85 |
sub insert { |
86 |
shift @ARGV; |
87 |
my $format = <STDIN>; |
88 |
my @slots = unpack $format, <STDIN>; |
89 |
|
90 |
my %res; |
91 |
|
92 |
while (<STDIN>) { |
93 |
next unless /\S/; |
94 |
|
95 |
my @row = unpack $format, $_; |
96 |
|
97 |
for (0 .. $#row) { |
98 |
next unless $row[$_] eq "\x{fffc}"; |
99 |
|
100 |
local $/ = "%%\n"; |
101 |
chomp ($row[$_] = <STDIN>); |
102 |
} |
103 |
|
104 |
$res{$row[0]} = \@row; |
105 |
} |
106 |
|
107 |
for_all_arc sub { |
108 |
my ($path, $arch) = @_; |
109 |
|
110 |
my $chg; |
111 |
|
112 |
for (keys %$arch) { |
113 |
my $data = $res{$_} |
114 |
or next; |
115 |
|
116 |
my $arch = $arch->{$_}; |
117 |
|
118 |
for (0 .. $#$data) { |
119 |
next if $data->[$_] eq $arch->{$slots[$_]}; |
120 |
$chg = 1; |
121 |
$arch->{$slots[$_]} = $data->[$_]; |
122 |
} |
123 |
} |
124 |
|
125 |
if ($chg) { |
126 |
open my $fh, ">:raw:utf8", "$path~" |
127 |
or die "$path~: $!"; |
128 |
print $fh Deliantra::archlist_to_string [ |
129 |
map $arch->{$_}, |
130 |
sort keys %$arch |
131 |
]; |
132 |
close $fh; |
133 |
system "diff", "-u", $path, "$path~"; |
134 |
unlink "$path~"; |
135 |
} |
136 |
}; |
137 |
} |
138 |
|
139 |
binmode STDIN, ":utf8"; |
140 |
binmode STDOUT, ":utf8"; |
141 |
|
142 |
if ($ARGV[0] eq "extract") { |
143 |
extract; |
144 |
} elsif ($ARGV[0] eq "diff") { |
145 |
insert; |
146 |
} else { |
147 |
die <<EOF; |
148 |
Usage: |
149 |
|
150 |
$0 extract 'filter' slot... |
151 |
|
152 |
extract slots from server archetypes file (NOT the .arc files!) |
153 |
Example: $0 extract '%type == 101' level |
154 |
|
155 |
$0 diff [really] |
156 |
|
157 |
generates a diff against the .arc files found |
158 |
in \$DELIANTRA_ARCHDIR or ".". |
159 |
|
160 |
Example: $0 diff <file |
161 |
|
162 |
EOF |
163 |
} |
164 |
|
165 |
|
166 |
|