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.115 by root, Sat May 14 17:41:57 2011 UTC vs.
Revision 1.116 by root, Sun May 15 20:14:30 2011 UTC

… …
107 khaki => 12, 107 khaki => 12,
108); 108);
109 109
110END { system "rm", "-rf", $TMPDIR } 110END { system "rm", "-rf", $TMPDIR }
111 111
112my $s_INT = EV::signal INT => sub { exit 1 }; 112my $s_INT = AE::signal INT => sub { exit 1 };
113my $s_TERM = EV::signal TERM => sub { exit 1 }; 113my $s_TERM = AE::signal TERM => sub { exit 1 };
114 114
115our %hash; 115our %hash;
116 116
117# here we could try to avoid collisions and reduce chksum size further 117# here we could try to avoid collisions and reduce chksum size further
118sub make_hash($\$\$;$) { 118sub make_hash($\$\$;$) {
… …
121 my $hash = substr +(Digest::MD5::md5 $$dataref), 0, $clen || 5; 121 my $hash = substr +(Digest::MD5::md5 $$dataref), 0, $clen || 5;
122 122
123 if (exists $hash{$hash}) { 123 if (exists $hash{$hash}) {
124 # hash collision, but some files are simply identical 124 # hash collision, but some files are simply identical
125 if (${$hash{$hash}[1]} ne $$dataref) { 125 if (${$hash{$hash}[1]} ne $$dataref) {
126 warn "hash collision $hash{$hash}[0] vs. $id (increase the default \$clen in make_hash?)\n"; 126 warn "ERROR: hash collision $hash{$hash}[0] vs. $id (increase the default \$clen in make_hash?)\n";
127 exit 1; 127 exit 1;
128 } else { 128 } else {
129 print "$hash{$hash}[0] and $id are identical (which is fine).\n" if $VERBOSE >= 3; 129 print "$hash{$hash}[0] and $id are identical (which is fine).\n" if $VERBOSE >= 3;
130 } 130 }
131 } 131 }
… …
190 my (undef, $path) = @_; 190 my (undef, $path) = @_;
191 191
192 print "\nInstalling '$path' to '$DATADIR/maps'\n\n"; 192 print "\nInstalling '$path' to '$DATADIR/maps'\n\n";
193 193
194 if (!-f "$path/regions") { 194 if (!-f "$path/regions") {
195 warn "'$path' does not look like a maps directory ('regions' file is missing).\n"; 195 warn "ERROR: '$path' does not look like a maps directory ('regions' file is missing).\n";
196 exit 1 unless $FORCE; 196 exit 1 unless $FORCE;
197 } 197 }
198 198
199 system $RSYNC, "-av", "--chmod=u=rwX,go=rX", 199 system $RSYNC, "-av", "--chmod=u=rwX,go=rX",
200 "$path/.", "$DATADIR/maps/.", 200 "$path/.", "$DATADIR/maps/.",
… …
210 our %FACEINFO; 210 our %FACEINFO;
211 our %RESOURCE; 211 our %RESOURCE;
212 our @ARC; 212 our @ARC;
213 our %ARC; 213 our %ARC;
214 our $TRS; 214 our $TRS;
215 our %PNG;
215 our $NFILE; 216 our $NFILE;
216 our $PATH; 217 our $PATH;
217 218
218 our $QUANTIZE = "+dither -colorspace RGB -colors 256"; 219 our $QUANTIZE = "+dither -colorspace RGB -colors 256";
219 220
… …
236 my $png; 237 my $png;
237 aio_lstat $path; 238 aio_lstat $path;
238 my ($size, $mtime) = (stat _)[7,9]; 239 my ($size, $mtime) = (stat _)[7,9];
239 240
240 if (0 > aio_load $path, $png) { 241 if (0 > aio_load $path, $png) {
241 warn "$path: $!, skipping.\n"; 242 warn "ERROR: $path: $!, skipping.\n";
242 next; 243 next;
243 } 244 }
244 245
245 my $stem = $path; 246 my $stem = $path;
246 my $T; 247 my $T;
… …
248 if ($stem =~ s/\.32x32\.png~?$//) { 249 if ($stem =~ s/\.32x32\.png~?$//) {
249 $T = 32; 250 $T = 32;
250 } elsif ($stem =~ s/\.64x64\.png~?$//) { 251 } elsif ($stem =~ s/\.64x64\.png~?$//) {
251 $T = 64; 252 $T = 64;
252 } else { 253 } else {
253 warn "$path: weird filename, skipping.\n"; 254 warn "ERROR: $path: weird filename, skipping.\n";
254 next; 255 next;
255 } 256 }
256 257
257 # quickly extract width and height of the (necessarily PNG) image 258 # quickly extract width and height of the (necessarily PNG) image
258 unless ($png =~ /^\x89PNG\x0d\x0a\x1a\x0a....IHDR(........)/s) { 259 unless ($png =~ /^\x89PNG\x0d\x0a\x1a\x0a....IHDR(........)/s) {
259 warn "$path: not a recognized png file, skipping.\n"; 260 warn "ERROR: $path: not a recognized png file, skipping.\n";
260 next; 261 next;
261 } 262 }
262 263
263 my ($w, $h) = unpack "NN", $1; 264 my ($w, $h) = unpack "NN", $1;
264 265
265 if ($w < $T || $h < $T) { 266 if ($w < $T || $h < $T) {
266 warn "$path: too small ($w $h), skipping.\n"; 267 warn "ERROR: $path: too small ($w $h), skipping.\n";
267 next; 268 next;
268 } 269 }
269 270
270 if ($w % $T || $h % $T) { 271 if ($w % $T || $h % $T) {
271 warn "$path: weird png size ($w $h), skipping.\n"; 272 warn "ERROR: $path: weird png size ($w $h), skipping.\n";
272 next; 273 next;
273 } 274 }
274 275
275 (my $base = $stem) =~ s/^.*\///; 276 (my $base = $stem) =~ s/^.*\///;
276 277
… …
397 } 398 }
398 } 399 }
399 400
400 (my $face = $stem) =~ s/^.*\///; 401 (my $face = $stem) =~ s/^.*\///;
401 402
403 for (@{ $fi->{derive} }) {
404 my ($dir, $type) = @$_;
405
406 my $geom = "${T}x${T}";
407 my $dpath = "$dir/$type:$face.$geom.png~";
408
409 if ($type eq "buildmaterial") {
410 my $ov = "$PATH/mapbuilding/buildmaterial.png";
411 make_file [$path, $ov], $dpath, sub {
412 fork_exec {
413 system "$CONVERT -size 64x64 xc:transparent \\( \Q$path\E -geometry 52x52+6+6 \\) -composite \Q$ov\E -composite -geometry $geom png:\Q$dpath\E~";
414 optipng "$dpath~";
415 rename "$dpath~", $dpath;
416 };
417 };
418 } elsif ($type eq "buildmaterial-box") {
419 my $ov = "$PATH/mapbuilding/buildmaterial-box.png";
420 make_file [$path, $ov], $dpath, sub {
421 fork_exec {
422 system "$CONVERT \Q$ov\E "
423 . "\\( \Q$path\E -trim -geometry 34x31\\> "
424 . "-gravity center -background transparent -extent 37x34 +gravity "
425 . "-geometry +22+6 \\) -composite "
426 . "-geometry $geom png:\Q$dpath\E~";
427 optipng "$dpath~";
428 rename "$dpath~", $dpath;
429 };
430 };
431 } elsif ($type eq "buildmaterial-sbox") {
432 my $ov = "$PATH/mapbuilding/buildmaterial-sbox.png";
433 make_file [$path, $ov], $dpath, sub {
434 fork_exec {
435 system "$CONVERT \Q$ov\E "
436 . "\\( \Q$path\E -trim -geometry 16x24\\> "
437 . "-gravity center -background transparent -extent 18x26 +gravity "
438 . "-geometry +26+16 \\) -composite "
439 . "-geometry $geom png:\Q$dpath\E~";
440 optipng "$dpath~";
441 rename "$dpath~", $dpath;
442 };
443 };
444 } else {
445 warn "ERROR: facename $type:$face contains unsupported derivation type.\n";
446 }
447
448 aio_load $dpath, my $png;
449 IO::AIO::aio_unlink $dpath unless $CACHE;
450 commit_png "$dir/$type:$face", "$type:$face", $png, $T;
451 }
452
402 # split all bigfaces, but avoid smoothfaces (*_S) 453 # split all bigfaces, but avoid smoothfaces (*_S)
403 if (($w > $T || $h > $T) && $face !~ /_S\./) { 454 if (($w > $T || $h > $T) && $face !~ /_S\./) {
404 # split 455 # split
405 my @tile; 456 my @tile;
406 for my $x (0 .. (int $w / $T) - 1) { 457 for my $x (0 .. (int $w / $T) - 1) {
… …
410 push @tile, [$x, $y, $file, (stat _)[9]]; 461 push @tile, [$x, $y, $file, (stat _)[9]];
411 } 462 }
412 } 463 }
413 464
414 my $mtime = (lstat $path)[9]; 465 my $mtime = (lstat $path)[9];
415 my @todo = grep { $_->[3] <= $mtime } @tile; 466 my @todo = grep { $_->[3] < $mtime } @tile;
416 if (@todo) { 467 if (@todo) {
417 fork_exec { 468 fork_exec {
418 open my $convert, "|-", $CONVERT, 469 open my $convert, "|-", $CONVERT,
419 "png:-", 470 "png:-",
420 (map { 471 (map {
… …
456 } else { 507 } else {
457 # use as-is (either small, use smooth) 508 # use as-is (either small, use smooth)
458 commit_png $stem, $face, $png, $T; 509 commit_png $stem, $face, $png, $T;
459 } 510 }
460 511
461 aio_unlink $path if $delete; 512 IO::AIO::aio_unlink $path if $delete;
462 } 513 }
463 } 514 }
464 515
465 sub process_faceinfo { 516 sub process_faceinfo {
466 my ($dir, $file) = @_; 517 my ($dir, $file) = @_;
467 my $path = "$dir/$file"; 518 my $path = "$dir/$file";
468 519
469 my $data; 520 my $data;
470 if (0 > aio_load $path, $data) { 521 if (0 > aio_load $path, $data) {
471 warn "$path: $!, skipping.\n"; 522 warn "ERROR: $path: $!, skipping.\n";
472 return; 523 return;
473 } 524 }
474 525
475 for (split /\n/, $data) { 526 for (split /\n/, $data) {
476 chomp; 527 chomp;
… …
482 $glyph =~ s/^"(.+)"$/$1/; # allow for ""-style quoting 533 $glyph =~ s/^"(.+)"$/$1/; # allow for ""-style quoting
483 534
484 $fg = "white" if $fg eq "none"; # lots of faces have no fg colour yet 535 $fg = "white" if $fg eq "none"; # lots of faces have no fg colour yet
485 536
486 (my $fgi = $COLOR{$fg}) 537 (my $fgi = $COLOR{$fg})
487 // warn "WARNING: $path: $face specifies unknown foreground colour '$fg'.\n"; 538 // warn "ERROR: $path: $face specifies unknown foreground colour '$fg'.\n";
488 (my $bgi = $COLOR{$bg}) 539 (my $bgi = $COLOR{$bg})
489 // warn "WARNING: $path: $face specifies unknown background colour '$bg'.\n"; 540 // warn "ERROR: $path: $face specifies unknown background colour '$bg'.\n";
490 541
491 my $fi = $FACEINFO{$face} ||= { }; 542 my $fi = $FACEINFO{$face} ||= { };
492 $fi->{visibility} = $visibility * 1; 543 $fi->{visibility} = $visibility * 1;
493 $fi->{magicmap} = $fgi; # foreground colour becomes magicmap 544 $fi->{magicmap} = $fgi; # foreground colour becomes magicmap
494 545
… …
563 next if /^facings\s/; 614 next if /^facings\s/;
564 615
565 my $face = $_; 616 my $face = $_;
566 $face =~ s/\+\d+\+\d+$//; # remove tile offset coordinates 617 $face =~ s/\+\d+\+\d+$//; # remove tile offset coordinates
567 618
568 my $info = $FACEINFO{$face} ||= { }; 619 # handle derived faces
620 if ($face =~ /^([^:]+):(.*)/) {
621 my ($type, $base) = ($1, $2);
622 push @{ $FACEINFO{$base}{derive} }, [$dir, $type];
623 }
624
569 $info->{arc} = $o; 625 $FACEINFO{$face}{arc} = $o;
570 626
571 next if $face =~ /^blank.x11$|^empty.x11$/; 627 next if $face =~ /^blank.x11$|^empty.x11$/;
572 } 628 }
573 629
574 if (my $smooth = delete $o->{smoothface}) { 630 if (my $smooth = delete $o->{smoothface}) {
… …
590 my ($dir, $file) = @_; 646 my ($dir, $file) = @_;
591 my $path = "$dir/$file"; 647 my $path = "$dir/$file";
592 648
593 my $trs; 649 my $trs;
594 if (0 > aio_load $path, $trs) { 650 if (0 > aio_load $path, $trs) {
595 warn "$path: $!, skipping.\n"; 651 warn "ERROR: $path: $!, skipping.\n";
596 return; 652 return;
597 } 653 }
598 654
599 $TRS .= $trs; 655 $TRS .= $trs;
600 } 656 }
… …
605 unless (exists $FILECACHE{$_[0]}) { 661 unless (exists $FILECACHE{$_[0]}) {
606 my $data; 662 my $data;
607 if (0 < aio_load $_[0], $data) { 663 if (0 < aio_load $_[0], $data) {
608 if ($_[1]) { 664 if ($_[1]) {
609 $data = eval { $_[1]->($data) }; 665 $data = eval { $_[1]->($data) };
610 warn "$_[0]: $@" if $@; 666 warn "ERROR: $_[0]: $@" if $@;
611 } 667 }
612 } 668 }
613 669
614 $FILECACHE{$_[0]} = $data; 670 $FILECACHE{$_[0]} = $data;
615 } 671 }
… …
714 "cc/by/2.0" => "Licensed under Creative Commons Attribution 2.0 http://creativecommons.org/licenses/by/2.0/", 770 "cc/by/2.0" => "Licensed under Creative Commons Attribution 2.0 http://creativecommons.org/licenses/by/2.0/",
715 "cc/by/2.1" => "Licensed under Creative Commons Attribution 2.1 http://creativecommons.org/licenses/by/2.1/", 771 "cc/by/2.1" => "Licensed under Creative Commons Attribution 2.1 http://creativecommons.org/licenses/by/2.1/",
716 "cc/by/2.5" => "Licensed under Creative Commons Attribution 2.5 http://creativecommons.org/licenses/by/2.5/", 772 "cc/by/2.5" => "Licensed under Creative Commons Attribution 2.5 http://creativecommons.org/licenses/by/2.5/",
717 "cc/by/3.0" => "Licensed under Creative Commons Attribution 3.0 http://creativecommons.org/licenses/by/3.0/", 773 "cc/by/3.0" => "Licensed under Creative Commons Attribution 3.0 http://creativecommons.org/licenses/by/3.0/",
718 })->{$meta->{license}} 774 })->{$meta->{license}}
719 || warn "$dir/$file: license tag '$meta->{license}' not found."; 775 || warn "ERROR: $dir/$file: license tag '$meta->{license}' not found.";
720 } 776 }
721 777
722 if (!exists $meta->{author} && $meta->{source} =~ m%^http://www.jamendo.com/en/artist/(.*)$%) { 778 if (!exists $meta->{author} && $meta->{source} =~ m%^http://www.jamendo.com/en/artist/(.*)$%) {
723 ($meta->{author} = $1) =~ s/_/ /g; 779 ($meta->{author} = $1) =~ s/_/ /g;
724 } 780 }
… …
735 $data = JSON::XS::encode_json JSON::XS->relaxed->utf8->decode ($data); 791 $data = JSON::XS::encode_json JSON::XS->relaxed->utf8->decode ($data);
736 } elsif ($filter eq "perl2json") { 792 } elsif ($filter eq "perl2json") {
737 $data = eval $data; die if $@; 793 $data = eval $data; die if $@;
738 $data = JSON::XS::encode_json $data; 794 $data = JSON::XS::encode_json $data;
739 } else { 795 } else {
740 warn "$dir/$file: unknown filter $filter, skipping\n"; 796 warn "ERROR: $dir/$file: unknown filter $filter, skipping\n";
741 } 797 }
742 } 798 }
743 799
744 substr $dir, 0, 1 + length $PATH, ""; 800 substr $dir, 0, 1 + length $PATH, "";
745 801
… …
792 } else { 848 } else {
793 $c_any->put ([\&process_res, $path, $file, undef]); 849 $c_any->put ([\&process_res, $path, $file, undef]);
794 } 850 }
795 851
796 } elsif ($file =~ /\.png$/) { 852 } elsif ($file =~ /\.png$/) {
797 push @c_png, ["$path/$file", 0]; 853 $PNG{$file} = $path;
798 854
799 } elsif ($file =~ /\.faceinfo$/) { 855 } elsif ($file =~ /\.faceinfo$/) {
800 $c_any->put ([\&process_faceinfo, $path, $file]); 856 $c_any->put ([\&process_faceinfo, $path, $file]);
801 857
802 } elsif ($file =~ /\.trs$/) { 858 } elsif ($file =~ /\.trs$/) {
… …
855 "Unless you run verbosely, all following warning\n", 911 "Unless you run verbosely, all following warning\n",
856 "or error messages indicate serious problems.\n", 912 "or error messages indicate serious problems.\n",
857 "\n"; 913 "\n";
858 914
859 if (!-d "$path/treasures") { 915 if (!-d "$path/treasures") {
860 warn "'$path' does not look like an arch directory ('treasures' directory is missing).\n"; 916 warn "FATAL: '$path' does not look like an arch directory ('treasures' directory is missing).\n";
861 exit 1 unless $FORCE; 917 exit 1 unless $FORCE;
862 } 918 }
863 919
864 print "starting file scan, arc, any processing...\n" if $VERBOSE; 920 print "starting file scan, arc, any processing...\n" if $VERBOSE;
865 921
… …
871 $c_arc->shutdown; 927 $c_arc->shutdown;
872 $c_any->shutdown; 928 $c_any->shutdown;
873 929
874 $_->join for @a_arc; # need to parse all archetypes before png processing 930 $_->join for @a_arc; # need to parse all archetypes before png processing
875 print "ended arc processing...\n" if $VERBOSE; 931 print "ended arc processing...\n" if $VERBOSE;
932
933 # fill png queue
934 for (keys %FACEINFO) {
935 # we only expect source pngs to exist for non-derived
936 # faces, i.e. no split tiles (+x+x) and no face derivates
937 # (xxx:)
938 /^[^:]+\....$/
939 or next;
940
941 my $seen;
942
943 if (exists $PNG{"$_.32x32.png"}) {
944 push @c_png, ["$PNG{\"$_.32x32.png\"}/$_.32x32.png"];
945 $seen = 1;
946 }
947 if (exists $PNG{"$_.64x64.png"}) {
948 push @c_png, ["$PNG{\"$_.64x64.png\"}/$_.64x64.png"];
949 $seen = 1;
950 }
951
952 warn "ERROR: $_: face not found, expect problems.\n"
953 unless $seen;
954 }
876 955
877 print "starting png processing...\n" if $VERBOSE; 956 print "starting png processing...\n" if $VERBOSE;
878 957
879 # eight png crunchers work fine for my 4x smp machine 958 # eight png crunchers work fine for my 4x smp machine
880 my @a_png = map +(async \&process_png), 1..8; 959 my @a_png = map +(async \&process_png), 1..8;
… …
909 delete @s{qw(_name more name name_pl)}; 988 delete @s{qw(_name more name name_pl)};
910 %$o = ( %s, %$o ); 989 %$o = ( %s, %$o );
911 ++$progress; 990 ++$progress;
912 } 991 }
913 } else { 992 } else {
914 warn "WARNING: archetype '$o->{_name}' tries to inherit from undefined archetype '$other', skipping.\n"; 993 warn "ERROR: archetype '$o->{_name}' tries to inherit from undefined archetype '$other', skipping.\n";
915 delete $ARC{$o->{_name}}; 994 delete $ARC{$o->{_name}};
916 } 995 }
917 } 996 }
918 } 997 }
919 998
… …
956 } 1035 }
957 1036
958 { 1037 {
959 print "processing facedata...\n" if $VERBOSE; 1038 print "processing facedata...\n" if $VERBOSE;
960 while (my ($k, $v) = each %FACEINFO) { 1039 while (my ($k, $v) = each %FACEINFO) {
961 length $v->{data32} or warn "WARNING: face '$k' has no png32. this will not work (shoddy gcfclient will crash of course).\n"; 1040 length $v->{data32} or warn "ERROR: face '$k' has no png32 - this will not work.\n";
962 length $v->{data64} or warn "WARNING: face '$k' has no png64. this will not work very well.\n"; 1041 length $v->{data64} or warn "ERROR: face '$k' has no png64 - this will not work.\n";
963 1042
964 make_hash $k, $v->{data32}, $v->{hash32}; 1043 make_hash $k, $v->{data32}, $v->{hash32};
965 make_hash $k, $v->{data64}, $v->{hash64}; 1044 make_hash $k, $v->{data64}, $v->{hash64};
966 1045
967 #length $v->{data32} <= 10000 or warn "WARNING: face '$k' has face32 larger than 10000 bytes, will not work with crossfire client.\n"; 1046 #length $v->{data32} <= 10000 or warn "WARNING: face '$k' has face32 larger than 10000 bytes, will not work with crossfire client.\n";
968 #length $v->{data64} <= 10000 or warn "WARNING: face '$k' has face64 larger than 10000 bytes.\n"; 1047 #length $v->{data64} <= 10000 or warn "WARNING: face '$k' has face64 larger than 10000 bytes.\n";
969 1048
970 $v->{glyph} // warn "WARNING: face '$k' has glyph."; 1049 $v->{glyph} // warn "ERROR: face '$k' has no glyph - missing faceinfo entry?\n";
971 $v->{visibility} // warn "WARNING: face '$k' has no visibility info, missing faceinfo entry?\n"; 1050 $v->{visibility} // warn "ERROR: face '$k' has no visibility info - missing faceinfo entry?\n";
972 $v->{magicmap} // warn "WARNING: face '$k' has foreground colour."; 1051 $v->{magicmap} // warn "ERROR: face '$k' has no foreground colour - missing faceinfo entry?\n";
973 1052
974 delete @$v{qw(arc stem)}; # not used by the server 1053 delete @$v{qw(arc stem derive)}; # not used by the server
975 } 1054 }
976 1055
977 print "processing resources...\n" if $VERBOSE; 1056 print "processing resources...\n" if $VERBOSE;
978 my $enc = JSON::XS->new->utf8->canonical->relaxed; 1057 my $enc = JSON::XS->new->utf8->canonical->relaxed;
979 while (my ($k, $v) = each %RESOURCE) { 1058 while (my ($k, $v) = each %RESOURCE) {

Diff Legend

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