146 |
rdwr => $mode && O_RDWR, |
rdwr => $mode && O_RDWR, |
147 |
append => $mode && O_APPEND, |
append => $mode && O_APPEND, |
148 |
create => $mode && O_CREAT, |
create => $mode && O_CREAT, |
149 |
|
trunc => $mode && O_TRUNC, |
150 |
}; |
}; |
151 |
warn "# open( $file, $mode ) pending: ", $pending->{$file}->{open}, " mode: ", dump( $mode_desc ),"\n"; |
my $path = fixup($file); |
152 |
|
warn "# open( $file, $mode ) pending: ", $pending->{$file}->{open}, " mode $mode: ", dump( $mode_desc )," $path [", -s $path, "]\n"; |
153 |
my $fh; |
my $fh; |
154 |
|
|
|
my $path = fixup($file); |
|
155 |
my $tmp = $mount->{tmp} . '/' . $file; |
my $tmp = $mount->{tmp} . '/' . $file; |
156 |
if ( -e $tmp ) { |
if ( -e $tmp ) { |
157 |
$path = $tmp; |
$path = $tmp; |
162 |
file_copy( '<:gzip', $path, '>', $tmp ); |
file_copy( '<:gzip', $path, '>', $tmp ); |
163 |
$path = $tmp; |
$path = $tmp; |
164 |
} |
} |
165 |
warn ">>> open abs path: $path [", -s $path, "]\n"; |
warn ">>> open abs path: $path [", -e $path ? -s $path : 'new' , "]\n"; |
166 |
return -$! unless sysopen($fh , $path, $mode); |
return -$! unless sysopen($fh , $path, $mode); |
167 |
|
warn ">>> after open [",-s $path, "]\n"; |
168 |
close($fh); |
close($fh); |
169 |
|
|
170 |
$pending->{$file}->{path} = $path; |
$pending->{$file}->{path} = $path; |
245 |
return $err; |
return $err; |
246 |
} |
} |
247 |
|
|
248 |
sub x_truncate { return truncate(fixup(shift),shift) ? 0 : -$! ; } |
sub x_truncate { |
249 |
|
my ( $file,$size ) = @_; |
250 |
|
my $path = fixup($file); |
251 |
|
my $rv = truncate( $path, $size ) ? 0 : -$! ; |
252 |
|
if ( $path =~ m/\.gz$/ ) { |
253 |
|
my $no_gz = $path; |
254 |
|
$no_gz =~ s/\.gz$//; |
255 |
|
rename $path, $no_gz || confess "can't rename $path -> $no_gz: $!"; |
256 |
|
} |
257 |
|
warn "## truncate( $file $size ) $path [", -s $path, "]\n"; |
258 |
|
return $rv; |
259 |
|
} |
260 |
sub x_utime { return utime($_[1],$_[2],fixup($_[0])) ? 0:-$!; } |
sub x_utime { return utime($_[1],$_[2],fixup($_[0])) ? 0:-$!; } |
261 |
|
|
262 |
sub x_mkdir { my ($name, $perm) = @_; return 0 if mkdir(fixup($name),$perm); return -$!; } |
sub x_mkdir { my ($name, $perm) = @_; return 0 if mkdir(fixup($name),$perm); return -$!; } |
303 |
file_copy( '<', $path, '>:gzip', $dest . '.gz' ); |
file_copy( '<', $path, '>:gzip', $dest . '.gz' ); |
304 |
|
|
305 |
# FIXME add timeout to remove uncompressed version? |
# FIXME add timeout to remove uncompressed version? |
306 |
|
# FIXME leave uncompressed file if smaller than compressed |
307 |
unlink $path || warn "can't remove $path: $!"; |
unlink $path || warn "can't remove $path: $!"; |
308 |
} |
} |
309 |
} else { |
} else { |