my
$filename
=
shift
@ARGV
;
unless
(
defined
$filename
)
{
warn
"reading archive from standard in"
;
}
my
$r
;
my
$flags
= ARCHIVE_EXTRACT_TIME
| ARCHIVE_EXTRACT_PERM
| ARCHIVE_EXTRACT_ACL
| ARCHIVE_EXTRACT_FFLAGS;
my
$a
= archive_read_new();
archive_read_support_filter_all(
$a
);
archive_read_support_format_all(
$a
);
my
$ext
= archive_write_disk_new();
archive_write_disk_set_options(
$ext
,
$flags
);
archive_write_disk_set_standard_lookup(
$ext
);
$r
= archive_read_open_filename(
$a
,
$filename
, 10240);
if
(
$r
!= ARCHIVE_OK)
{
die
"error opening $filename: "
, archive_error_string(
$a
);
}
while
(1)
{
$r
= archive_read_next_header(
$a
,
my
$entry
);
if
(
$r
== ARCHIVE_EOF)
{
last
;
}
if
(
$r
!= ARCHIVE_OK)
{
print
archive_error_string(
$a
),
"\n"
;
}
if
(
$r
< ARCHIVE_WARN)
{
exit
1;
}
$r
= archive_write_header(
$ext
,
$entry
);
if
(
$r
!= ARCHIVE_OK)
{
print
archive_error_string(
$ext
),
"\n"
;
}
elsif
(archive_entry_size(
$entry
) > 0)
{
copy_data(
$a
,
$ext
);
}
}
archive_read_close(
$a
);
archive_read_free(
$a
);
archive_write_close(
$ext
);
archive_write_free(
$ext
);
sub
copy_data
{
my
(
$ar
,
$aw
) =
@_
;
my
$r
;
while
(1)
{
$r
= archive_read_data_block(
$ar
,
my
$buff
,
my
$offset
);
if
(
$r
== ARCHIVE_EOF)
{
return
;
}
if
(
$r
!= ARCHIVE_OK)
{
die
archive_error_string(
$ar
),
"\n"
;
}
$r
= archive_write_data_block(
$aw
,
$buff
,
$offset
);
if
(
$r
!= ARCHIVE_OK)
{
die
archive_error_string(
$aw
),
"\n"
;
}
}
}