[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.8 by root, Sun Mar 11 21:26:06 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;
18		25
19	sub usage {	26	sub usage {
20	warn <<EOF;	27	warn <<EOF;
21	Usage: cfutil [-v] [-q] [--force]	28	Usage: cfutil [-v] [-q] [--force] [--cache]
22	[--install-arch path]	29	[--install-arch path]
23	[--install-maps maps]	30	[--install-maps maps]
24	[--print-statedir]	31	[--print-statedir]
25	[--print-confdir]	32	[--print-confdir]
26	[--print-datadir]	33	[--print-datadir]
…		…
29	EOF	36	EOF
30	exit 1;	37	exit 1;
31	}	38	}
32		39
33	my $VERBOSE = 1;	40	my $VERBOSE = 1;
		41	my $CACHE = 0;
34	my $FORCE;	42	my $FORCE;
35	my $TMPDIR = "/tmp/cfutil$$~";	43	my $TMPDIR = "/tmp/cfutil$$~";
		44	my $TMPFILE = "aaaa0";
36		45
37	END { system "rm", "-rf", $TMPDIR }	46	END { system "rm", "-rf", $TMPDIR }
		47
		48	Event->signal (signal => "INT", cb => sub { exit 1 });
		49	Event->signal (signal => "TERM", cb => sub { exit 1 });
38		50
39	mkdir $TMPDIR, 0700	51	mkdir $TMPDIR, 0700
40	or die "$TMPDIR: $!";	52	or die "$TMPDIR: $!";
		53
		54	sub fork_sub(&) {
		55	my ($cb) = @_;
		56
		57	if (my $pid = fork) {
		58	my $current = $Coro::current;
		59	my $w = AnyEvent->child (pid => $pid, cb => sub { $current->ready });
		60	Coro::schedule;
		61	} else {
		62	eval { $cb->() };
		63	POSIX::_exit 0 unless $@;
		64	warn $@;
		65	POSIX::_exit 1;
		66	}
		67	}
41		68
42	sub inst_maps($) {	69	sub inst_maps($) {
43	my (undef, $path) = @_;	70	my (undef, $path) = @_;
44		71
45	print "installing '$path' to '$DATADIR/maps'\n\n";	72	print "installing '$path' to '$DATADIR/maps'\n\n";
…		…
51		78
52	system $RSYNC, "-av", "$path/.", "$DATADIR/maps/.", "--delete", "--exclude", "CVS", "--delete-excluded";	79	system $RSYNC, "-av", "$path/.", "$DATADIR/maps/.", "--delete", "--exclude", "CVS", "--delete-excluded";
53	}	80	}
54		81
55	{	82	{
56	my @PNG;	83	our %PNG32;
		84	our %FACEINFO;
57	my @ARC;	85	our @ARC;
		86	our $NFILE;
		87	our %ANIM;
		88
		89	our (@png, @trs, @arc); # files we are interested in
58		90
59	sub commit_png {	91	sub commit_png {
60	my ($name, $data) = @_;	92	my ($name, $data) = @_;
61	#warn "$name: commited\n";
62	}
63		93
64	sub add_png($) {	94	$PNG32{$name} = $data;
		95	$FACEINFO{$name} \|\|= {};
		96	}
		97
		98	sub process_png {
		99	while (@png) {
		100	my $path = pop @png;
		101
		102	my $png;
		103	aio_lstat $path;
		104	my ($size, $mtime) = (stat _)[7,9];
		105
		106	if (0 > aio_load $path, $png) {
		107	warn "$path: $!, skipping.\n";
		108	next;
		109	}
		110
		111	# quickly extract width and height of the (necessarily PNG) image
		112	unless ($png =~ /^\x89PNG\x0d\x0a\x1a\x0a....IHDR(........)/s) {
		113	warn "$path: not a recongized png file, skipping.\n";
		114	next;
		115	}
		116
		117	my ($w, $h) = unpack "NN", $1;
		118
		119	(my $face = $path) =~ s/^.*\///;
		120	my $T = 32;
		121
		122	unless ($face =~ s/\.base\.(...)\.png$/.$1/) {
		123	warn "$path: weird filename, skipping.\n";
		124	next;
		125	}
		126
		127	if ($w < $T \|\| $h < $T) {
		128	warn "$path: too small ($w $h), skipping.\n";
		129	next;
		130	}
		131
		132	if ($w % $T \|\| $h % $T) {
		133	warn "$path: weird png size ($w $h), skipping.\n";
		134	next;
		135	}
		136
		137	if (($w > $T \|\| $h > $T) && $face !~ /_S\./) {
		138	# split
		139	my @tile;
		140	for my $x (0 .. (int $w / $T) - 1) {
		141	for my $y (0 .. (int $h / $T) - 1) {
		142	my $file = "$path+$x+$y~";
		143	aio_lstat $file;
		144	push @tile, [$x, $y, $file, (stat _)[9]];
		145	}
		146	}
		147
		148	my $mtime = (lstat $path)[9];
		149	my @todo = grep { $_->[3] <= $mtime } @tile;
		150	if (@todo) {
		151	fork_sub {
		152	open my $convert, "\|-", $CONVERT,
		153	"png:-",
		154	(map {
		155	(
		156	"(",
		157	"+clone",
		158	-crop => (sprintf "%dx%d+%d+%d", $T, $T, $_->[0] * $T, $_->[1] * $T),
		159	"+repage",
		160	-write => "png:$_->[2]~",
		161	"+delete",
		162	")",
		163	)
		164	} @todo),
		165	"null:";
		166
		167	binmode $convert;
		168	print $convert $png;
		169	close $convert;
		170
		171	# pass 2, optimise, and rename
		172	for (@todo) {
		173	system $OPTIPNG, "-o5", "-i0", "-q", "$_->[2]~";
		174	rename "$_->[2]~", $_->[2];
		175	}
		176	};
		177	}
		178
		179	for (@tile) {
		180	my ($x, $y, $file) = @$_;
		181	my $tile;
		182
		183	if (0 > aio_load $file, $tile) {
		184	die "$path: unable to read tile +$x+$y, aborting.\n";
		185	}
		186	IO::AIO::aio_unlink $file unless $CACHE;
		187	commit_png $x\|$y ? "$face+$x+$y" : $face, $tile;
		188	}
		189	} else {
		190	# use as-is (either small, use smooth)
		191	commit_png $face, $png;
		192	}
		193	}
		194	}
		195
		196	sub process_arc {
		197	while (@arc) {
		198	my ($dir, $file) = @{pop @arc};
		199
		200	my $arc;
		201	aio_load "$dir/$file", $arc; # simply pre-cache, as read_arch wants a file :/
		202
		203	my $arc = read_arch "$dir/$file";
		204	for my $o (values %$arc) {
		205	push @ARC, $o;
		206
		207	my $visibility = delete $o->{visibility};
		208	my $magicmap = delete $o->{magicmap};
		209
		210	# find upper left corner :/
		211	# omg, this is sooo broken
		212	my ($dx, $dy);
		213	for (my $o = $o; $o; $o = $o->{more}) {
		214	$dx = $o->{x} if $o->{x} < $dx;
		215	$dy = $o->{y} if $o->{y} < $dy;
		216	}
		217
		218	for (my $o = $o; $o; $o = $o->{more}) {
		219	my $x = $o->{x} - $dx;
		220	my $y = $o->{y} - $dy;
		221
		222	my $ext = $x\|$y ? "+$x+$y" : "";
		223
		224	$o->{face} .= $ext;
		225
		226	my $visibility = delete $o->{visibility} if exists $o->{visibility};
		227	my $magicmap = delete $o->{magicmap} if exists $o->{magicmap};
		228
		229	my $anim = delete $o->{anim};
		230
		231	if ($anim) {
		232	$o->{animation} = "$o->{_name}";
		233
		234	for (@$anim) {
		235	$_ .= $ext unless /^facings\s/;
		236	}
		237
		238	$ANIM{"$o->{_name}$ext"} =
		239	join "", map "$_\n",
		240	"anim $o->{_name}",
		241	@$anim,
		242	"mina";
		243	}
		244
		245	for my $face ($o->{face} \|\| (), @{$anim \|\| []}) {
		246	next if /^facings\s/;
		247
		248	my $info = $FACEINFO{$face} \|\|= {};
		249
		250	$info->{visibility} = $visibility if defined $visibility;
		251	$info->{magicmap} = $magicmap if defined $magicmap;
		252	}
		253	}
		254	}
		255	}
		256	}
		257
		258	sub process_trs {
		259	while (@trs) {
		260	my ($dir, $file) = @{pop @trs};
		261	}
		262	}
		263
		264	sub find_files;
		265	sub find_files {
65	my ($path) = @_;	266	my ($path) = @_;
66		267
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;	268	IO::AIO::aioreq_pri 4;
134	aio_scandir $path, 4, sub {	269	IO::AIO::aio_scandir $path, 4, sub {
135	my ($dirs, $nondirs) = @_;	270	my ($dirs, $nondirs) = @_;
136		271
137	collect_arch "$path/$_"	272	find_files "$path/$_"
138	for grep $_ !~ /^(?:CVS\|dev)$/, @$dirs;	273	for grep $_ !~ /^(?:CVS\|dev)$/, @$dirs;
139		274
140	for my $file (@$nondirs) {	275	for my $file (@$nondirs) {
141	if ($file =~ /\.png$/) {	276	if ($file =~ /\.png$/) {
142	add_png "$path/$file";	277	push @png, "$path/$file";
143	} elsif ($file =~ /\.trs$/) {	278	} elsif ($file =~ /\.trs$/) {
144	add_trs $path, $file;	279	push @trs, [$path, $file];
145	} elsif ($file =~ /\.arc$/) {	280	} elsif ($file =~ /\.arc$/) {
146	add_arc $path, $file;	281	push @arc, [$path, $file];
147	} else {	282	} else {
148	warn "ignoring $path/$file\n" if $VERBOSE >= 2;	283	warn "ignoring $path/$file\n" if $VERBOSE >= 2;
149	}	284	}
150	}	285	}
151	};	286	};
…		…
159	if (!-d "$path/treasures") {	294	if (!-d "$path/treasures") {
160	warn "'$path' does not look like an arch directory ('treasures' directory is missing).\n";	295	warn "'$path' does not look like an arch directory ('treasures' directory is missing).\n";
161	exit 1 unless $FORCE;	296	exit 1 unless $FORCE;
162	}	297	}
163		298
164	collect_arch $path;	299	find_files $path;
165	IO::AIO::flush;	300	IO::AIO::flush;
166		301
		302	$_->join for (
		303	(async \&process_png), (async \&process_png),
		304	(async \&process_trs), (async \&process_trs),
		305	(async \&process_arc), (async \&process_arc),
		306	);
		307
		308	{
		309	open my $fh, ">:utf8", "$DATADIR/animations~"
		310	or die "$DATADIR/animations~: $!";
		311	print $fh join "", map $ANIM{$_}, sort keys %ANIM
		312	}
		313
		314	{
		315	open my $fh, ">:utf8", "$DATADIR/archetypes~"
		316	or die "$DATADIR/archetypes~: $!";
		317	print $fh Crossfire::archlist_to_string \@ARC;
		318	}
		319
		320	{
		321	while (my ($k, $v) = each %FACEINFO) {
		322	$v->{data32} \|\|= delete $PNG32{$k};
		323	}
		324
		325	while (my ($k, $v) = each %FACEINFO) {
		326	exists $v->{data32} or warn "$k: face has no png32. this will crash the server.\n";
		327
		328	$v->{chksum32} = Digest::MD5::md5 $v->{data32};
		329	}
		330
		331	open my $fh, ">:perlio", "$DATADIR/faces~"
		332	or die "$DATADIR/faces~: $!";
		333
		334	print $fh Storable::nfreeze \%FACEINFO;
		335
		336	#use PApp::Util; warn PApp::Util::dumpval \%FACEINFO;
		337	}
		338
		339	for (qw(archetypes faces animations)) {
		340	chmod 0644, "$DATADIR/$_~";
		341	rename "$DATADIR/$_~", "$DATADIR/$_";
		342	}
		343
167	die "--install-arch not yet implemented\n";	344	die "--install-arch not fully implemented\n";
168	}	345	}
169	}	346	}
170		347
171	Getopt::Long::Configure ("bundling", "no_ignore_case");	348	Getopt::Long::Configure ("bundling", "no_ignore_case");
172	GetOptions (	349	GetOptions (
173	"verbose\|v:+" => \$VERBOSE,	350	"verbose\|v:+" => \$VERBOSE,
		351	"cache" => \$CACHE,
174	"quiet\|q" => sub { $VERBOSE = 0 },	352	"quiet\|q" => sub { $VERBOSE = 0 },
175	"force" => sub { $FORCE = 1 },	353	"force" => sub { $FORCE = 1 },
176	"install-arch=s" => \&inst_arch,	354	"install-arch=s" => \&inst_arch,
177	"install-maps=s" => \&inst_maps,	355	"install-maps=s" => \&inst_maps,
178	"print-statedir" => sub { print "@pkgstatedir@\n" },	356	"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.8 by root, Sun Mar 11 21:26:06 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.8 by root, Sun Mar 11 21:26:06 2007 UTC