ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra/Deliantra.pm
(Generate patch)

Comparing deliantra/Deliantra/Deliantra.pm (file contents):
Revision 1.17 by root, Wed Feb 22 22:36:45 2006 UTC vs.
Revision 1.23 by root, Thu Feb 23 02:52:51 2006 UTC

… …
12 12
13use base 'Exporter'; 13use base 'Exporter';
14 14
15use Carp (); 15use Carp ();
16use Storable; 16use Storable;
17use File::Spec;
17use List::Util qw(min max); 18use List::Util qw(min max);
18 19
19#XXX: The map_* procedures scream for a map-object 20#XXX: The map_* procedures scream for a map-object
20 21
21our @EXPORT = 22our @EXPORT =
… …
113 my ($path, $cache) = @_; 114 my ($path, $cache) = @_;
114 115
115 eval { 116 eval {
116 defined $cache 117 defined $cache
117 && -M $cache < -M $path 118 && -M $cache < -M $path
118 && Storable::retrieve $cache 119 && Storable::retrieve ($cache)
119 } or do { 120 } or do {
120 my %pak; 121 my %pak;
121 122
122 open my $fh, "<:raw", $path 123 open my $fh, "<:raw", $path
123 or Carp::croak "$_[0]: $!"; 124 or Carp::croak "$_[0]: $!";
… …
125 my ($type, $id, $len, $path) = split; 126 my ($type, $id, $len, $path) = split;
126 $path =~ s/.*\///; 127 $path =~ s/.*\///;
127 read $fh, $pak{$path}, $len; 128 read $fh, $pak{$path}, $len;
128 } 129 }
129 130
130 Storable::nstore \%pak, $cache 131 Storable::nstore (\%pak, $cache)
131 if defined $cache; 132 if defined $cache;
132 133
133 \%pak 134 \%pak
134 } 135 }
135} 136}
… …
138 my ($path, $cache) = @_; 139 my ($path, $cache) = @_;
139 140
140 eval { 141 eval {
141 defined $cache 142 defined $cache
142 && -M $cache < -M $path 143 && -M $cache < -M $path
143 && Storable::retrieve $cache 144 && Storable::retrieve ($cache)
144 } or do { 145 } or do {
145 my %arc; 146 my %arc;
146 my ($more, $prev); 147 my ($more, $prev);
147 148
148 open my $fh, "<:raw", $path 149 open my $fh, "<:raw", $path
… …
203 } 204 }
204 } 205 }
205 206
206 undef $parse_block; # work around bug in perl not freeing $fh etc. 207 undef $parse_block; # work around bug in perl not freeing $fh etc.
207 208
208 Storable::nstore \%arc, $cache 209 Storable::nstore (\%arc, $cache)
209 if defined $cache; 210 if defined $cache;
210 211
211 \%arc 212 \%arc
212 } 213 }
213} 214}
… …
269sub init($) { 270sub init($) {
270 my ($cachedir) = @_; 271 my ($cachedir) = @_;
271 272
272 return if %ARCH; 273 return if %ARCH;
273 274
275 mkdir $cachedir, 0777;
274 *ARCH = read_arch "$LIB/archetypes", "$cachedir/archetypes.pst"; 276 *ARCH = read_arch "$LIB/archetypes", "$cachedir/archetypes.pst";
275} 277}
276 278
277=item $data = arch_attr $arch 279=item $type = arch_attr $arch
278 280
279Returns a hashref describing the object and its attributes. It can contain 281Returns a hashref describing the object and its attributes. It can contain
280the following keys: 282the following keys:
281 283
282 name the name, suitable for display purposes 284 name the name, suitable for display purposes
283 ignore 285 ignore
284 attr 286 attr
285 desc 287 desc
286 use 288 use
287 section => [name => \%attr, name => \%attr] 289 section => [name => \%attr, name => \%attr]
290 import
288 291
289=cut 292=cut
290 293
291sub arch_attr($) { 294sub arch_attr($) {
292 my ($arch) = @_; 295 my ($arch) = @_;
293 296
294 require Crossfire::Data; 297 require Crossfire::Data;
295 298
296 my %attr; 299 my $attr;
297 300
298 if ($arch->{type} > 0) { 301 if ($arch->{type} > 0) {
299 %attr = %{ $Crossfire::Data::ATTR{$arch->{type}+0} || {} }; 302 $attr = $Crossfire::Data::ATTR{$arch->{type}+0};
300 } else { 303 } else {
301 die; 304 $attr = $Crossfire::Data::TYPE{Misc};
302 }
303 305
304 use PApp::Util; 306 type:
305 warn PApp::Util::dumpval \%attr; 307 for (@Crossfire::Data::ATTR0) {
308 my $req = $_->{required}
309 or die "internal error: ATTR0 without 'required'";
310
311 while (my ($k, $v) = each %$req) {
312 next type
313 unless $arch->{$k} == $v;
314 }
315
316 $attr = $_;
317 }
318 }
319
320 $attr || \%Crossfire::Data::DEFAULT_ATTR;
306} 321}
307 322
308sub arch_edit_sections { 323sub arch_edit_sections {
309# if (edit_type == IGUIConstants.TILE_EDIT_NONE) 324# if (edit_type == IGUIConstants.TILE_EDIT_NONE)
310# edit_type = 0; 325# edit_type = 0;
… …
364# return(edit_type); 379# return(edit_type);
365# 380#
366# 381#
367} 382}
368 383
369$CACHEDIR ||= "$ENV{HOME}/.crossfire"; 384$CACHEDIR ||= $ENV{HOME} ? "$ENV{HOME}/.crossfire" : File::Spec->tmpdir;
370 385
371init $CACHEDIR; 386init $CACHEDIR;
372 387
373=head1 AUTHOR 388=head1 AUTHOR
374 389

Diff Legend

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