ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/utils/cfutil.in
(Generate patch)

Comparing deliantra/server/utils/cfutil.in (file contents):
Revision 1.27 by root, Wed Apr 18 07:59:03 2007 UTC vs.
Revision 1.53 by root, Sun Aug 19 09:27:08 2007 UTC

… …
6my $exec_prefix = "@exec_prefix@"; 6my $exec_prefix = "@exec_prefix@";
7my $datarootdir = "@datarootdir@"; 7my $datarootdir = "@datarootdir@";
8my $DATADIR = "@datadir@/@PACKAGE@"; 8my $DATADIR = "@datadir@/@PACKAGE@";
9 9
10my $CONVERT = "@CONVERT@"; 10my $CONVERT = "@CONVERT@";
11my $IDENTIFY = "@IDENTIFY@"; 11#my $IDENTIFY = "@IDENTIFY@";
12my $OPTIPNG = "@OPTIPNG@"; 12my $OPTIPNG = "@OPTIPNG@";
13my $RSYNC = "@RSYNC@"; 13my $RSYNC = "@RSYNC@";
14my $PNGNQ = "@PNGNQ@";
14 15
15use Getopt::Long; 16use Getopt::Long;
16use Coro::Event; 17use Coro::Event;
17use AnyEvent; 18use AnyEvent;
18use IO::AIO (); 19use IO::AIO ();
19use File::Temp; 20use File::Temp;
20use Crossfire; 21use Crossfire;
21use Coro; 22use Coro;
22use Coro::AIO; 23use Coro::AIO;
24use Coro::Util;
23use POSIX (); 25use POSIX ();
24use Digest::MD5; 26use Digest::MD5;
27use Carp;
28use Coro::Channel;
25use Coro::Storable; $Storable::canonical = 1; 29use Coro::Storable; $Storable::canonical = 1;
30
31$SIG{QUIT} = sub { Carp::cluck "QUIT" };
26 32
27sub usage { 33sub usage {
28 warn <<EOF; 34 warn <<EOF;
29Usage: cfutil [-v] [-q] [--force] [--cache] 35Usage: cfutil [-v] [-q] [--force] [--cache]
30 [--install-arch path] 36 [--install-arch path]
… …
42my $CACHE = 0; 48my $CACHE = 0;
43my $FORCE; 49my $FORCE;
44my $TMPDIR = "/tmp/cfutil$$~"; 50my $TMPDIR = "/tmp/cfutil$$~";
45my $TMPFILE = "aaaa0"; 51my $TMPFILE = "aaaa0";
46 52
53our %COLOR = (
54 black => 0,
55 white => 1,
56 navy => 2,
57 red => 3,
58 orange => 4,
59 blue => 5,
60 darkorange => 6,
61 green => 7,
62 lightgreen => 8,
63 grey => 9,
64 brown => 10,
65 gold => 11,
66 tan => 12,
67);
68
47END { system "rm", "-rf", $TMPDIR } 69END { system "rm", "-rf", $TMPDIR }
48 70
49Event->signal (signal => "INT", cb => sub { exit 1 }); 71Event->signal (signal => "INT", cb => sub { exit 1 });
50Event->signal (signal => "TERM", cb => sub { exit 1 }); 72Event->signal (signal => "TERM", cb => sub { exit 1 });
51 73
… …
68} 90}
69 91
70sub inst_maps($) { 92sub inst_maps($) {
71 my (undef, $path) = @_; 93 my (undef, $path) = @_;
72 94
73 print "installing '$path' to '$DATADIR/maps'\n"; 95 print "\nInstalling '$path' to '$DATADIR/maps'\n\n";
74 96
75 if (!-f "$path/regions") { 97 if (!-f "$path/regions") {
76 warn "'$path' does not look like a maps directory ('regions' file is missing).\n"; 98 warn "'$path' does not look like a maps directory ('regions' file is missing).\n";
77 exit 1 unless $FORCE; 99 exit 1 unless $FORCE;
78 } 100 }
79 101
80 system $RSYNC, "-av", "$path/.", "$DATADIR/maps/.", "--delete", "--exclude", "CVS", "--delete-excluded" 102 system $RSYNC, "-a", "--chmod=u=rwX,go=rX", "$path/.", "$DATADIR/maps/.", "--delete", "--exclude", "CVS", "--delete-excluded"
81 and die "map installation failed.\n"; 103 and die "map installation failed.\n";
82 104
83 print "maps installed successfully.\n"; 105 print "maps installed successfully.\n";
84} 106}
85 107
86{ 108{
87 our %ANIMINFO; 109 our %ANIMINFO;
88 our %FACEINFO; 110 our %FACEINFO;
111 our %RESOURCE;
112 our @ARC;
89 our %ARC; 113 our %ARC;
90 our $TRS; 114 our $TRS;
91 our $NFILE; 115 our $NFILE;
116 our $PATH;
92 117
93 our $QUANTIZE = "+dither -colorspace RGB -colors 256"; 118 our $QUANTIZE = "+dither -colorspace RGB -colors 256";
94 119
95 our (@png, @trs, @arc); # files we are interested in 120 our $c_arc = new Coro::Channel;
121 our $c_trs = new Coro::Channel;
122 our $c_res = new Coro::Channel;
123
124 our @c_png;
96 125
97 sub commit_png($$$) { 126 sub commit_png($$$) {
98 my ($name, $data, $T) = @_; 127 my ($name, $data, $T) = @_;
99 128
100 $FACEINFO{$name}{"data$T"} = $data; 129 $FACEINFO{$name}{"data$T"} = $data;
101 } 130 }
102 131
103 sub process_png { 132 sub process_png {
104 while (@png) { 133 while (@c_png) {
105 my ($path, $delete) = @{pop @png}; 134 my ($path, $delete) = @{pop @c_png};
106 135
107 my $png; 136 my $png;
108 aio_lstat $path; 137 aio_lstat $path;
109 my ($size, $mtime) = (stat _)[7,9]; 138 my ($size, $mtime) = (stat _)[7,9];
110 139
… …
147 # possibly enlarge 176 # possibly enlarge
148 if (0 > aio_stat "$stem.64x64.png") { 177 if (0 > aio_stat "$stem.64x64.png") {
149 my $other = "$stem.64x64.png~"; 178 my $other = "$stem.64x64.png~";
150 179
151 if (0 > aio_lstat $other or (-M _) > (-M $path)) { 180 if (0 > aio_lstat $other or (-M _) > (-M $path)) {
152 my $wrap = 0; # for the time being
153 fork_sub { 181 fork_sub {
182 my $CROP;
183 my $SRC = "png:\Q$path\E";
184
185 # check if this is a wall. ultra-ugly. ultra-ultra-ugly.
186 if ($path =~ /^(.*\/wall\/.*_)([0-9A-F])(\.x11.*\.png)$/) {
187 my ($pfx, $dir, $sfx) = ($1, hex $2, $3);
188 #check for 0..F images to be sure(?) this is a wall
189 unless (grep { !-e sprintf "%s%X%s", $pfx, $_, $sfx } 0..15) {
190 # add a 4px border and add other images around it
191 $CROP = "-shave 8x8 +repage";
192
193 $w += 8;
194 $h += 8;
195
196 $SRC = "-size ${w}x${h} xc:transparent";
197 $SRC .= " png:\Q$path\E -geometry +4+4 -composite";
198
199 # 8 surrounding images
200 for (
201 # x y b r0 r1
202 [-1, -1, 0, 6],
203 [ 0, -1, 1, 10, 14],
204 [+1, -1, 0, 12],
205
206 [-1, 0, 8, 5, 7],
207 #
208 [+1, 0, 2, 5, 13],
209
210 [-1, +1, 0, 3],
211 [ 0, +1, 4, 10, 11],
212 [+1, +1, 0, 9],
213 ) {
214 my ($x, $y, $d, $r0, $r1) = @$_;
215 $SRC .= sprintf " png:%s%X%s -geometry %+d%+d -composite",
216 "\Q$pfx",
217 ($dir & $d) ? $r1 : $r0,
218 "\Q$sfx",
219 $x * ($w - 8) + 4,
220 $y * ($h - 8) + 4;
221 }
222 }
223 }
224
154 system "convert png:\Q$path\E -depth 8 rgba:-" 225 system "convert -depth 8 $SRC rgba:-"
155 . "| $exec_prefix/bin/cfhq2xa $w $h $wrap" 226 . "| $exec_prefix/bin/cfhq2xa $w $h 0"
156 . "| convert -depth 8 -size ".($w * 2)."x".($h * 2)." rgba:- $QUANTIZE -quality 00 png32:\Q$other\E~" 227 . "| convert -depth 8 -size ".($w * 2)."x".($h * 2)." rgba:- $CROP $QUANTIZE -quality 00 png32:\Q$other\E~"
157 and die "convert/hq2xa pipeline error: status $? ($!)"; 228 and die "convert/cfhq2xa pipeline error: status $? ($!)";
158 system $OPTIPNG, "-o5", "-i0", "-q", "$other~"; 229 system $OPTIPNG, "-i0", "-q", "$other~";
159 die "$other~ has zero size, aborting." unless -s "$other~"; 230 die "$other~ has zero size, aborting." unless -s "$other~";
160 rename "$other~", $other; 231 rename "$other~", $other;
161 }; 232 };
162 } 233 }
163 234
164 push @png, [$other, !$CACHE]; 235 push @c_png, [$other, !$CACHE];
165 } 236 }
166 237
167 # possibly scale down 238 # possibly scale down
168 if (0 > aio_stat "$stem.32x32.png") { 239 if (0 > aio_stat "$stem.32x32.png") {
169 my $other = "$stem.32x32.png~"; 240 my $other = "$stem.32x32.png~";
170 241
171 if (0 > aio_lstat $other or (-M _) > (-M $path)) { 242 if (0 > aio_lstat $other or (-M _) > (-M $path)) {
172 fork_sub { 243 fork_sub {
173 system "convert png:\Q$path\E -geometry 50% -filter lanczos $QUANTIZE -quality 00 png32:\Q$other\E~"; 244 system "convert png:\Q$path\E -geometry 50% -filter lanczos $QUANTIZE -quality 00 png32:\Q$other\E~";
174 system $OPTIPNG, "-o5", "-i0", "-q", "$other~"; 245 system $OPTIPNG, "-i0", "-q", "$other~";
246
247 # reduce smoothfaces >10000 bytes
248 if ($stem =~ /_S\./ && (-s "$other~") > 10000) {
249 my $ncolor = 256;
250 while () {
251 system "<\Q$other~\E $PNGNQ -s1 -n$ncolor >\Q$other~~\E";
252 system $OPTIPNG, "-i0", "-q", "$other~~";
253 last if 10000 > -s "$other~~";
254 $ncolor = int $ncolor * 0.9;
255 $ncolor > 8 or die "cannot reduce filesize to < 10000 bytes";
256 }
257
258 printf "reduced %s from %d to %d bytes using %d colours.\n",
259 $other, -s "$other~", -s "$other~~", $ncolor
260 if $VERBOSE >= 2;
261 rename "$other~~", "$other~";
262 }
263
175 die "$other~ has zero size, aborting." unless -s "$other~"; 264 die "$other~ has zero size, aborting." unless -s "$other~";
176 rename "$other~", $other; 265 rename "$other~", $other;
177 }; 266 };
178 } 267 }
179 268
180 #warn "scaled down $path to $other\n";#d# 269 #warn "scaled down $path to $other\n";#d#
181 push @png, [$other, !$CACHE]; 270 push @c_png, [$other, !$CACHE];
182 } 271 }
183 } 272 }
184 273
185 (my $face = $stem) =~ s/^.*\///; 274 (my $face = $stem) =~ s/^.*\///;
186 275
… …
247 aio_unlink $path if $delete; 336 aio_unlink $path if $delete;
248 } 337 }
249 } 338 }
250 339
251 sub process_arc { 340 sub process_arc {
252 while (@arc) { 341 while (my $job = $c_arc->get) {
253 my ($dir, $file) = @{pop @arc}; 342 my ($dir, $file) = @$job;
254 343
255 my $arc; 344 my $arc;
256 aio_load "$dir/$file", $arc; # simply pre-cache, as read_arch wants a file :/ 345 aio_load "$dir/$file", $arc; # simply pre-cache, as read_arch wants a file :/
257 346
258 my $arc = read_arch "$dir/$file"; 347 my $arc = read_arch "$dir/$file";
259 for my $o (values %$arc) { 348 for my $o (values %$arc) {
349 push @ARC, $o;
350 for (my $m = $o; $m; $m = $m->{more}) {
260 $ARC{$o->{_name}} = $o; 351 $ARC{$m->{_name}} = $m;
352 }
261 353
262 $o->{editor_folder} = $dir; 354 $o->{editor_folder} = $dir;
263 355
264 my $visibility = delete $o->{visibility}; 356 my $visibility = delete $o->{visibility};
265 my $magicmap = delete $o->{magicmap}; 357 my $magicmap = delete $o->{magicmap};
… …
278 370
279 my $ext = $x|$y ? "+$x+$y" : ""; 371 my $ext = $x|$y ? "+$x+$y" : "";
280 372
281 $o->{face} .= $ext unless /^blank.x11$|^empty.x11$/ || !$o->{face}; 373 $o->{face} .= $ext unless /^blank.x11$|^empty.x11$/ || !$o->{face};
282 374
283 my $visibility = delete $o->{visibility} if exists $o->{visibility}; 375 $visibility = delete $o->{visibility} if exists $o->{visibility};
284 my $magicmap = delete $o->{magicmap} if exists $o->{magicmap}; 376 $magicmap = delete $o->{magicmap} if exists $o->{magicmap};
285 377
286 my $anim = delete $o->{anim}; 378 my $anim = delete $o->{anim};
287 379
288 if ($anim) { 380 if ($anim) {
289 # possibly add $ext to the animation name to avoid 381 # possibly add $ext to the animation name to avoid
… …
312 for my $face ($o->{face} || (), @{$anim || []}) { 404 for my $face ($o->{face} || (), @{$anim || []}) {
313 next if $face =~ /^facings\s|^blank.x11$|^empty.x11$/; 405 next if $face =~ /^facings\s|^blank.x11$|^empty.x11$/;
314 406
315 my $info = $FACEINFO{$face} ||= {}; 407 my $info = $FACEINFO{$face} ||= {};
316 408
409 $info->{arc} = $o;
317 $info->{visibility} = $visibility if defined $visibility; 410 $info->{visibility} = $visibility if defined $visibility;
318 $info->{magicmap} = $magicmap if defined $magicmap; 411 $info->{magicmap} = $magicmap if defined $magicmap;
319 } 412 }
320 413
321 if (my $smooth = delete $o->{smoothface}) { 414 if (my $smooth = delete $o->{smoothface}) {
… …
330 } 423 }
331 } 424 }
332 } 425 }
333 426
334 sub process_trs { 427 sub process_trs {
335 while (@trs) { 428 while (my $job = $c_trs->get) {
336 my ($dir, $file) = @{pop @trs}; 429 my ($dir, $file) = @$job;
337 my $path = "$dir/$file"; 430 my $path = "$dir/$file";
338 431
339 my $trs; 432 my $trs;
340 if (0 > aio_load $path, $trs) { 433 if (0 > aio_load $path, $trs) {
341 warn "$path: $!, skipping.\n"; 434 warn "$path: $!, skipping.\n";
… …
344 437
345 $TRS .= $trs; 438 $TRS .= $trs;
346 } 439 }
347 } 440 }
348 441
442 my %FILECACHE;
443
444 sub load_cached($;$) {
445 unless (exists $FILECACHE{$_[0]}) {
446 my $data;
447 if (0 < aio_load $_[0], $data) {
448 if ($_[1]) {
449 $data = eval { $_[1]->($data) };
450 warn "$_[0]: $@" if $@;
451 }
452 }
453
454 $FILECACHE{$_[0]} = $data;
455 }
456
457 $FILECACHE{$_[0]}
458 }
459
460 sub process_res {
461 while (my $job = $c_res->get) {
462 my ($dir, $file, $type) = @$job;
463
464 my $data;
465 aio_load "$dir/$file", $data;
466
467 my $meta = load_cached "$dir/meta", sub { JSON::XS::from_json shift };
468
469 next if $meta && !exists $meta->{$file};
470
471 $meta = {
472 %{ $meta->{"" } || {} },
473 %{ $meta->{$file} || {} },
474 };
475
476 if ($meta->{license} =~ s/^#//) {
477 $meta->{license} = ({
478 "pd" => "Public Domain",
479 "gpl" => "GNU General Public License, version 3.0 or any later",
480 "cc/by/2.0" => "Licensed under Creative Commons Attribution 2.0 http://creativecommons.org/licenses/by/2.0/",
481 "cc/by/2.5" => "Licensed under Creative Commons Attribution 2.5 http://creativecommons.org/licenses/by/2.5/",
482 "cc/by/3.0" => "Licensed under Creative Commons Attribution 3.0 http://creativecommons.org/licenses/by/3.0/",
483 })->{$meta->{license}}
484 || warn "$dir/$file: license tag '$meta->{license}' not found.";
485 }
486
487 $file =~ s/\.res$//;
488 $file =~ s/\.(ogg|wav|jpg|png)$//;
489
490 substr $dir, 0, 1 + length $PATH, "";
491
492 $RESOURCE{"$dir/$file"} = {
493 type => (delete $meta->{type}) || $type,
494 data => $data,
495 chksum => (Digest::MD5::md5 $data),
496 %$meta ? (meta => $meta) : (),
497 };
498 }
499 }
500
349 sub find_files; 501 sub find_files;
350 sub find_files { 502 sub find_files {
351 my ($path) = @_; 503 my ($path) = @_;
352 504
353 IO::AIO::aioreq_pri 4; 505 IO::AIO::aioreq_pri 4;
… …
355 my ($dirs, $nondirs) = @_; 507 my ($dirs, $nondirs) = @_;
356 508
357 find_files "$path/$_" 509 find_files "$path/$_"
358 for grep $_ !~ /^(?:CVS|dev)$/, @$dirs; 510 for grep $_ !~ /^(?:CVS|dev)$/, @$dirs;
359 511
512 my $dir = $path;
513 substr $dir, 0, 1 + length $PATH, "";
514
360 for my $file (@$nondirs) { 515 for my $file (@$nondirs) {
516 if ($dir =~ /^music(?:\/|$)/) {
517 $c_res->put ([$path, $file, 3]) # FT_MUSIC
518 if $file =~ /\.(ogg)$/;
519
520 } elsif ($dir =~ /^sound(?:\/|$)/) {
521 $c_res->put ([$path, $file, 5]) # FT_SOUND
522 if $file =~ /\.(wav|ogg)$/;
523
524 } elsif ($dir =~ /^res(?:\/|$)/) {
525 $c_res->put ([$path, $file, 0]) # FT_FACE
526 if $file =~ /\.(jpg|png)$/;
527 $c_res->put ([$path, $file, 7]) # FT_RSRC
528 if $file =~ /\.(res)$/;
529
361 if ($file =~ /\.png$/) { 530 } elsif ($file =~ /\.png$/) {
362 push @png, ["$path/$file", 0]; 531 push @c_png, ["$path/$file", 0];
532
363 } elsif ($file =~ /\.trs$/) { 533 } elsif ($file =~ /\.trs$/) {
364 push @trs, [$path, $file]; 534 $c_trs->put ([$path, $file]);
535
365 } elsif ($file =~ /\.arc$/) { 536 } elsif ($file =~ /\.arc$/) {
366 push @arc, [$path, $file]; 537 $c_arc->put ([$path, $file]);
538
367 } else { 539 } else {
368 warn "ignoring $path/$file\n" if $VERBOSE >= 2; 540 warn "ignoring $path/$file\n" if $VERBOSE >= 3;
369 } 541 }
370 } 542 }
371 }; 543 };
372 } 544 }
373 545
374 sub inst_arch($) { 546 sub inst_arch($) {
375 my (undef, $path) = @_; 547 my (undef, $path) = @_;
376 548
549 $PATH = $path;
550
551 print "\n",
377 print "Installing '$path' to '$DATADIR'\n", 552 "Installing '$path' to '$DATADIR'\n",
553 "\n",
378 "This can take a long time if you run this\n", 554 "This can take a long time if you run this\n",
379 "for the first time or do not use --cache.\n", 555 "for the first time or do not use --cache.\n",
380 "\n", 556 "\n",
381 "Unless you run verbosely, all following warning\n", 557 "Unless you run verbosely, all following warning\n",
382 "or error messages indicate serious problems.\n", 558 "or error messages indicate serious problems.\n",
… …
385 if (!-d "$path/treasures") { 561 if (!-d "$path/treasures") {
386 warn "'$path' does not look like an arch directory ('treasures' directory is missing).\n"; 562 warn "'$path' does not look like an arch directory ('treasures' directory is missing).\n";
387 exit 1 unless $FORCE; 563 exit 1 unless $FORCE;
388 } 564 }
389 565
566 print "scanning files...\n" if $VERBOSE;
567
390 find_files $path; 568 find_files $path;
569
570 my @a_arc = map +(async \&process_arc), 1..2;
571 my @a_res = map +(async \&process_res), 1..2;
572 my @a_trs = map +(async \&process_trs), 1..2;
573
391 IO::AIO::flush; 574 IO::AIO::flush;
392 575
393 $_->join for ( 576 $c_res->put (undef) for @a_res;
577 $c_arc->put (undef) for @a_arc;
578 $c_trs->put (undef) for @a_trs;
579
580 print "start file scan, arc, res processing...\n" if $VERBOSE;
581
582 $_->join for @a_arc; # need to parse all archetypes before png processing
583
584 print "end arc, start png processing...\n" if $VERBOSE;
585
394 # four png crunchers work fine for my 2x smp machine 586 # four png crunchers work fine for my 2x smp machine
395 (async \&process_png), (async \&process_png), (async \&process_png), (async \&process_png), 587 my @a_png = map +(async \&process_png), 1..4;
396 (async \&process_trs), (async \&process_trs),
397 (async \&process_arc), (async \&process_arc),
398 );
399 588
589 $_->join for (@a_trs, @a_res, @a_png);
590
591 print "scanning done, processing results...\n" if $VERBOSE;
400 { 592 {
401 # remove path prefix from editor_folder 593 # remove path prefix from editor_folder
402 substr $_->{editor_folder}, 0, 1 + length $path, "" 594 substr $_->{editor_folder}, 0, 1 + length $path, ""
403 for values %ARC; 595 for values %ARC;
404 596
597 print "resolving inheritance tree...\n" if $VERBOSE;
405 # resolve inherit 598 # resolve inherit
406 while () { 599 while () {
407 my $progress; 600 my $progress;
408 my $loop; 601 my $loop;
409 602
… …
412 if (my $s = $ARC{$other}) { 605 if (my $s = $ARC{$other}) {
413 if ($s->{inherit}) { 606 if ($s->{inherit}) {
414 $loop = $s; 607 $loop = $s;
415 } else { 608 } else {
416 delete $o->{inherit}; 609 delete $o->{inherit};
610 my %s = %$s;
611 delete @s{qw(_name more name name_pl)};
417 %$o = ( %$s, %$o ); 612 %$o = ( %s, %$o );
418 ++$progress; 613 ++$progress;
419 } 614 }
420 } else { 615 } else {
421 warn "'$o->{_name}' tries to inherit from undefined archetype '$other', skipping.\n"; 616 warn "'$o->{_name}' tries to inherit from undefined archetype '$other', skipping.\n";
422 delete $ARC{$o->{_name}}; 617 delete $ARC{$o->{_name}};
… …
430 625
431 last; 626 last;
432 } 627 }
433 } 628 }
434 629
630 # remove base classes (by naming scheme, should use something like "baseclass xxx" to inherit
631 @ARC = grep $_->{_name} !~ /^(?:type|class)_/, @ARC;
632
633 print "writing archetypes...\n" if $VERBOSE;
435 open my $fh, ">:utf8", "$DATADIR/archetypes~" 634 open my $fh, ">:utf8", "$DATADIR/archetypes~"
436 or die "$DATADIR/archetypes~: $!"; 635 or die "$DATADIR/archetypes~: $!";
437 print $fh Crossfire::archlist_to_string [sort { $a->{_name} cmp $b->{_name} } values %ARC]; 636 print $fh Crossfire::archlist_to_string [sort { $a->{_name} cmp $b->{_name} } @ARC];
438 } 637 }
439 638
440 { 639 {
640 print "writing treasures...\n" if $VERBOSE;
441 open my $fh, ">:utf8", "$DATADIR/treasures~" 641 open my $fh, ">:utf8", "$DATADIR/treasures~"
442 or die "$DATADIR/treasures~: $!"; 642 or die "$DATADIR/treasures~: $!";
443 print $fh $TRS; 643 print $fh $TRS;
444 } 644 }
445 645
446 { 646 {
647 print "processing facedata...\n" if $VERBOSE;
447 while (my ($k, $v) = each %FACEINFO) { 648 while (my ($k, $v) = each %FACEINFO) {
448 length $v->{data32} or warn "$k: face has no png32. this will not work (shoddy gcfclient will crash of course).\n"; 649 length $v->{data32} or warn "$k: face has no png32. this will not work (shoddy gcfclient will crash of course).\n";
449 length $v->{data64} or warn "$k: face has no png64. this will not work very well.\n"; 650 length $v->{data64} or warn "$k: face has no png64. this will not work very well.\n";
450 651
451 length $v->{data32} <= 10000 or warn "$k: face32 larger than 10000 bytes, will not work with crossfire client.\n"; 652 length $v->{data32} <= 10000 or warn "$k: face32 larger than 10000 bytes, will not work with crossfire client.\n";
452 #length $v->{data64} <= 10000 or warn "$k: face64 larger than 10000 bytes.\n"; 653 #length $v->{data64} <= 10000 or warn "$k: face64 larger than 10000 bytes.\n";
453 654
454 $v->{chksum32} = Digest::MD5::md5 $v->{data32}; 655 $v->{chksum32} = Digest::MD5::md5 $v->{data32};
455 $v->{chksum64} = Digest::MD5::md5 $v->{data64}; 656 $v->{chksum64} = Digest::MD5::md5 $v->{data64};
657
658 if (my $magicmap = $v->{magicmap}) {
659 $magicmap =~ y/A-Z_\-/a-z/d;
660 $v->{magicmap} = $COLOR{$magicmap};
456 } 661 }
457 662
663 delete $v->{arc};
664 }
665
666 print "writing facedata...\n" if $VERBOSE;
458 open my $fh, ">:perlio", "$DATADIR/facedata~" 667 open my $fh, ">:perlio", "$DATADIR/facedata~"
459 or die "$DATADIR/facedata~: $!"; 668 or die "$DATADIR/facedata~: $!";
460 669
461 print $fh freeze { 670 print $fh freeze {
462 version => 2, 671 version => 2,
463 faceinfo => \%FACEINFO, 672 faceinfo => \%FACEINFO,
464 animinfo => \%ANIMINFO, 673 animinfo => \%ANIMINFO,
674 resource => \%RESOURCE,
465 }; 675 };
466 } 676 }
677
678 print "committing files...\n" if $VERBOSE;
467 679
468 for (qw(archetypes facedata treasures)) { 680 for (qw(archetypes facedata treasures)) {
469 chmod 0644, "$DATADIR/$_~"; 681 chmod 0644, "$DATADIR/$_~";
470 rename "$DATADIR/$_~", "$DATADIR/$_" 682 rename "$DATADIR/$_~", "$DATADIR/$_"
471 or die "$DATADIR/$_: $!"; 683 or die "$DATADIR/$_: $!";

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines