--- deliantra/server/utils/cfutil.in 2008/01/15 12:02:24 1.69 +++ deliantra/server/utils/cfutil.in 2009/11/15 18:04:00 1.79 @@ -1,5 +1,27 @@ #!@PERL@ +# +# This file is part of Deliantra, the Roguelike Realtime MMORPG. +# +# Copyright (©) 2007,2008,2009 Marc Alexander Lehmann / Robin Redeker / the Deliantra team +# +# Deliantra is free software: you can redistribute it and/or modify it under +# the terms of the Affero GNU General Public License as published by the +# Free Software Foundation, either version 3 of the License, or (at your +# option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the Affero GNU General Public License +# and the GNU General Public License along with this program. If not, see +# . +# +# The authors can be reached via e-mail to +# + use strict; my $prefix = "@prefix@"; @@ -14,21 +36,25 @@ my $PNGNQ = "@PNGNQ@"; use Getopt::Long; +use File::Temp; +use POSIX (); +use Carp; + use Coro::EV; use AnyEvent; -use YAML (); +use YAML::XS (); use JSON::XS (); use IO::AIO (); -use File::Temp; -use Deliantra; -use Coro; +use Digest::MD5 (); + +use Coro 5.12; use Coro::AIO; use Coro::Util; -use POSIX (); -use Carp; use Coro::Channel; use Coro::Storable; $Storable::canonical = 1; +use Deliantra; + $SIG{QUIT} = sub { Carp::cluck "QUIT" }; sub usage { @@ -72,6 +98,28 @@ my $s_INT = EV::signal INT => sub { exit 1 }; my $s_TERM = EV::signal TERM => sub { exit 1 }; +our %hash; + +# here we could try to avoid collisions and reduce chksum size further +sub make_hash($\$\$;$) { + my ($id, $dataref, $hashref, $clen) = @_; + + my $hash = substr +(Digest::MD5::md5 $$dataref), 0, $clen || 4; + + if (exists $hash{$hash}) { + # hahs collinion, but some files are simply identical + if (${$hash{$hash}[1]} ne $$dataref) { + warn "hash collision $hash{$hash}[0] vs. $id\n"; + exit 1; + } else { + print "$hash{$hash}[0] and $id are identical (which is fine).\n" if $VERBOSE >= 3; + } + } + $hash{$hash} = [$id, $dataref, $hashref]; + + $$hashref = $hash; +} + mkdir $TMPDIR, 0700 or die "$TMPDIR: $!"; @@ -275,7 +323,8 @@ system $OPTIPNG, "-i0", "-q", "$other~"; # reduce smoothfaces >10000 bytes - if ($stem =~ /_S\./ && (-s "$other~") > 10000) { + # obsolete, no longer required + if (0 && $stem =~ /_S\./ && (-s "$other~") > 10000) { my $ncolor = 256; while () { system "<\Q$other~\E $PNGNQ -s1 -n$ncolor >\Q$other~~\E"; @@ -381,7 +430,7 @@ $ARC{$m->{_name}} = $m; } - $o->{editor_folder} = $dir; + $o->{editor_folder} ||= "\x00$dir"; # horrible kludge my $visibility = delete $o->{visibility}; my $magicmap = delete $o->{magicmap}; @@ -535,7 +584,7 @@ if (my $filter = $meta->{cfutil_filter}) { if ($filter eq "yaml2json") { - $data = JSON::XS::encode_json YAML::Load $data; + $data = JSON::XS::encode_json YAML::XS::Load $data; } elsif ($filter eq "json2json") { $data = JSON::XS::encode_json JSON::XS->relaxed->utf8->decode ($data); } elsif ($filter eq "perl2json") { @@ -602,6 +651,31 @@ }; } + sub generate_plurals { +# use Lingua::EN::Inflect (); +# Lingua::EN::Inflect::classical; +# Lingua::EN::Inflect::def_noun '(.*)staff' => '$1staves'; # policy +# Lingua::EN::Inflect::def_noun '(.*)boots' => '$1boots'; # hack +# +# for my $a (@ARC) { +# my $name = $a->{name} || $a->{_name}; +# +# next unless $a->{name_pl}; +# next if $a->{invisible}; +# next if $a->{is_floor}; +# next if $a->{no_pick}; +# +# my $test = Lingua::EN::Inflect::PL_N_eq $name, Lingua::EN::Inflect::PL $name; +# my $pl = $test =~ /^(?:eq|p:.)$/ +# ? $name +# : Lingua::EN::Inflect::PL $name; +# +# if ($pl ne $a->{name_pl}) { +# warn "$a->{_name}: plural differs, $pl vs $a->{name_pl}\n"; +# } +# } + } + sub inst_arch($) { my (undef, $path) = @_; @@ -632,9 +706,9 @@ IO::AIO::flush; - $c_res->put (undef) for @a_res; - $c_arc->put (undef) for @a_arc; - $c_trs->put (undef) for @a_trs; + $c_res->shutdown; + $c_arc->shutdown; + $c_trs->shutdown; print "start file scan, arc, res processing...\n" if $VERBOSE; @@ -650,8 +724,9 @@ print "scanning done, processing results...\n" if $VERBOSE; { # remove path prefix from editor_folder - substr $_->{editor_folder}, 0, 1 + length $path, "" - for values %ARC; + $_->{editor_folder} =~ /^\x00/ + and substr $_->{editor_folder}, 0, 2 + length $path, "" + for values %ARC; print "resolving inheritance tree...\n" if $VERBOSE; # resolve inherit @@ -689,14 +764,17 @@ # remove base classes (by naming scheme, should use something like "baseclass xxx" to inherit @ARC = grep $_->{_name} !~ /^(?:type|class)_/, @ARC; - print "writing archetypes...\n" if $VERBOSE; + print "generating plurals...\n" if $VERBOSE; + generate_plurals; + + printf "writing %d archetypes...\n", scalar @ARC if $VERBOSE; open my $fh, ">:utf8", "$DATADIR/archetypes~" or die "$DATADIR/archetypes~: $!"; print $fh Deliantra::archlist_to_string [sort { $a->{_name} cmp $b->{_name} } @ARC]; } { - print "writing treasures...\n" if $VERBOSE; + printf "writing treasures (%d octets)...\n", length $TRS if $VERBOSE; open my $fh, ">:utf8", "$DATADIR/treasures~" or die "$DATADIR/treasures~: $!"; print $fh $TRS; @@ -708,7 +786,10 @@ length $v->{data32} or warn "$k: face has no png32. this will not work (shoddy gcfclient will crash of course).\n"; length $v->{data64} or warn "$k: face has no png64. this will not work very well.\n"; - length $v->{data32} <= 10000 or warn "$k: face32 larger than 10000 bytes, will not work with crossfire client.\n"; + make_hash $k, $v->{data32}, $v->{hash32}; + make_hash $k, $v->{data64}, $v->{hash64}; + + #length $v->{data32} <= 10000 or warn "$k: face32 larger than 10000 bytes, will not work with crossfire client.\n"; #length $v->{data64} <= 10000 or warn "$k: face64 larger than 10000 bytes.\n"; if (my $magicmap = $v->{magicmap}) { @@ -719,7 +800,30 @@ delete $v->{arc}; } - print "writing facedata...\n" if $VERBOSE; + print "processing resources...\n" if $VERBOSE; + my $enc = JSON::XS->new->utf8->canonical->relaxed; + while (my ($k, $v) = each %RESOURCE) { + + if ($v->{type} & 1) { + # prepend meta info + + my $meta = $enc->encode ({ + name => $k, + %{ $v->{meta} || {} }, + }); + + $v->{data} = pack "(w/a*)*", $meta, $v->{data}; + } + + make_hash $k, $v->{data}, $v->{hash}, 6; # 6 for the benefit of existing clients + } + + printf "writing facedata (%d faces, %d anims, %d resources)...\n", + scalar keys %FACEINFO, + scalar keys %ANIMINFO, + scalar keys %RESOURCE + if $VERBOSE; + open my $fh, ">:perlio", "$DATADIR/facedata~" or die "$DATADIR/facedata~: $!"; @@ -729,6 +833,7 @@ animinfo => \%ANIMINFO, resource => \%RESOURCE, }; + } print "committing files...\n" if $VERBOSE;