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.50 by root, Thu Aug 9 22:54:28 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 ();
… …
20use Crossfire; 21use Crossfire;
21use Coro; 22use Coro;
22use Coro::AIO; 23use Coro::AIO;
23use POSIX (); 24use POSIX ();
24use Digest::MD5; 25use Digest::MD5;
26use Carp;
25use Coro::Storable; $Storable::canonical = 1; 27use Coro::Storable; $Storable::canonical = 1;
28
29$SIG{QUIT} = sub { Carp::cluck "QUIT" };
26 30
27sub usage { 31sub usage {
28 warn <<EOF; 32 warn <<EOF;
29Usage: cfutil [-v] [-q] [--force] [--cache] 33Usage: cfutil [-v] [-q] [--force] [--cache]
30 [--install-arch path] 34 [--install-arch path]
… …
42my $CACHE = 0; 46my $CACHE = 0;
43my $FORCE; 47my $FORCE;
44my $TMPDIR = "/tmp/cfutil$$~"; 48my $TMPDIR = "/tmp/cfutil$$~";
45my $TMPFILE = "aaaa0"; 49my $TMPFILE = "aaaa0";
46 50
51our %COLOR = (
52 black => 0,
53 white => 1,
54 navy => 2,
55 red => 3,
56 orange => 4,
57 blue => 5,
58 darkorange => 6,
59 green => 7,
60 lightgreen => 8,
61 grey => 9,
62 brown => 10,
63 gold => 11,
64 tan => 12,
65);
66
47END { system "rm", "-rf", $TMPDIR } 67END { system "rm", "-rf", $TMPDIR }
48 68
49Event->signal (signal => "INT", cb => sub { exit 1 }); 69Event->signal (signal => "INT", cb => sub { exit 1 });
50Event->signal (signal => "TERM", cb => sub { exit 1 }); 70Event->signal (signal => "TERM", cb => sub { exit 1 });
51 71
… …
68} 88}
69 89
70sub inst_maps($) { 90sub inst_maps($) {
71 my (undef, $path) = @_; 91 my (undef, $path) = @_;
72 92
73 print "installing '$path' to '$DATADIR/maps'\n"; 93 print "\nInstalling '$path' to '$DATADIR/maps'\n\n";
74 94
75 if (!-f "$path/regions") { 95 if (!-f "$path/regions") {
76 warn "'$path' does not look like a maps directory ('regions' file is missing).\n"; 96 warn "'$path' does not look like a maps directory ('regions' file is missing).\n";
77 exit 1 unless $FORCE; 97 exit 1 unless $FORCE;
78 } 98 }
79 99
80 system $RSYNC, "-av", "$path/.", "$DATADIR/maps/.", "--delete", "--exclude", "CVS", "--delete-excluded" 100 system $RSYNC, "-a", "--chmod=u=rwX,go=rX", "$path/.", "$DATADIR/maps/.", "--delete", "--exclude", "CVS", "--delete-excluded"
81 and die "map installation failed.\n"; 101 and die "map installation failed.\n";
82 102
83 print "maps installed successfully.\n"; 103 print "maps installed successfully.\n";
84} 104}
85 105
86{ 106{
87 our %ANIMINFO; 107 our %ANIMINFO;
88 our %FACEINFO; 108 our %FACEINFO;
109 our %RESOURCE;
110 our @ARC;
89 our %ARC; 111 our %ARC;
90 our $TRS; 112 our $TRS;
91 our $NFILE; 113 our $NFILE;
114 our $PATH;
92 115
93 our $QUANTIZE = "+dither -colorspace RGB -colors 256"; 116 our $QUANTIZE = "+dither -colorspace RGB -colors 256";
94 117
95 our (@png, @trs, @arc); # files we are interested in 118 our (@png, @trs, @arc, @res); # files we are interested in
96 119
97 sub commit_png($$$) { 120 sub commit_png($$$) {
98 my ($name, $data, $T) = @_; 121 my ($name, $data, $T) = @_;
99 122
100 $FACEINFO{$name}{"data$T"} = $data; 123 $FACEINFO{$name}{"data$T"} = $data;
… …
153 fork_sub { 176 fork_sub {
154 system "convert png:\Q$path\E -depth 8 rgba:-" 177 system "convert png:\Q$path\E -depth 8 rgba:-"
155 . "| $exec_prefix/bin/cfhq2xa $w $h $wrap" 178 . "| $exec_prefix/bin/cfhq2xa $w $h $wrap"
156 . "| convert -depth 8 -size ".($w * 2)."x".($h * 2)." rgba:- $QUANTIZE -quality 00 png32:\Q$other\E~" 179 . "| convert -depth 8 -size ".($w * 2)."x".($h * 2)." rgba:- $QUANTIZE -quality 00 png32:\Q$other\E~"
157 and die "convert/hq2xa pipeline error: status $? ($!)"; 180 and die "convert/hq2xa pipeline error: status $? ($!)";
158 system $OPTIPNG, "-o5", "-i0", "-q", "$other~"; 181 system $OPTIPNG, "-i0", "-q", "$other~";
159 die "$other~ has zero size, aborting." unless -s "$other~"; 182 die "$other~ has zero size, aborting." unless -s "$other~";
160 rename "$other~", $other; 183 rename "$other~", $other;
161 }; 184 };
162 } 185 }
163 186
… …
169 my $other = "$stem.32x32.png~"; 192 my $other = "$stem.32x32.png~";
170 193
171 if (0 > aio_lstat $other or (-M _) > (-M $path)) { 194 if (0 > aio_lstat $other or (-M _) > (-M $path)) {
172 fork_sub { 195 fork_sub {
173 system "convert png:\Q$path\E -geometry 50% -filter lanczos $QUANTIZE -quality 00 png32:\Q$other\E~"; 196 system "convert png:\Q$path\E -geometry 50% -filter lanczos $QUANTIZE -quality 00 png32:\Q$other\E~";
174 system $OPTIPNG, "-o5", "-i0", "-q", "$other~"; 197 system $OPTIPNG, "-i0", "-q", "$other~";
198
199 # reduce smoothfaces >10000 bytes
200 if ($stem =~ /_S\./ && (-s "$other~") > 10000) {
201 my $ncolor = 256;
202 while () {
203 system "<\Q$other~\E $PNGNQ -s1 -n$ncolor >\Q$other~~\E";
204 system $OPTIPNG, "-i0", "-q", "$other~~";
205 last if 10000 > -s "$other~~";
206 $ncolor = int $ncolor * 0.9;
207 $ncolor > 8 or die "cannot reduce filesize to < 10000 bytes";
208 }
209
210 printf "reduced %s from %d to %d bytes using %d colours.\n",
211 $other, -s "$other~", -s "$other~~", $ncolor
212 if $VERBOSE >= 2;
213 rename "$other~~", "$other~";
214 }
215
175 die "$other~ has zero size, aborting." unless -s "$other~"; 216 die "$other~ has zero size, aborting." unless -s "$other~";
176 rename "$other~", $other; 217 rename "$other~", $other;
177 }; 218 };
178 } 219 }
179 220
… …
255 my $arc; 296 my $arc;
256 aio_load "$dir/$file", $arc; # simply pre-cache, as read_arch wants a file :/ 297 aio_load "$dir/$file", $arc; # simply pre-cache, as read_arch wants a file :/
257 298
258 my $arc = read_arch "$dir/$file"; 299 my $arc = read_arch "$dir/$file";
259 for my $o (values %$arc) { 300 for my $o (values %$arc) {
301 push @ARC, $o;
302 for (my $m = $o; $m; $m = $m->{more}) {
260 $ARC{$o->{_name}} = $o; 303 $ARC{$m->{_name}} = $m;
304 }
261 305
262 $o->{editor_folder} = $dir; 306 $o->{editor_folder} = $dir;
263 307
264 my $visibility = delete $o->{visibility}; 308 my $visibility = delete $o->{visibility};
265 my $magicmap = delete $o->{magicmap}; 309 my $magicmap = delete $o->{magicmap};
… …
278 322
279 my $ext = $x|$y ? "+$x+$y" : ""; 323 my $ext = $x|$y ? "+$x+$y" : "";
280 324
281 $o->{face} .= $ext unless /^blank.x11$|^empty.x11$/ || !$o->{face}; 325 $o->{face} .= $ext unless /^blank.x11$|^empty.x11$/ || !$o->{face};
282 326
283 my $visibility = delete $o->{visibility} if exists $o->{visibility}; 327 $visibility = delete $o->{visibility} if exists $o->{visibility};
284 my $magicmap = delete $o->{magicmap} if exists $o->{magicmap}; 328 $magicmap = delete $o->{magicmap} if exists $o->{magicmap};
285 329
286 my $anim = delete $o->{anim}; 330 my $anim = delete $o->{anim};
287 331
288 if ($anim) { 332 if ($anim) {
289 # possibly add $ext to the animation name to avoid 333 # possibly add $ext to the animation name to avoid
… …
344 388
345 $TRS .= $trs; 389 $TRS .= $trs;
346 } 390 }
347 } 391 }
348 392
393 my %FILECACHE;
394
395 sub load_cached($;$) {
396 unless (exists $FILECACHE{$_[0]}) {
397 my $data;
398 if (0 < aio_load $_[0], $data) {
399 if ($_[1]) {
400 $data = eval { $_[1]->($data) };
401 warn "$_[0]: $@" if $@;
402 }
403 }
404
405 $FILECACHE{$_[0]} = $data;
406 }
407
408 $FILECACHE{$_[0]}
409 }
410
411 sub process_res {
412 while (@res) {
413 my ($dir, $file, $type) = @{pop @res};
414
415 my $data;
416 aio_load "$dir/$file", $data;
417
418 my $meta = load_cached "$dir/meta", sub { JSON::XS::from_json shift };
419
420 next if $meta && !exists $meta->{$file};
421
422 $meta = {
423 %{ $meta->{"" } || {} },
424 %{ $meta->{$file} || {} },
425 };
426
427 if ($meta->{license} =~ s/^#//) {
428 $meta->{license} = ({
429 "pd" => "Public Domain",
430 "gpl" => "GNU General Public License, version 3.0 or any later",
431 "cc/by/2.0" => "Licensed under Creative Commons Attribution 2.0 http://creativecommons.org/licenses/by/2.0/",
432 "cc/by/2.5" => "Licensed under Creative Commons Attribution 2.0 http://creativecommons.org/licenses/by/2.5/",
433 "cc/by/3.0" => "Licensed under Creative Commons Attribution 3.0 http://creativecommons.org/licenses/by/3.0/",
434 })->{$meta->{license}}
435 || warn "$dir/$file: license tag '$meta->{license}' not found.";
436 }
437
438 $file =~ s/\.res$//;
439 $file =~ s/\.(ogg|wav|jpg|png)$//;
440
441 substr $dir, 0, 1 + length $PATH, "";
442
443 $RESOURCE{"$dir/$file"} = {
444 type => (delete $meta->{type}) || $type,
445 data => $data,
446 chksum => (Digest::MD5::md5 $data),
447 %$meta ? (meta => $meta) : (),
448 };
449 }
450 }
451
349 sub find_files; 452 sub find_files;
350 sub find_files { 453 sub find_files {
351 my ($path) = @_; 454 my ($path) = @_;
352 455
353 IO::AIO::aioreq_pri 4; 456 IO::AIO::aioreq_pri 4;
… …
355 my ($dirs, $nondirs) = @_; 458 my ($dirs, $nondirs) = @_;
356 459
357 find_files "$path/$_" 460 find_files "$path/$_"
358 for grep $_ !~ /^(?:CVS|dev)$/, @$dirs; 461 for grep $_ !~ /^(?:CVS|dev)$/, @$dirs;
359 462
463 my $dir = $path;
464 substr $dir, 0, 1 + length $PATH, "";
465
360 for my $file (@$nondirs) { 466 for my $file (@$nondirs) {
467 if ($dir =~ /^music(?:\/|$)/) {
468 push @res, [$path, $file, 3] # FT_MUSIC
469 if $file =~ /\.(ogg)$/;
470
471 } elsif ($dir =~ /^sound(?:\/|$)/) {
472 push @res, [$path, $file, 5] # FT_SOUND
473 if $file =~ /\.(wav|ogg)$/;
474
475 } elsif ($dir =~ /^res(?:\/|$)/) {
476 push @res, [$path, $file, 0] # FT_FACE
477 if $file =~ /\.(jpg|png)$/;
478 push @res, [$path, $file, 7] # FT_RSRC
479 if $file =~ /\.(res)$/;
480
361 if ($file =~ /\.png$/) { 481 } elsif ($file =~ /\.png$/) {
362 push @png, ["$path/$file", 0]; 482 push @png, ["$path/$file", 0];
483
363 } elsif ($file =~ /\.trs$/) { 484 } elsif ($file =~ /\.trs$/) {
364 push @trs, [$path, $file]; 485 push @trs, [$path, $file];
486
365 } elsif ($file =~ /\.arc$/) { 487 } elsif ($file =~ /\.arc$/) {
366 push @arc, [$path, $file]; 488 push @arc, [$path, $file];
489
367 } else { 490 } else {
368 warn "ignoring $path/$file\n" if $VERBOSE >= 2; 491 warn "ignoring $path/$file\n" if $VERBOSE >= 3;
369 } 492 }
370 } 493 }
371 }; 494 };
372 } 495 }
373 496
374 sub inst_arch($) { 497 sub inst_arch($) {
375 my (undef, $path) = @_; 498 my (undef, $path) = @_;
376 499
500 $PATH = $path;
501
502 print "\n",
377 print "Installing '$path' to '$DATADIR'\n", 503 "Installing '$path' to '$DATADIR'\n",
504 "\n",
378 "This can take a long time if you run this\n", 505 "This can take a long time if you run this\n",
379 "for the first time or do not use --cache.\n", 506 "for the first time or do not use --cache.\n",
380 "\n", 507 "\n",
381 "Unless you run verbosely, all following warning\n", 508 "Unless you run verbosely, all following warning\n",
382 "or error messages indicate serious problems.\n", 509 "or error messages indicate serious problems.\n",
… …
393 $_->join for ( 520 $_->join for (
394 # four png crunchers work fine for my 2x smp machine 521 # four png crunchers work fine for my 2x smp machine
395 (async \&process_png), (async \&process_png), (async \&process_png), (async \&process_png), 522 (async \&process_png), (async \&process_png), (async \&process_png), (async \&process_png),
396 (async \&process_trs), (async \&process_trs), 523 (async \&process_trs), (async \&process_trs),
397 (async \&process_arc), (async \&process_arc), 524 (async \&process_arc), (async \&process_arc),
525 (async \&process_res), (async \&process_res),
398 ); 526 );
399 527
400 { 528 {
401 # remove path prefix from editor_folder 529 # remove path prefix from editor_folder
402 substr $_->{editor_folder}, 0, 1 + length $path, "" 530 substr $_->{editor_folder}, 0, 1 + length $path, ""
… …
412 if (my $s = $ARC{$other}) { 540 if (my $s = $ARC{$other}) {
413 if ($s->{inherit}) { 541 if ($s->{inherit}) {
414 $loop = $s; 542 $loop = $s;
415 } else { 543 } else {
416 delete $o->{inherit}; 544 delete $o->{inherit};
545 my %s = %$s;
546 delete @s{qw(_name more name name_pl)};
417 %$o = ( %$s, %$o ); 547 %$o = ( %s, %$o );
418 ++$progress; 548 ++$progress;
419 } 549 }
420 } else { 550 } else {
421 warn "'$o->{_name}' tries to inherit from undefined archetype '$other', skipping.\n"; 551 warn "'$o->{_name}' tries to inherit from undefined archetype '$other', skipping.\n";
422 delete $ARC{$o->{_name}}; 552 delete $ARC{$o->{_name}};
… …
430 560
431 last; 561 last;
432 } 562 }
433 } 563 }
434 564
565 # remove base classes (by naming scheme, should use something like "baseclass xxx" to inherit
566 @ARC = grep $_->{_name} !~ /^(?:type|class)_/, @ARC;
567
435 open my $fh, ">:utf8", "$DATADIR/archetypes~" 568 open my $fh, ">:utf8", "$DATADIR/archetypes~"
436 or die "$DATADIR/archetypes~: $!"; 569 or die "$DATADIR/archetypes~: $!";
437 print $fh Crossfire::archlist_to_string [sort { $a->{_name} cmp $b->{_name} } values %ARC]; 570 print $fh Crossfire::archlist_to_string [sort { $a->{_name} cmp $b->{_name} } @ARC];
438 } 571 }
439 572
440 { 573 {
441 open my $fh, ">:utf8", "$DATADIR/treasures~" 574 open my $fh, ">:utf8", "$DATADIR/treasures~"
442 or die "$DATADIR/treasures~: $!"; 575 or die "$DATADIR/treasures~: $!";
… …
451 length $v->{data32} <= 10000 or warn "$k: face32 larger than 10000 bytes, will not work with crossfire client.\n"; 584 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"; 585 #length $v->{data64} <= 10000 or warn "$k: face64 larger than 10000 bytes.\n";
453 586
454 $v->{chksum32} = Digest::MD5::md5 $v->{data32}; 587 $v->{chksum32} = Digest::MD5::md5 $v->{data32};
455 $v->{chksum64} = Digest::MD5::md5 $v->{data64}; 588 $v->{chksum64} = Digest::MD5::md5 $v->{data64};
589
590 if (my $magicmap = $v->{magicmap}) {
591 $magicmap =~ y/A-Z_\-/a-z/d;
592 $v->{magicmap} = $COLOR{$magicmap};
593 }
456 } 594 }
457 595
458 open my $fh, ">:perlio", "$DATADIR/facedata~" 596 open my $fh, ">:perlio", "$DATADIR/facedata~"
459 or die "$DATADIR/facedata~: $!"; 597 or die "$DATADIR/facedata~: $!";
460 598
461 print $fh freeze { 599 print $fh freeze {
462 version => 2, 600 version => 2,
463 faceinfo => \%FACEINFO, 601 faceinfo => \%FACEINFO,
464 animinfo => \%ANIMINFO, 602 animinfo => \%ANIMINFO,
603 resource => \%RESOURCE,
465 }; 604 };
466 } 605 }
467 606
468 for (qw(archetypes facedata treasures)) { 607 for (qw(archetypes facedata treasures)) {
469 chmod 0644, "$DATADIR/$_~"; 608 chmod 0644, "$DATADIR/$_~";

Diff Legend

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