aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--Packdrakeng.pm72
1 files changed, 36 insertions, 36 deletions
diff --git a/Packdrakeng.pm b/Packdrakeng.pm
index 23bc9e2..b130e75 100644
--- a/Packdrakeng.pm
+++ b/Packdrakeng.pm
@@ -166,7 +166,7 @@ sub build_toc {
$pack->{need_build_toc} or return 1;
$pack->end_block();
$pack->end_seek() or do {
- warn "Can't seek into archive";
+ $pack->{log}("Can't seek into archive");
return 0;
};
my ($toc_length, $cf, $cd, $cl) = (0, 0, 0, 0);
@@ -174,7 +174,7 @@ sub build_toc {
foreach my $entry (keys %{$pack->{'dir'}}) {
$cd++;
my $w = syswrite($pack->{handle}, $entry . "\n") or do {
- warn "Can't write toc into archive";
+ $pack->{log}("Can't write toc into archive");
return 0;
};
$toc_length += $w;
@@ -182,7 +182,7 @@ sub build_toc {
foreach my $entry (keys %{$pack->{'symlink'}}) {
$cl++;
my $w = syswrite($pack->{handle}, sprintf("%s\n%s\n", $entry, $pack->{'symlink'}{$entry})) or do {
- warn "Can't write toc into archive";
+ $pack->{log}("Can't write toc into archive");
return 0;
};
$toc_length += $w
@@ -190,7 +190,7 @@ sub build_toc {
foreach my $entry (sort keys %{$pack->{files}}) {
$cf++;
my $w = syswrite($pack->{handle}, $entry ."\n") or do {
- warn "Can't write toc into archive";
+ $pack->{log}("Can't write toc into archive");
return 0;
};
$toc_length += $w;
@@ -198,7 +198,7 @@ sub build_toc {
foreach my $file (sort keys %{$pack->{files}}) {
my $entry = $pack->{files}{$file};
syswrite($pack->{handle}, pack('NNNN', $entry->{coff}, $entry->{csize}, $entry->{off}, $entry->{size})) or do {
- warn "Can't write toc into archive";
+ $pack->{log}("Can't write toc into archive");
return 0;
};
}
@@ -208,10 +208,10 @@ sub build_toc {
$toc_length,
$pack->{uncompress_method},
$toc_footer)) or do {
- warn "Can't write toc into archive";
+ $pack->{log}("Can't write toc into archive");
return 0;
};
- 1
+ 1;
}
sub read_toc {
@@ -221,7 +221,7 @@ sub read_toc {
my ($header, $toc_d_count, $toc_l_count, $toc_f_count, $toc_str_size, $uncompress, $trailer) =
unpack("a4NNNNZ40a4", $buf);
$header eq $toc_header && $trailer eq $toc_footer or do {
- warn "Error reading toc: wrong header/trailer";
+ $pack->{log}("Error reading toc: wrong header/trailer");
return 0;
};
@@ -252,7 +252,7 @@ sub read_toc {
$pack->{files}{$f}{coff} + $pack->{files}{$f}{csize} > $pack->{coff} and
$pack->{coff} = $pack->{files}{$f}{coff} + $pack->{files}{$f}{csize};
}
- 1
+ 1;
}
# Goto to the end of written compressed data
@@ -301,7 +301,7 @@ sub extern_compress {
close($hin); # ensure the flush
$pack->{cstream_data}{pid} = CORE::open($hout,
"|$pack->{compress_method} > $pack->{cstream_data}{file_block}") or do {
- warn "Unable to start $pack->{compress_method}";
+ $pack->{log}("Unable to start $pack->{compress_method}");
return 0, 0;
};
$pack->{cstream_data}{hout} = $hout;
@@ -311,7 +311,7 @@ sub extern_compress {
while (my $length = sysread($sourcefh, my $data, $pack->{bufsize})) {
# pushing data to compressor
(my $l = syswrite($hout, $data)) == $length or do {
- warn "can't push all data to compressor";
+ $pack->{log}("can't push all data to compressor");
};
$insize += $l;
$outsize = (stat($pack->{cstream_data}{file_block}))[7];
@@ -321,14 +321,14 @@ sub extern_compress {
close($hout);
waitpid $pack->{cstream_data}{pid}, 0;
sysopen(my $hin, $pack->{cstream_data}{file_block}, O_RDONLY) or do {
- warn "Can't open temp block file";
+ $pack->{log}("Can't open temp block file");
return 0, 0;
};
$outsize = (stat($pack->{cstream_data}{file_block}))[7];
unlink($pack->{cstream_data}{file_block});
while (my $lenght = sysread($hin, my $data, $pack->{bufsize})) {
(my $l = syswrite($pack->{handle}, $data)) == $lenght or do {
- warn "Can't write all data in archive";
+ $pack->{log}("Can't write all data in archive");
};
}
close($hin);
@@ -349,14 +349,14 @@ sub extern_uncompress {
$cread + $pack->{bufsize} > $fileinfo->{csize} ?
$fileinfo->{csize} - $cread :
$pack->{bufsize}) or do {
- warn("Enexpected end of file");
+ $pack->{log}("Unexpected end of file");
close($tempfh);
unlink($tempname);
return -1;
};
$cread += $cl;
syswrite($tempfh, $data) == length($data) or do {
- warn "Can't write all data into temp file";
+ $pack->{log}("Can't write all data into temp file");
close($tempfh);
unlink($tempname);
return -1;
@@ -365,7 +365,7 @@ sub extern_uncompress {
close($tempfh);
CORE::open(my $hc, "cat '$tempname' | $pack->{uncompress_method} |") or do {
- warn "Can't start $pack->{uncompress_method} to uncompress data";
+ $pack->{log}("Can't start $pack->{uncompress_method} to uncompress data");
unlink($tempname);
return -1;
};
@@ -376,7 +376,7 @@ sub extern_uncompress {
while ($byteswritten < $fileinfo->{size}) {
my $length = sysread($hc, my $data, $pack->{bufsize}) or do {
- warn "unexpected end of stream $tempname";
+ $pack->{log}("unexpected end of stream $tempname");
#unlink($tempname);
close($hc);
return -1;
@@ -391,7 +391,7 @@ sub extern_uncompress {
my $bw = $byteswritten + length($data) > $fileinfo->{size} ? $fileinfo->{size} - $byteswritten : length($data);
syswrite($destfh, $data, $bw) == $bw or do {
- warn "Can't write data into dest";
+ $pack->{log}("Can't write data into dest");
return -1;
};
$byteswritten += $bw;
@@ -412,19 +412,19 @@ sub extract_block {
my ($pack, $dest, $file) = @_;
sysopen(my $handle, $dest, O_WRONLY | O_TRUNC | O_CREAT) or do {
- warn "Can't open $dest";
+ $pack->{log}("Can't open $dest");
return -1;
};
sysseek($pack->{handle}, $pack->{files}{$file}->{coff}, 0) == $pack->{files}{$file}->{coff} or do {
- warn("Can't seek to offset $pack->{files}{$file}->{coff}");
+ $pack->{log}("Can't seek to offset $pack->{files}{$file}->{coff}");
close($handle);
return -1;
};
{
my $l;
- $l = sysread($pack->{handle}, my $buf, $pack->{files}{$file}->{csize}) == $pack->{files}{$file}->{csize} or warn "Read only $l / $pack->{files}{$file}->{csize} bytes";
+ $l = sysread($pack->{handle}, my $buf, $pack->{files}{$file}->{csize}) == $pack->{files}{$file}->{csize} or $pack->{log}("Read only $l / $pack->{files}{$file}->{csize} bytes");
syswrite($handle, $buf);
}
@@ -460,7 +460,7 @@ sub add_virtual {
$type eq 'f' and do {
# Be sure we are at the end, allow extract + add in only one instance
$pack->end_seek() or do {
- warn("Can't seek to offset $pack->{coff}");
+ $pack->{log}("Can't seek to offset $pack->{coff}");
next;
};
@@ -503,23 +503,23 @@ sub add {
};
-f $srcfile and do {
sysopen(my $htocompress, $srcfile, O_RDONLY) or do {
- warn "Can't add $srcfile: $!";
+ $pack->{log}("Can't add $srcfile: $!");
next;
};
$pack->add_virtual('f', $file, $htocompress);
close($htocompress);
next;
};
- warn "Can't pack $srcfile";
+ $pack->{log}("Can't pack $srcfile");
}
- 1
+ 1;
}
sub extract_virtual {
my ($pack, $destfh, $filename) = @_;
defined($pack->{files}{$filename}) or return -1;
sysseek($pack->{handle}, $pack->{files}{$filename}->{coff}, 0) == $pack->{files}{$filename}->{coff} or do {
- warn("Can't seek to offset $pack->{files}{$filename}->{coff}");
+ $pack->{log}("Can't seek to offset $pack->{files}{$filename}->{coff}");
return -1;
};
my $m = $pack->{subuncompress};
@@ -533,39 +533,39 @@ sub extract {
my ($dir) = $dest =~ m!(.*)/.*!;
if (exists($pack->{dir}{$f})) {
-d $dest || mkpath($dest)
- or warn "Unable to create dir $dest: $!";
+ or $pack->{log}("Unable to create dir $dest: $!");
next;
} elsif (exists($pack->{'symlink'}{$f})) {
-d $dir || mkpath($dir) or
- warn "Unable to create dir $dest: $!";
+ $pack->{log}("Unable to create dir $dest: $!");
-l $dest and unlink $dest;
symlink($pack->{'symlink'}{$f}, $dest)
- or warn "Unable to extract symlink $f: $!";
+ or $pack->{log}("Unable to extract symlink $f: $!");
next;
} elsif (exists($pack->{files}{$f})) {
-d $dir || mkpath($dir) or do {
- warn "Unable to create dir $dir";
+ $pack->{log}("Unable to create dir $dir");
};
if (-l $dest) {
unlink($dest) or do {
- warn "Can't remove link $dest: $!";
+ $pack->{log}("Can't remove link $dest: $!");
next; # Don't overwrite a file because where the symlink point to
};
}
sysopen(my $destfh, $dest, O_CREAT | O_TRUNC | O_WRONLY)
or do {
- warn "Unable to extract $dest";
+ $pack->{log}("Unable to extract $dest");
next;
};
my $written = $pack->extract_virtual($destfh, $f);
- $written == -1 and warn "Unable to extract file $f";
+ $written == -1 and $pack->{log}("Unable to extract file $f");
close($destfh);
next;
} else {
- warn "Can't find $f in archive";
+ $pack->{log}("Can't find $f in archive");
}
}
- 1
+ 1;
}
# Return \@dir, \@files, \@symlink list
@@ -609,7 +609,7 @@ sub dumptoc {
}
}
-1
+1;
__END__