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

Comparing deliantra/server/utils/cfutil.in (file contents):
Revision 1.2 by root, Wed Mar 7 01:23:37 2007 UTC vs.
Revision 1.20 by root, Mon Apr 2 18:04:47 2007 UTC

…		…
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 $RSYNC = "@RSYNC@";	13	my $RSYNC = "@RSYNC@";
13		14
14	use Getopt::Long;	15	use Getopt::Long;
		16	use Coro::Event;
		17	use AnyEvent;
15	use IO::AIO;	18	use IO::AIO ();
16	use File::Temp;	19	use File::Temp;
17	use Crossfire;	20	use Crossfire;
		21	use Coro;
		22	use Coro::AIO;
		23	use POSIX ();
		24	use Digest::MD5;
		25	use Storable; $Storable::canonical = 1;
18		26
19	sub usage {	27	sub usage {
20	warn <<EOF;	28	warn <<EOF;
21	Usage: cfutil [-v] [-q] [--force]	29	Usage: cfutil [-v] [-q] [--force] [--cache]
22	[--install-arch path]	30	[--install-arch path]
23	[--install-maps maps]	31	[--install-maps maps]
24	[--print-statedir]	32	[--print-statedir]
25	[--print-confdir]	33	[--print-confdir]
26	[--print-datadir]	34	[--print-datadir]
…		…
29	EOF	37	EOF
30	exit 1;	38	exit 1;
31	}	39	}
32		40
33	my $VERBOSE = 1;	41	my $VERBOSE = 1;
		42	my $CACHE = 0;
34	my $FORCE;	43	my $FORCE;
35	my $TMPDIR = "/tmp/cfutil$$~";	44	my $TMPDIR = "/tmp/cfutil$$~";
		45	my $TMPFILE = "aaaa0";
36		46
37	END { system "rm", "-rf", $TMPDIR }	47	END { system "rm", "-rf", $TMPDIR }
		48
		49	Event->signal (signal => "INT", cb => sub { exit 1 });
		50	Event->signal (signal => "TERM", cb => sub { exit 1 });
38		51
39	mkdir $TMPDIR, 0700	52	mkdir $TMPDIR, 0700
40	or die "$TMPDIR: $!";	53	or die "$TMPDIR: $!";
41		54
		55	sub fork_sub(&) {
		56	my ($cb) = @_;
		57
		58	if (my $pid = fork) {
		59	my $current = $Coro::current;
		60	my $w = AnyEvent->child (pid => $pid, cb => sub { $current->ready });
		61	Coro::schedule;
		62	} else {
		63	eval { $cb->() };
		64	POSIX::_exit 0 unless $@;
		65	warn $@;
		66	POSIX::_exit 1;
		67	}
		68	}
		69
42	sub inst_maps($) {	70	sub inst_maps($) {
43	my (undef, $path) = @_;	71	my (undef, $path) = @_;
44		72
45	print "installing '$path' to '$DATADIR/maps'\n\n";	73	print "installing '$path' to '$DATADIR/maps'\n";
46		74
47	if (!-f "$path/regions") {	75	if (!-f "$path/regions") {
48	warn "'$path' does not look like a maps directory ('regions' file is missing).\n";	76	warn "'$path' does not look like a maps directory ('regions' file is missing).\n";
49	exit 1 unless $FORCE;	77	exit 1 unless $FORCE;
50	}	78	}
51		79
52	system $RSYNC, "-av", "$path/.", "$DATADIR/maps/.", "--delete", "--exclude", "CVS", "--delete-excluded";	80	system $RSYNC, "-av", "$path/.", "$DATADIR/maps/.", "--delete", "--exclude", "CVS", "--delete-excluded"
		81	and die "map installation failed.\n";
		82
		83	print "maps installed successfully.\n";
53	}	84	}
54		85
55	{	86	{
56	my @PNG;	87	our %FACEINFO;
57	my @ARC;	88	our @ARC;
		89	our $TRS;
		90	our $NFILE;
		91	our %ANIM;
58		92
		93	our $QUANTIZE = "+dither -colorspace RGB -colors 256";
		94
		95	our (@png, @trs, @arc); # files we are interested in
		96
59	sub commit_png {	97	sub commit_png($$$) {
60	my ($name, $data) = @_;	98	my ($name, $data, $T) = @_;
61	#warn "$name: commited\n";
62	}
63		99
64	sub add_png($) {	100	$FACEINFO{$name}{"data$T"} = $data;
		101	}
		102
		103	sub process_png {
		104	while (@png) {
		105	my ($path, $delete) = @{pop @png};
		106
		107	my $png;
		108	aio_lstat $path;
		109	my ($size, $mtime) = (stat _)[7,9];
		110
		111	if (0 > aio_load $path, $png) {
		112	warn "$path: $!, skipping.\n";
		113	next;
		114	}
		115
		116	my $stem = $path;
		117	my $T;
		118
		119	if ($stem =~ s/\.32x32\.png~?$//) {
		120	$T = 32;
		121	} elsif ($stem =~ s/\.64x64\.png~?$//) {
		122	$T = 64;
		123	} else {
		124	warn "$path: weird filename, skipping.\n";
		125	next;
		126	}
		127
		128	# quickly extract width and height of the (necessarily PNG) image
		129	unless ($png =~ /^\x89PNG\x0d\x0a\x1a\x0a....IHDR(........)/s) {
		130	warn "$path: not a recognized png file, skipping.\n";
		131	next;
		132	}
		133
		134	my ($w, $h) = unpack "NN", $1;
		135
		136	if ($w < $T \|\| $h < $T) {
		137	warn "$path: too small ($w $h), skipping.\n";
		138	next;
		139	}
		140
		141	if ($w % $T \|\| $h % $T) {
		142	warn "$path: weird png size ($w $h), skipping.\n";
		143	next;
		144	}
		145
		146	unless ($path =~ /~$/) {
		147	# possibly enlarge
		148	if (0 > aio_stat "$stem.64x64.png") {
		149	my $other = "$stem.64x64.png~";
		150
		151	if (0 > aio_lstat $other or (-M _) > (-M $path)) {
		152	warn "rescale $other\n";#d#
		153	my $wrap = 0; # for the time being
		154	fork_sub {
		155	system "convert png:\Q$path\E -depth 8 rgba:-"
		156	. "\| $exec_prefix/bin/cfhq2xa $w $h $wrap"
		157	. "\| convert -depth 8 -size ".($w * 2)."x".($h * 2)." rgba:- $QUANTIZE -quality 00 png32:\Q$other\E~"
		158	and die "convert/hq2xa pipeline error: status $? ($!)";
		159	system $OPTIPNG, "-o5", "-i0", "-q", "$other~";
		160	die "$other~ has zero size, aborting." unless -s "$other~";
		161	rename "$other~", $other;
		162	};
		163	}
		164
		165	push @png, [$other, !$CACHE];
		166	}
		167
		168	# possibly scale down
		169	if (0 > aio_stat "$stem.32x32.png") {
		170	my $other = "$stem.32x32.png~";
		171
		172	if (0 > aio_lstat $other or (-M _) > (-M $path)) {
		173	fork_sub {
		174	system "convert png:\Q$path\E -geometry 50% -filter lanczos $QUANTIZE -quality 00 png32:\Q$other\E~";
		175	system $OPTIPNG, "-o5", "-i0", "-q", "$other~";
		176	die "$other~ has zero size, aborting." unless -s "$other~";
		177	rename "$other~", $other;
		178	};
		179	}
		180
		181	warn "scaled down $path to $other\n";#d#
		182
		183	push @png, [$other, !$CACHE];
		184	}
		185	}
		186
		187	(my $face = $stem) =~ s/^.*\///;
		188
		189	if (($w > $T \|\| $h > $T) && $face !~ /_S\./) {
		190	# split
		191	my @tile;
		192	for my $x (0 .. (int $w / $T) - 1) {
		193	for my $y (0 .. (int $h / $T) - 1) {
		194	my $file = "$path+$x+$y~";
		195	aio_lstat $file;
		196	push @tile, [$x, $y, $file, (stat _)[9]];
		197	}
		198	}
		199
		200	my $mtime = (lstat $path)[9];
		201	my @todo = grep { $_->[3] <= $mtime } @tile;
		202	if (@todo) {
		203	fork_sub {
		204	open my $convert, "\|-", $CONVERT,
		205	"png:-",
		206	(map {
		207	(
		208	"(",
		209	"+clone",
		210	-crop => (sprintf "%dx%d+%d+%d", $T, $T, $_->[0] * $T, $_->[1] * $T),
		211	"+repage",
		212	-quality => "00",
		213	-write => "png32:$_->[2]~",
		214	"+delete",
		215	")",
		216	)
		217	} @todo),
		218	"null:";
		219
		220	binmode $convert;
		221	print $convert $png;
		222	close $convert;
		223
		224	# pass 2, optimise, and rename
		225	for (@todo) {
		226	system $OPTIPNG, "-o5", "-i0", "-q", "$_->[2]~";
		227	die "$_->[2]~ has zero size, aborting." unless -s "$_->[2]~";
		228	rename "$_->[2]~", $_->[2];
		229	}
		230	};
		231	}
		232
		233	for (@tile) {
		234	my ($x, $y, $file) = @$_;
		235	my $tile;
		236
		237	if (0 > aio_load $file, $tile) {
		238	die "$path: unable to read tile +$x+$y, aborting.\n";
		239	}
		240	IO::AIO::aio_unlink $file unless $CACHE;
		241	commit_png $x\|$y ? "$face+$x+$y" : $face, $tile, $T;
		242	}
		243	} else {
		244	# use as-is (either small, use smooth)
		245	commit_png $face, $png, $T;
		246	}
		247
		248	aio_unlink $path if $delete;
		249	}
		250	}
		251
		252	sub process_arc {
		253	while (@arc) {
		254	my ($dir, $file) = @{pop @arc};
		255
		256	my $arc;
		257	aio_load "$dir/$file", $arc; # simply pre-cache, as read_arch wants a file :/
		258
		259	my $arc = read_arch "$dir/$file";
		260	for my $o (values %$arc) {
		261	push @ARC, $o;
		262
		263	$o->{editor_folder} = $dir;
		264
		265	my $visibility = delete $o->{visibility};
		266	my $magicmap = delete $o->{magicmap};
		267
		268	# find upper left corner :/
		269	# omg, this is sooo broken
		270	my ($dx, $dy);
		271	for (my $o = $o; $o; $o = $o->{more}) {
		272	$dx = $o->{x} if $o->{x} < $dx;
		273	$dy = $o->{y} if $o->{y} < $dy;
		274	}
		275
		276	for (my $o = $o; $o; $o = $o->{more}) {
		277	my $x = $o->{x} - $dx;
		278	my $y = $o->{y} - $dy;
		279
		280	my $ext = $x\|$y ? "+$x+$y" : "";
		281
		282	$o->{face} .= $ext unless /^blank.x11$\|^empty.x11$/;
		283
		284	my $visibility = delete $o->{visibility} if exists $o->{visibility};
		285	my $magicmap = delete $o->{magicmap} if exists $o->{magicmap};
		286
		287	my $anim = delete $o->{anim};
		288
		289	if ($anim) {
		290	$o->{animation} = "$o->{_name}";
		291
		292	for (@$anim) {
		293	$_ .= $ext unless /^facings\s\|^blank.x11$\|^empty.x11$/;
		294	}
		295
		296	$ANIM{"$o->{_name}$ext"} =
		297	join "", map "$_\n",
		298	"anim $o->{_name}",
		299	@$anim,
		300	"mina";
		301	}
		302
		303	for my $face ($o->{face} \|\| (), @{$anim \|\| []}) {
		304	next if $face =~ /^facings\s\|^blank.x11$\|^empty.x11$/;
		305
		306	my $info = $FACEINFO{$face} \|\|= {};
		307
		308	$info->{visibility} = $visibility if defined $visibility;
		309	$info->{magicmap} = $magicmap if defined $magicmap;
		310	}
		311
		312	if (my $smooth = delete $o->{smoothface}) {
		313	my ($face, $smooth) = split /\s+/, $smooth;
		314	# skip empty_S.x11, it seems to server no purpose whatsoever
		315	# but increases bandwidth demands and worse.
		316	unless ($smooth eq "empty_S.x11") {
		317	$FACEINFO{$face}{smooth} = $smooth;
		318	}
		319	}
		320	}
		321	}
		322	}
		323	}
		324
		325	sub process_trs {
		326	while (@trs) {
		327	my ($dir, $file) = @{pop @trs};
		328	my $path = "$dir/$file";
		329
		330	my $trs;
		331	if (0 > aio_load $path, $trs) {
		332	warn "$path: $!, skipping.\n";
		333	next;
		334	}
		335
		336	$TRS .= $trs;
		337	}
		338	}
		339
		340	sub find_files;
		341	sub find_files {
65	my ($path) = @_;	342	my ($path) = @_;
66		343
67	my $png;
68	aio_lstat $path, sub {
69	my ($size, $mtime) = (stat _)[7,9];
70
71	aio_load $path, $png, sub {
72	if ($_[0] < 0) {
73	warn "$path: $!, skipping.\n";
74	return;
75	}
76
77	unless ($png =~ /^\x89PNG\x0d\x0a\x1a\x0a....IHDR(........)/s) {
78	warn "$path: not a recongized png file, skipping.\n";
79	return;
80	}
81
82	my ($w, $h) = unpack "NN", $1;
83
84	(my $face = $path) =~ s/^.*\///;
85	my $T = 32;
86
87	unless ($face =~ s/\.base\.(...)\.png$/.$1/) {
88	warn "$path: weird filename, skipping.\n";
89	return;
90	}
91
92	if ($w < $T \|\| $h < $T) {
93	warn "$path: too small ($w $h), skipping.\n";
94	return;
95	}
96
97	if ($w % $T \|\| $h % $T) {
98	warn "$path: weird png size ($w $h), skipping.\n";
99	return;
100	}
101
102	if ($w > $T \|\| $h > $T) {
103	# split
104	} else {
105	# use as-is
106	commit_png $face, $png;
107	}
108
109	#warn "$path: $w, $h\n";
110	};
111	};
112
113	IO::AIO::poll; # reduce file-handle pressure
114	}
115
116	sub add_arc($$) {
117	my ($dir, $file) = @_;
118
119	my $arc;
120	aio_load "$dir/$file", $arc, sub { # simply pre-cache, as read_arch wants a file :/
121	my $arc = read_arch "$dir/$file";
122	};
123	}
124
125	sub add_trs($$) {
126	my ($dir, $file) = @_;
127	}
128
129	sub collect_arch;
130	sub collect_arch {
131	my ($path) = @_;
132
133	aioreq_pri 4;	344	IO::AIO::aioreq_pri 4;
134	aio_scandir $path, 4, sub {	345	IO::AIO::aio_scandir $path, 4, sub {
135	my ($dirs, $nondirs) = @_;	346	my ($dirs, $nondirs) = @_;
136		347
137	collect_arch "$path/$_"	348	find_files "$path/$_"
138	for grep $_ !~ /^(?:CVS\|dev)$/, @$dirs;	349	for grep $_ !~ /^(?:CVS\|dev)$/, @$dirs;
139		350
140	for my $file (@$nondirs) {	351	for my $file (@$nondirs) {
141	if ($file =~ /\.png$/) {	352	if ($file =~ /\.png$/) {
142	add_png "$path/$file";	353	push @png, ["$path/$file", 0];
143	} elsif ($file =~ /\.trs$/) {	354	} elsif ($file =~ /\.trs$/) {
144	add_trs $path, $file;	355	push @trs, [$path, $file];
145	} elsif ($file =~ /\.arc$/) {	356	} elsif ($file =~ /\.arc$/) {
146	add_arc $path, $file;	357	push @arc, [$path, $file];
147	} else {	358	} else {
148	warn "ignoring $path/$file\n" if $VERBOSE >= 2;	359	warn "ignoring $path/$file\n" if $VERBOSE >= 2;
149	}	360	}
150	}	361	}
151	};	362	};
152	}	363	}
153		364
154	sub inst_arch($) {	365	sub inst_arch($) {
155	my (undef, $path) = @_;	366	my (undef, $path) = @_;
156		367
157	print "installing '$path' to '$DATADIR'\n\n";	368	print "installing '$path' to '$DATADIR'\n",
		369	"(this can take a long time if you run this\n",
		370	"for the first time or do not use --cache).\n";
158		371
159	if (!-d "$path/treasures") {	372	if (!-d "$path/treasures") {
160	warn "'$path' does not look like an arch directory ('treasures' directory is missing).\n";	373	warn "'$path' does not look like an arch directory ('treasures' directory is missing).\n";
161	exit 1 unless $FORCE;	374	exit 1 unless $FORCE;
162	}	375	}
163		376
164	collect_arch $path;	377	find_files $path;
165	IO::AIO::flush;	378	IO::AIO::flush;
166		379
167	die "--install-arch not yet implemented\n";	380	$_->join for (
		381	# four png crunchers work fine for my 2x smp machine
		382	(async \&process_png), (async \&process_png), (async \&process_png), (async \&process_png),
		383	(async \&process_trs), (async \&process_trs),
		384	(async \&process_arc), (async \&process_arc),
		385	);
		386
		387	{
		388	open my $fh, ">:utf8", "$DATADIR/animations~"
		389	or die "$DATADIR/animations~: $!";
		390	print $fh join "", map $ANIM{$_}, sort keys %ANIM
		391	}
		392
		393	{
		394	open my $fh, ">:utf8", "$DATADIR/archetypes~"
		395	or die "$DATADIR/archetypes~: $!";
		396	substr $_->{editor_folder}, 0, 1 + length $path, "" for @ARC;
		397	print $fh Crossfire::archlist_to_string \@ARC;
		398	}
		399
		400	{
		401	open my $fh, ">:utf8", "$DATADIR/treasures~"
		402	or die "$DATADIR/treasures~: $!";
		403	print $fh $TRS;
		404	}
		405
		406	{
		407	while (my ($k, $v) = each %FACEINFO) {
		408	length $v->{data32} or warn "$k: face has no png32. this will not work (shoddy gcfclient will crash of course).\n";
		409	length $v->{data64} or warn "$k: face has no png64. this will not work very well.\n";
		410
		411	length $v->{data32} <= 10000 or warn "$k: face32 larger than 10000 bytes, will not work with crossfire client.\n";
		412	#length $v->{data64} <= 10000 or warn "$k: face64 larger than 10000 bytes.\n";
		413
		414	$v->{chksum32} = Digest::MD5::md5 $v->{data32};
		415	$v->{chksum64} = Digest::MD5::md5 $v->{data64};
		416	}
		417
		418	open my $fh, ">:perlio", "$DATADIR/facedata~"
		419	or die "$DATADIR/facedata~: $!";
		420
		421	$FACEINFO{""} = { version => 1};
		422	print $fh Storable::nfreeze \%FACEINFO;
		423	}
		424
		425	for (qw(archetypes facedata animations treasures)) {
		426	chmod 0644, "$DATADIR/$_~";
		427	rename "$DATADIR/$_~", "$DATADIR/$_"
		428	or die "$DATADIR/$_: $!";
		429	}
		430
		431	print "archetype data installed successfully.\n";
168	}	432	}
169	}	433	}
170		434
171	Getopt::Long::Configure ("bundling", "no_ignore_case");	435	Getopt::Long::Configure ("bundling", "no_ignore_case");
172	GetOptions (	436	GetOptions (
173	"verbose\|v:+" => \$VERBOSE,	437	"verbose\|v:+" => \$VERBOSE,
		438	"cache" => \$CACHE,
174	"quiet\|q" => sub { $VERBOSE = 0 },	439	"quiet\|q" => sub { $VERBOSE = 0 },
175	"force" => sub { $FORCE = 1 },	440	"force" => sub { $FORCE = 1 },
176	"install-arch=s" => \&inst_arch,	441	"install-arch=s" => \&inst_arch,
177	"install-maps=s" => \&inst_maps,	442	"install-maps=s" => \&inst_maps,
178	"print-statedir" => sub { print "@pkgstatedir@\n" },	443	"print-statedir" => sub { print "@pkgstatedir@\n" },

Diff Legend

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

Comparing deliantra/server/utils/cfutil.in (file contents): Revision 1.2 by root, Wed Mar 7 01:23:37 2007 UTC vs. Revision 1.20 by root, Mon Apr 2 18:04:47 2007 UTC

Diff Legend

Comparing deliantra/server/utils/cfutil.in (file contents):
Revision 1.2 by root, Wed Mar 7 01:23:37 2007 UTC vs.
Revision 1.20 by root, Mon Apr 2 18:04:47 2007 UTC