| … | |
… | |
| 130 | sub MOVE_ALL (){ 0x1001f } # very special value, more PITA |
130 | sub MOVE_ALL (){ 0x1001f } # very special value, more PITA |
| 131 | |
131 | |
| 132 | sub load_ref($) { |
132 | sub 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 | |
| 143 | sub save_ref($$) { |
142 | sub 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 | } |
| … | |
… | |
| 288 | sub read_pak($) { |
286 | sub 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 | |
| 305 | sub read_arch($) { |
303 | sub 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 { |
| … | |
… | |
| 368 | } else { |
366 | } else { |
| 369 | push @{ $arc{arch} }, $arc; |
367 | push @{ $arc{arch} }, $arc; |
| 370 | } |
368 | } |
| 371 | $prev = $arc; |
369 | $prev = $arc; |
| 372 | $more = undef; |
370 | $more = undef; |
|
|
371 | } elsif ($toplevel && /^(\S+)\s+(.*)$/) { |
|
|
372 | if ($1 eq "lev_array") { |
|
|
373 | while (<$fh>) { |
|
|
374 | last if /^endplst\s*$/; |
|
|
375 | push @{$toplevel->{lev_array}}, $_+0; |
|
|
376 | } |
|
|
377 | } else { |
|
|
378 | $toplevel->{$1} = $2; |
|
|
379 | } |
| 373 | } elsif (/^\s*($|#)/) { |
380 | } elsif (/^\s*($|#)/) { |
| 374 | # |
381 | # |
| 375 | } else { |
382 | } else { |
| 376 | warn "$path: unparseable top-level line '$_'"; |
383 | die "$path: unparseable top-level line '$_'"; |
| 377 | } |
384 | } |
| 378 | } |
385 | } |
| 379 | |
386 | |
| 380 | undef $parse_block; # work around bug in perl not freeing $fh etc. |
387 | undef $parse_block; # work around bug in perl not freeing $fh etc. |
| 381 | |
388 | |
