[ViewVC] Diff of: cvs/deliantra/server/utils/cfutil.in

Comparing deliantra/server/utils/cfutil.in (file contents):
Revision 1.24 by root, Thu Apr 12 14:18:06 2007 UTC vs.
Revision 1.73 by root, Mon Oct 26 11:31:39 2009 UTC

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

Diff Legend

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

Comparing deliantra/server/utils/cfutil.in (file contents): Revision 1.24 by root, Thu Apr 12 14:18:06 2007 UTC vs. Revision 1.73 by root, Mon Oct 26 11:31:39 2009 UTC

Diff Legend

Comparing deliantra/server/utils/cfutil.in (file contents):
Revision 1.24 by root, Thu Apr 12 14:18:06 2007 UTC vs.
Revision 1.73 by root, Mon Oct 26 11:31:39 2009 UTC