… | |
… | |
114 | my ($path, $cache) = @_; |
114 | my ($path, $cache) = @_; |
115 | |
115 | |
116 | eval { |
116 | eval { |
117 | defined $cache |
117 | defined $cache |
118 | && -M $cache < -M $path |
118 | && -M $cache < -M $path |
119 | && Storable::retrieve $cache |
119 | && Storable::retrieve ($cache) |
120 | } or do { |
120 | } or do { |
121 | my %pak; |
121 | my %pak; |
122 | |
122 | |
123 | open my $fh, "<:raw", $path |
123 | open my $fh, "<:raw", $path |
124 | or Carp::croak "$_[0]: $!"; |
124 | or Carp::croak "$_[0]: $!"; |
… | |
… | |
126 | my ($type, $id, $len, $path) = split; |
126 | my ($type, $id, $len, $path) = split; |
127 | $path =~ s/.*\///; |
127 | $path =~ s/.*\///; |
128 | read $fh, $pak{$path}, $len; |
128 | read $fh, $pak{$path}, $len; |
129 | } |
129 | } |
130 | |
130 | |
131 | Storable::nstore \%pak, $cache |
131 | Storable::nstore (\%pak, $cache) |
132 | if defined $cache; |
132 | if defined $cache; |
133 | |
133 | |
134 | \%pak |
134 | \%pak |
135 | } |
135 | } |
136 | } |
136 | } |
… | |
… | |
139 | my ($path, $cache) = @_; |
139 | my ($path, $cache) = @_; |
140 | |
140 | |
141 | eval { |
141 | eval { |
142 | defined $cache |
142 | defined $cache |
143 | && -M $cache < -M $path |
143 | && -M $cache < -M $path |
144 | && Storable::retrieve $cache |
144 | && Storable::retrieve ($cache) |
145 | } or do { |
145 | } or do { |
146 | my %arc; |
146 | my %arc; |
147 | my ($more, $prev); |
147 | my ($more, $prev); |
148 | |
148 | |
149 | open my $fh, "<:raw", $path |
149 | open my $fh, "<:raw", $path |
… | |
… | |
204 | } |
204 | } |
205 | } |
205 | } |
206 | |
206 | |
207 | 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. |
208 | |
208 | |
209 | Storable::nstore \%arc, $cache |
209 | Storable::nstore (\%arc, $cache) |
210 | if defined $cache; |
210 | if defined $cache; |
211 | |
211 | |
212 | \%arc |
212 | \%arc |
213 | } |
213 | } |
214 | } |
214 | } |
… | |
… | |
270 | sub init($) { |
270 | sub init($) { |
271 | my ($cachedir) = @_; |
271 | my ($cachedir) = @_; |
272 | |
272 | |
273 | return if %ARCH; |
273 | return if %ARCH; |
274 | |
274 | |
275 | mkdir 0777, $cachedir; |
275 | mkdir $cachedir, 0777; |
276 | *ARCH = read_arch "$LIB/archetypes", "$cachedir/archetypes.pst"; |
276 | *ARCH = read_arch "$LIB/archetypes", "$cachedir/archetypes.pst"; |
277 | } |
277 | } |
278 | |
278 | |
279 | =item $type = arch_attr $arch |
279 | =item $type = arch_attr $arch |
280 | |
280 | |