server/utils/cfutil.in

#!@PERL@

use strict;

my $prefix      = "@prefix@";
my $exec_prefix = "@exec_prefix@";
my $datarootdir = "@datarootdir@";
my $DATADIR     = "@datadir@/@PACKAGE@";

my $CONVERT  = "@CONVERT@";
my $IDENTIFY = "@IDENTIFY@";
my $OPTIPNG  = "@OPTIPNG@";
my $RSYNC    = "@RSYNC@";

use Getopt::Long;
use Coro::Event;
use AnyEvent;
use IO::AIO ();
use File::Temp;
use Crossfire;
use Coro;
use Coro::AIO;
use POSIX ();
use Digest::MD5;

sub usage {
   warn <<EOF;
Usage: cfutil [-v] [-q] [--force] [--cache]
              [--install-arch path]
              [--install-maps maps]
              [--print-statedir]
              [--print-confdir]
              [--print-datadir]
              [--print-libdir]
              [--print-bindir]
EOF
   exit 1;
}

my $VERBOSE = 1;
my $CACHE = 0;
my $FORCE;
my $TMPDIR  = "/tmp/cfutil$$~";
my $TMPFILE = "aaaa0";

END { system "rm", "-rf", $TMPDIR }

Event->signal (signal => "INT",  cb => sub { exit 1 });
Event->signal (signal => "TERM", cb => sub { exit 1 });

mkdir $TMPDIR, 0700
   or die "$TMPDIR: $!";

sub fork_sub(&) {
   my ($cb) = @_;

   if (my $pid = fork) {
      my $current = $Coro::current;
      my $w = AnyEvent->child (pid => $pid, cb => sub { $current->ready });
      Coro::schedule;
   } else {
      eval { $cb->() };
      POSIX::_exit 0 unless $@;
      warn $@;
      POSIX::_exit 1;
   }
}

sub inst_maps($) {
   my (undef, $path) = @_;

   print "installing '$path' to '$DATADIR/maps'\n";

   if (!-f "$path/regions") {
      warn "'$path' does not look like a maps directory ('regions' file is missing).\n";
      exit 1 unless $FORCE;
   }

   system $RSYNC, "-av", "$path/.", "$DATADIR/maps/.", "--delete", "--exclude", "CVS", "--delete-excluded"
      or die "map installation failed.\n";

   print "maps installed successfully.\n";
}

{
   our %PNG32;
   our %FACEINFO;
   our @ARC;
   our $TRS;
   our $NFILE;
   our %ANIM;

   our (@png, @trs, @arc); # files we are interested in

   sub commit_png {
      my ($name, $data) = @_;

      $PNG32{$name} = $data;
      $FACEINFO{$name} ||= {};
   }

   sub process_png {
      while (@png) {
         my $path = pop @png;

         my $png;
         aio_lstat $path;
         my ($size, $mtime) = (stat _)[7,9];

         if (0 > aio_load $path, $png) {
            warn "$path: $!, skipping.\n";
            next;
         }

         # quickly extract width and height of the (necessarily PNG) image
         unless ($png =~ /^\x89PNG\x0d\x0a\x1a\x0a....IHDR(........)/s) {
            warn "$path: not a recongized png file, skipping.\n";
            next;
         }

         my ($w, $h) = unpack "NN", $1;

         (my $face = $path) =~ s/^.*\///;
         my $T = 32;

         unless ($face =~ s/\.base\.(...)\.png$/.$1/) {
            warn "$path: weird filename, skipping.\n";
            next;
         }

         if ($w < $T || $h < $T) {
            warn "$path: too small ($w $h), skipping.\n";
            next;
         }

         if ($w % $T || $h % $T) {
            warn "$path: weird png size ($w $h), skipping.\n";
            next;
         }

         if (($w > $T || $h > $T) && $face !~ /_S\./) {
            # split
            my @tile;
            for my $x (0 .. (int $w / $T) - 1) {
               for my $y (0 .. (int $h / $T) - 1) {
                  my $file = "$path+$x+$y~";
                  aio_lstat $file;
                  push @tile, [$x, $y, $file, (stat _)[9]];
               }
            }

            my $mtime = (lstat $path)[9];
            my @todo = grep { $_->[3] <= $mtime } @tile;
            if (@todo) {
               fork_sub {
                  open my $convert, "|-", $CONVERT,
                     "png:-",
                     (map {
                        (
                           "(",
                           "+clone",
                           -crop => (sprintf "%dx%d+%d+%d", $T, $T, $_->[0] * $T, $_->[1] * $T),
                           "+repage",
                           -write => "png:$_->[2]~",
                           "+delete",
                           ")",
                        )
                     } @todo),
                     "null:";

                  binmode $convert;
                  print $convert $png;
                  close $convert;

                  # pass 2, optimise, and rename
                  for (@todo) {
                     system $OPTIPNG, "-o5", "-i0", "-q", "$_->[2]~";
                     rename "$_->[2]~", $_->[2];
                  }
               };
            }

            for (@tile) {
               my ($x, $y, $file) = @$_;
               my $tile;

               if (0 > aio_load $file, $tile) {
                  die "$path: unable to read tile +$x+$y, aborting.\n";
               }
               IO::AIO::aio_unlink $file unless $CACHE;
               commit_png $x|$y ? "$face+$x+$y" : $face, $tile;
            }
         } else {
            # use as-is (either small, use smooth)
            commit_png $face, $png;
         }
      }
   }

   sub process_arc {
      while (@arc) {
         my ($dir, $file) = @{pop @arc};

         my $arc;
         aio_load "$dir/$file", $arc; # simply pre-cache, as read_arch wants a file :/

         my $arc = read_arch "$dir/$file";
         for my $o (values %$arc) {
            push @ARC, $o;

            $o->{editor_folder} = $dir;

            my $visibility = delete $o->{visibility};
            my $magicmap   = delete $o->{magicmap};

            # find upper left corner :/
            # omg, this is sooo broken
            my ($dx, $dy);
            for (my $o = $o; $o; $o = $o->{more}) {
               $dx = $o->{x} if $o->{x} < $dx;
               $dy = $o->{y} if $o->{y} < $dy;
            }

            for (my $o = $o; $o; $o = $o->{more}) {
               my $x = $o->{x} - $dx;
               my $y = $o->{y} - $dy;

               my $ext = $x|$y ? "+$x+$y" : "";

               $o->{face} .= $ext unless /^blank.x11$|^empty.x11$/;

               my $visibility = delete $o->{visibility} if exists $o->{visibility};
               my $magicmap   = delete $o->{magicmap}   if exists $o->{magicmap};

               my $anim = delete $o->{anim};

               if ($anim) {
                  $o->{animation} = "$o->{_name}";

                  for (@$anim) {
                     $_ .= $ext unless /^facings\s|^blank.x11$|^empty.x11$/;
                  }

                  $ANIM{"$o->{_name}$ext"} =
                     join "", map "$_\n",
                        "anim $o->{_name}",
                        @$anim,
                        "mina";
               }

               for my $face ($o->{face} || (), @{$anim || []}) {
                  next if $face =~ /^facings\s|^blank.x11$|^empty.x11$/;

                  my $info = $FACEINFO{$face} ||= {};

                  $info->{visibility} = $visibility if defined $visibility;
                  $info->{magicmap}   = $magicmap   if defined $magicmap;
               }

               if (my $smooth = delete $o->{smoothface}) {
                  my ($face, $smooth) = split /\s+/, $smooth;
                  # skip empty_S.x11, it seems to server no purpose whatsoever
                  # but increases bandwidth demands and worse.
                  unless ($smooth eq "empty_S.x11") {
                     $FACEINFO{$face}{smooth} = $smooth;
                  }
               }
            }
         }
      }
   }

   sub process_trs {
      while (@trs) {
         my ($dir, $file) = @{pop @trs};
         my $path = "$dir/$file";

         my $trs;
         if (0 > aio_load $path, $trs) {
            warn "$path: $!, skipping.\n";
            next;
         }

         $TRS .= $trs;
      }
   }

   sub find_files;
   sub find_files {
      my ($path) = @_;

      IO::AIO::aioreq_pri 4;
      IO::AIO::aio_scandir $path, 4, sub {
         my ($dirs, $nondirs) = @_;

         find_files "$path/$_"
            for grep $_ !~ /^(?:CVS|dev)$/, @$dirs;

         for my $file (@$nondirs) {
            if ($file =~ /\.png$/) {
               push @png, "$path/$file";
            } elsif ($file =~ /\.trs$/) {
               push @trs, [$path, $file];
            } elsif ($file =~ /\.arc$/) {
               push @arc, [$path, $file];
            } else {
               warn "ignoring $path/$file\n" if $VERBOSE >= 2;
            }
         }
      };
   }

   sub inst_arch($) {
      my (undef, $path) = @_;

      print "installing '$path' to '$DATADIR'\n";

      if (!-d "$path/treasures") {
         warn "'$path' does not look like an arch directory ('treasures' directory is missing).\n";
         exit 1 unless $FORCE;
      }

      find_files $path;
      IO::AIO::flush;

      $_->join for (
         (async \&process_png), (async \&process_png),
         (async \&process_trs), (async \&process_trs),
         (async \&process_arc), (async \&process_arc),
      );

      {
         open my $fh, ">:utf8", "$DATADIR/animations~"
            or die "$DATADIR/animations~: $!";
         print $fh join "", map $ANIM{$_}, sort keys %ANIM
      }

      {
         open my $fh, ">:utf8", "$DATADIR/archetypes~"
            or die "$DATADIR/archetypes~: $!";
         substr $_->{editor_folder}, 0, 1 + length $path, "" for @ARC;
         print $fh Crossfire::archlist_to_string \@ARC;
      }

      {
         open my $fh, ">:utf8", "$DATADIR/treasures~"
            or die "$DATADIR/treasures~: $!";
         print $fh $TRS;
      }

      {
         while (my ($k, $v) = each %FACEINFO) {
            $v->{data32} ||= delete $PNG32{$k};
         }

         while (my ($k, $v) = each %FACEINFO) {
            length $v->{data32} or warn "$k: face has no png32. this will not work (shoddy gcfclient will crash of course).\n";

            $v->{chksum32} = Digest::MD5::md5 $v->{data32};
         }

         open my $fh, ">:perlio", "$DATADIR/faces~"
            or die "$DATADIR/faces~: $!";

         print $fh Storable::nfreeze \%FACEINFO;
      }

      for (qw(archetypes faces animations treasures)) {
         chmod 0644, "$DATADIR/$_~";
         rename "$DATADIR/$_~", "$DATADIR/$_"
            or die "$DATADIR/$_: $!";
      }

      print "archetype data installed successfully.\n";
   }
}

Getopt::Long::Configure ("bundling", "no_ignore_case");
GetOptions (
   "verbose|v:+"    => \$VERBOSE,
   "cache"          => \$CACHE,
   "quiet|q"        => sub { $VERBOSE = 0 },
   "force"          => sub { $FORCE = 1 },
   "install-arch=s" => \&inst_arch,
   "install-maps=s" => \&inst_maps,
   "print-statedir" => sub { print "@pkgstatedir@\n" },
   "print-datadir"  => sub { print "$DATADIR\n" },
   "print-confdir"  => sub { print "@pkgconfdir@\n" },
   "print-libdir"   => sub { print "@libdir@/@PACKAGE@\n" },
   "print-bindir"   => sub { print "@bindir@/@PACKAGE@\n" },
) or usage;

Revision:	1.14
Committed:	Wed Mar 14 00:04:59 2007 UTC (17 years, 2 months ago) by root
Branch:	MAIN
Changes since 1.13:	+7 -9 lines
Log Message:	- rewrote smooth face handling, as a side-effect, smoothing seems to work again and smooth faces can be reloaded. - the server now sends the full animation for an object the first time it is seen, this uses slightly more bandwidth initially, but avoids the flickering for objects change their face later.
#	User	Rev	Content
1	root	1.1	#!@PERL@
2
3	root	1.2	use strict;
4
5			my $prefix = "@prefix@";
6			my $exec_prefix = "@exec_prefix@";
7			my $datarootdir = "@datarootdir@";
8			my $DATADIR = "@datadir@/@PACKAGE@";
9
10			my $CONVERT = "@CONVERT@";
11			my $IDENTIFY = "@IDENTIFY@";
12	root	1.3	my $OPTIPNG = "@OPTIPNG@";
13	root	1.2	my $RSYNC = "@RSYNC@";
14
15			use Getopt::Long;
16	root	1.3	use Coro::Event;
17			use AnyEvent;
18			use IO::AIO ();
19	root	1.2	use File::Temp;
20			use Crossfire;
21	root	1.3	use Coro;
22			use Coro::AIO;
23			use POSIX ();
24	root	1.6	use Digest::MD5;
25	root	1.2
26			sub usage {
27			warn <<EOF;
28	root	1.3	Usage: cfutil [-v] [-q] [--force] [--cache]
29	root	1.2	[--install-arch path]
30			[--install-maps maps]
31			[--print-statedir]
32			[--print-confdir]
33			[--print-datadir]
34			[--print-libdir]
35			[--print-bindir]
36			EOF
37			exit 1;
38			}
39
40			my $VERBOSE = 1;
41	root	1.3	my $CACHE = 0;
42	root	1.2	my $FORCE;
43	root	1.3	my $TMPDIR = "/tmp/cfutil$$~";
44			my $TMPFILE = "aaaa0";
45	root	1.2
46			END { system "rm", "-rf", $TMPDIR }
47
48	root	1.3	Event->signal (signal => "INT", cb => sub { exit 1 });
49			Event->signal (signal => "TERM", cb => sub { exit 1 });
50
51	root	1.2	mkdir $TMPDIR, 0700
52			or die "$TMPDIR: $!";
53
54	root	1.3	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			}
68
69	root	1.2	sub inst_maps($) {
70			my (undef, $path) = @_;
71
72	root	1.13	print "installing '$path' to '$DATADIR/maps'\n";
73	root	1.2
74			if (!-f "$path/regions") {
75			warn "'$path' does not look like a maps directory ('regions' file is missing).\n";
76			exit 1 unless $FORCE;
77			}
78
79	root	1.13	system $RSYNC, "-av", "$path/.", "$DATADIR/maps/.", "--delete", "--exclude", "CVS", "--delete-excluded"
80			or die "map installation failed.\n";
81
82			print "maps installed successfully.\n";
83	root	1.2	}
84
85			{
86	root	1.6	our %PNG32;
87			our %FACEINFO;
88	root	1.3	our @ARC;
89	root	1.12	our $TRS;
90	root	1.3	our $NFILE;
91	root	1.6	our %ANIM;
92	root	1.3
93			our (@png, @trs, @arc); # files we are interested in
94	root	1.2
95			sub commit_png {
96			my ($name, $data) = @_;
97	root	1.5
98	root	1.6	$PNG32{$name} = $data;
99			$FACEINFO{$name} \|\|= {};
100	root	1.2	}
101
102	root	1.3	sub process_png {
103			while (@png) {
104			my $path = pop @png;
105	root	1.2
106	root	1.3	my $png;
107			aio_lstat $path;
108	root	1.2	my ($size, $mtime) = (stat _)[7,9];
109
110	root	1.3	if (0 > aio_load $path, $png) {
111			warn "$path: $!, skipping.\n";
112	root	1.5	next;
113	root	1.3	}
114
115	root	1.6	# quickly extract width and height of the (necessarily PNG) image
116	root	1.3	unless ($png =~ /^\x89PNG\x0d\x0a\x1a\x0a....IHDR(........)/s) {
117			warn "$path: not a recongized png file, skipping.\n";
118	root	1.5	next;
119	root	1.3	}
120	root	1.2
121	root	1.3	my ($w, $h) = unpack "NN", $1;
122	root	1.2
123	root	1.3	(my $face = $path) =~ s/^.*\///;
124			my $T = 32;
125	root	1.2
126	root	1.3	unless ($face =~ s/\.base\.(...)\.png$/.$1/) {
127			warn "$path: weird filename, skipping.\n";
128	root	1.5	next;
129	root	1.3	}
130	root	1.2
131	root	1.3	if ($w < $T \|\| $h < $T) {
132			warn "$path: too small ($w $h), skipping.\n";
133	root	1.5	next;
134	root	1.3	}
135
136			if ($w % $T \|\| $h % $T) {
137			warn "$path: weird png size ($w $h), skipping.\n";
138	root	1.5	next;
139	root	1.3	}
140	root	1.2
141	root	1.3	if (($w > $T \|\| $h > $T) && $face !~ /_S\./) {
142			# split
143			my @tile;
144			for my $x (0 .. (int $w / $T) - 1) {
145			for my $y (0 .. (int $h / $T) - 1) {
146			my $file = "$path+$x+$y~";
147			aio_lstat $file;
148			push @tile, [$x, $y, $file, (stat _)[9]];
149			}
150	root	1.2	}
151
152	root	1.3	my $mtime = (lstat $path)[9];
153			my @todo = grep { $_->[3] <= $mtime } @tile;
154			if (@todo) {
155			fork_sub {
156			open my $convert, "\|-", $CONVERT,
157			"png:-",
158			(map {
159			(
160			"(",
161			"+clone",
162			-crop => (sprintf "%dx%d+%d+%d", $T, $T, $_->[0] * $T, $_->[1] * $T),
163	root	1.7	"+repage",
164	root	1.3	-write => "png:$_->[2]~",
165			"+delete",
166			")",
167			)
168			} @todo),
169			"null:";
170
171			binmode $convert;
172			print $convert $png;
173			close $convert;
174
175			# pass 2, optimise, and rename
176			for (@todo) {
177			system $OPTIPNG, "-o5", "-i0", "-q", "$_->[2]~";
178			rename "$_->[2]~", $_->[2];
179			}
180			};
181	root	1.2	}
182
183	root	1.3	for (@tile) {
184			my ($x, $y, $file) = @$_;
185			my $tile;
186
187			if (0 > aio_load $file, $tile) {
188			die "$path: unable to read tile +$x+$y, aborting.\n";
189			}
190			IO::AIO::aio_unlink $file unless $CACHE;
191			commit_png $x\|$y ? "$face+$x+$y" : $face, $tile;
192	root	1.2	}
193	root	1.3	} else {
194			# use as-is (either small, use smooth)
195			commit_png $face, $png;
196			}
197			}
198	root	1.2	}
199
200	root	1.3	sub process_arc {
201			while (@arc) {
202			my ($dir, $file) = @{pop @arc};
203	root	1.2
204	root	1.3	my $arc;
205			aio_load "$dir/$file", $arc; # simply pre-cache, as read_arch wants a file :/
206	root	1.4
207	root	1.2	my $arc = read_arch "$dir/$file";
208	root	1.4	for my $o (values %$arc) {
209			push @ARC, $o;
210	root	1.6
211	root	1.10	$o->{editor_folder} = $dir;
212
213	root	1.6	my $visibility = delete $o->{visibility};
214			my $magicmap = delete $o->{magicmap};
215
216			# find upper left corner :/
217			# omg, this is sooo broken
218	root	1.4	my ($dx, $dy);
219			for (my $o = $o; $o; $o = $o->{more}) {
220			$dx = $o->{x} if $o->{x} < $dx;
221			$dy = $o->{y} if $o->{y} < $dy;
222			}
223	root	1.6
224	root	1.4	for (my $o = $o; $o; $o = $o->{more}) {
225			my $x = $o->{x} - $dx;
226			my $y = $o->{y} - $dy;
227	root	1.6
228			my $ext = $x\|$y ? "+$x+$y" : "";
229
230	root	1.9	$o->{face} .= $ext unless /^blank.x11$\|^empty.x11$/;
231	root	1.6
232			my $visibility = delete $o->{visibility} if exists $o->{visibility};
233			my $magicmap = delete $o->{magicmap} if exists $o->{magicmap};
234
235			my $anim = delete $o->{anim};
236
237			if ($anim) {
238	root	1.8	$o->{animation} = "$o->{_name}";
239	root	1.6
240			for (@$anim) {
241	root	1.9	$_ .= $ext unless /^facings\s\|^blank.x11$\|^empty.x11$/;
242	root	1.6	}
243
244			$ANIM{"$o->{_name}$ext"} =
245			join "", map "$_\n",
246	root	1.8	"anim $o->{_name}",
247	root	1.6	@$anim,
248			"mina";
249			}
250
251			for my $face ($o->{face} \|\| (), @{$anim \|\| []}) {
252	root	1.9	next if $face =~ /^facings\s\|^blank.x11$\|^empty.x11$/;
253	root	1.6
254			my $info = $FACEINFO{$face} \|\|= {};
255
256			$info->{visibility} = $visibility if defined $visibility;
257			$info->{magicmap} = $magicmap if defined $magicmap;
258	root	1.4	}
259	root	1.12
260			if (my $smooth = delete $o->{smoothface}) {
261	root	1.14	my ($face, $smooth) = split /\s+/, $smooth;
262			# skip empty_S.x11, it seems to server no purpose whatsoever
263			# but increases bandwidth demands and worse.
264			unless ($smooth eq "empty_S.x11") {
265			$FACEINFO{$face}{smooth} = $smooth;
266			}
267	root	1.12	}
268	root	1.4	}
269			}
270	root	1.3	}
271	root	1.2	}
272
273	root	1.3	sub process_trs {
274			while (@trs) {
275			my ($dir, $file) = @{pop @trs};
276	root	1.12	my $path = "$dir/$file";
277
278			my $trs;
279			if (0 > aio_load $path, $trs) {
280			warn "$path: $!, skipping.\n";
281			next;
282			}
283
284			$TRS .= $trs;
285	root	1.3	}
286	root	1.2	}
287
288	root	1.3	sub find_files;
289			sub find_files {
290	root	1.2	my ($path) = @_;
291
292	root	1.3	IO::AIO::aioreq_pri 4;
293			IO::AIO::aio_scandir $path, 4, sub {
294	root	1.2	my ($dirs, $nondirs) = @_;
295
296	root	1.3	find_files "$path/$_"
297	root	1.2	for grep $_ !~ /^(?:CVS\|dev)$/, @$dirs;
298
299			for my $file (@$nondirs) {
300			if ($file =~ /\.png$/) {
301	root	1.3	push @png, "$path/$file";
302	root	1.2	} elsif ($file =~ /\.trs$/) {
303	root	1.3	push @trs, [$path, $file];
304	root	1.2	} elsif ($file =~ /\.arc$/) {
305	root	1.3	push @arc, [$path, $file];
306	root	1.2	} else {
307			warn "ignoring $path/$file\n" if $VERBOSE >= 2;
308			}
309			}
310			};
311			}
312
313			sub inst_arch($) {
314			my (undef, $path) = @_;
315
316	root	1.13	print "installing '$path' to '$DATADIR'\n";
317	root	1.2
318			if (!-d "$path/treasures") {
319			warn "'$path' does not look like an arch directory ('treasures' directory is missing).\n";
320			exit 1 unless $FORCE;
321			}
322
323	root	1.3	find_files $path;
324	root	1.2	IO::AIO::flush;
325
326	root	1.3	$_->join for (
327			(async \&process_png), (async \&process_png),
328			(async \&process_trs), (async \&process_trs),
329			(async \&process_arc), (async \&process_arc),
330			);
331
332	root	1.5	{
333			open my $fh, ">:utf8", "$DATADIR/animations~"
334			or die "$DATADIR/animations~: $!";
335	root	1.6	print $fh join "", map $ANIM{$_}, sort keys %ANIM
336	root	1.5	}
337
338			{
339			open my $fh, ">:utf8", "$DATADIR/archetypes~"
340			or die "$DATADIR/archetypes~: $!";
341	root	1.11	substr $_->{editor_folder}, 0, 1 + length $path, "" for @ARC;
342	root	1.5	print $fh Crossfire::archlist_to_string \@ARC;
343			}
344
345	root	1.6	{
346	root	1.12	open my $fh, ">:utf8", "$DATADIR/treasures~"
347			or die "$DATADIR/treasures~: $!";
348			print $fh $TRS;
349			}
350
351			{
352	root	1.6	while (my ($k, $v) = each %FACEINFO) {
353			$v->{data32} \|\|= delete $PNG32{$k};
354			}
355
356			while (my ($k, $v) = each %FACEINFO) {
357	root	1.12	length $v->{data32} or warn "$k: face has no png32. this will not work (shoddy gcfclient will crash of course).\n";
358	root	1.5
359	root	1.6	$v->{chksum32} = Digest::MD5::md5 $v->{data32};
360			}
361
362			open my $fh, ">:perlio", "$DATADIR/faces~"
363			or die "$DATADIR/faces~: $!";
364
365			print $fh Storable::nfreeze \%FACEINFO;
366	root	1.5	}
367
368	root	1.14	for (qw(archetypes faces animations treasures)) {
369	root	1.6	chmod 0644, "$DATADIR/$_~";
370	root	1.13	rename "$DATADIR/$_~", "$DATADIR/$_"
371			or die "$DATADIR/$_: $!";
372	root	1.6	}
373	root	1.13
374			print "archetype data installed successfully.\n";
375	root	1.2	}
376			}
377
378			Getopt::Long::Configure ("bundling", "no_ignore_case");
379			GetOptions (
380			"verbose\|v:+" => \$VERBOSE,
381	root	1.3	"cache" => \$CACHE,
382	root	1.2	"quiet\|q" => sub { $VERBOSE = 0 },
383			"force" => sub { $FORCE = 1 },
384			"install-arch=s" => \&inst_arch,
385			"install-maps=s" => \&inst_maps,
386			"print-statedir" => sub { print "@pkgstatedir@\n" },
387			"print-datadir" => sub { print "$DATADIR\n" },
388			"print-confdir" => sub { print "@pkgconfdir@\n" },
389			"print-libdir" => sub { print "@libdir@/@PACKAGE@\n" },
390			"print-bindir" => sub { print "@bindir@/@PACKAGE@\n" },
391			) or usage;
392