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.62 by root, Tue Mar 28 14:44:52 2006 UTC vs.
Revision 1.65 by root, Wed May 3 19:34:31 2006 UTC

130sub MOVE_ALL (){ 0x1001f } # very special value, more PITA 130sub MOVE_ALL (){ 0x1001f } # very special value, more PITA
131 131
132sub load_ref($) { 132sub load_ref($) {
133 my ($path) = @_; 133 my ($path) = @_;
134 134
135 open my $fh, "<", $path 135 open my $fh, "<:raw:perlio", $path
136 or die "$path: $!"; 136 or die "$path: $!";
137 binmode $fh;
138 local $/; 137 local $/;
139 138
140 thaw <$fh> 139 thaw <$fh>
141} 140}
142 141
143sub save_ref($$) { 142sub save_ref($$) {
144 my ($ref, $path) = @_; 143 my ($ref, $path) = @_;
145 144
146 open my $fh, ">", "$path~" 145 open my $fh, ">:raw:perlio", "$path~"
147 or die "$path~: $!"; 146 or die "$path~: $!";
148 binmode $fh;
149 print $fh freeze $ref; 147 print $fh freeze $ref;
150 close $fh; 148 close $fh;
151 rename "$path~", $path 149 rename "$path~", $path
152 or die "$path: $!"; 150 or die "$path: $!";
153} 151}
288sub read_pak($) { 286sub read_pak($) {
289 my ($path) = @_; 287 my ($path) = @_;
290 288
291 my %pak; 289 my %pak;
292 290
293 open my $fh, "<", $path 291 open my $fh, "<:raw:perlio", $path
294 or Carp::croak "$_[0]: $!"; 292 or Carp::croak "$_[0]: $!";
295 binmode $fh; 293 binmode $fh;
296 while (<$fh>) { 294 while (<$fh>) {
297 my ($type, $id, $len, $path) = split; 295 my ($type, $id, $len, $path) = split;
298 $path =~ s/.*\///; 296 $path =~ s/.*\///;
300 } 298 }
301 299
302 \%pak 300 \%pak
303} 301}
304 302
305sub read_arch($) { 303sub read_arch($;$) {
306 my ($path) = @_; 304 my ($path, $toplevel) = @_;
307 305
308 my %arc; 306 my %arc;
309 my ($more, $prev); 307 my ($more, $prev);
310 308
311 open my $fh, "<", $path 309 open my $fh, "<:raw:perlio:utf8", $path
312 or Carp::croak "$path: $!"; 310 or Carp::croak "$path: $!";
313 311
314 binmode $fh; 312 binmode $fh;
315 313
316 my $parse_block; $parse_block = sub { 314 my $parse_block; $parse_block = sub {
330 } elsif (/^msg$/i) { 328 } elsif (/^msg$/i) {
331 while (<$fh>) { 329 while (<$fh>) {
332 last if /^endmsg\s*$/i; 330 last if /^endmsg\s*$/i;
333 $arc{msg} .= $_; 331 $arc{msg} .= $_;
334 } 332 }
333 } elsif (/^anim$/i) {
334 while (<$fh>) {
335 last if /^mina\s*$/i;
336 chomp;
337 push @{ $arc{anim} }, $_;
338 }
335 } elsif (/^(\S+)\s*(.*)$/) { 339 } elsif (/^(\S+)\s*(.*)$/) {
336 $arc{lc $1} = $2; 340 $arc{lc $1} = $2;
337 } elsif (/^\s*($|#)/) { 341 } elsif (/^\s*($|#)/) {
338 # 342 #
339 } else { 343 } else {
368 } else { 372 } else {
369 push @{ $arc{arch} }, $arc; 373 push @{ $arc{arch} }, $arc;
370 } 374 }
371 $prev = $arc; 375 $prev = $arc;
372 $more = undef; 376 $more = undef;
377 } elsif ($toplevel && /^(\S+)\s+(.*)$/) {
378 if ($1 eq "lev_array") {
379 while (<$fh>) {
380 last if /^endplst\s*$/;
381 push @{$toplevel->{lev_array}}, $_+0;
382 }
383 } else {
384 $toplevel->{$1} = $2;
385 }
373 } elsif (/^\s*($|#)/) { 386 } elsif (/^\s*($|#)/) {
374 # 387 #
375 } else { 388 } else {
376 warn "$path: unparseable top-level line '$_'"; 389 die "$path: unparseable top-level line '$_'";
377 } 390 }
378 } 391 }
379 392
380 undef $parse_block; # work around bug in perl not freeing $fh etc. 393 undef $parse_block; # work around bug in perl not freeing $fh etc.
381 394

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines