Archive-Libarchive-XS

 view release on metacpan or  search on metacpan

lib/Archive/Libarchive/XS.xs  view on Meta::CPAN

{
  struct lookup_callback_data *data = (struct lookup_callback_data *)d;

  if(data->cleanup_callback != NULL)
  {
    dSP;
    ENTER;
    SAVETMPS;
    PUSHMARK(SP);
    if(data->perl_data == NULL)
      XPUSHs(&PL_sv_undef);
    else
      XPUSHs(data->perl_data);
    PUTBACK;

    call_sv(data->cleanup_callback, G_DISCARD|G_VOID);
  }

  if(data->perl_data != NULL)
    SvREFCNT_dec(data->perl_data);
  if(data->lookup_callback != NULL)
    SvREFCNT_dec(data->lookup_callback);
  if(data->cleanup_callback != NULL)
    SvREFCNT_dec(data->cleanup_callback);
  if(data->value != NULL)
    Safefree(data->value);

  Safefree(data);
}

static struct lookup_callback_data *
new_lookup_callback(SV *data, SV *lookup_callback, SV* cleanup_callback)
{
  struct lookup_callback_data *c_data = NULL;
  Newx(c_data, 1, struct lookup_callback_data);
  c_data->perl_data        = SvOK(data) ? SvREFCNT_inc(data) : NULL;
  c_data->lookup_callback  = SvOK(lookup_callback) ? SvREFCNT_inc(lookup_callback) : NULL;
  c_data->cleanup_callback = SvOK(cleanup_callback) ? SvREFCNT_inc(cleanup_callback) : NULL;
  c_data->value            = NULL;
  return c_data;
}

MODULE = Archive::Libarchive::XS   PACKAGE = Archive::Libarchive::XS

BOOT:
     PERL_MATH_INT64_LOAD_OR_CROAK;

=head2 archive_read_data_into_fh

 my $status = archive_read_data_into_fh($archive, $fh);

A convenience function that repeatedly calls L<#archive_read_data_block> to copy the entire entry to the provided file handle.

=head2 archive_write_disk_set_group_lookup

 my $status = archive_write_disk_set_group_lookup($archive, $data, $lookup_callback, $cleanup_callback);

Register a callback for the lookup of group names from group id numbers.  In order to deregister
call C<archive_write_disk_set_group_lookup> with both callback functions set to C<undef>.

See L<Archive::Libarchive::XS::Callback> for calling conventions for the lookup and cleanup callbacks.

=cut

#if HAS_archive_write_disk_set_group_lookup

int
archive_write_disk_set_group_lookup(archive, data, lookup_callback, cleanup_callback)
    struct archive *archive
    SV *data
    SV *lookup_callback
    SV *cleanup_callback
  CODE:
    if(SvOK(cleanup_callback) || SvOK(lookup_callback))
      RETVAL = archive_write_disk_set_group_lookup(archive, new_lookup_callback(data,lookup_callback,cleanup_callback), &mylookup_write_lookup, &mylookup_cleanup);
    else
      RETVAL = archive_write_disk_set_group_lookup(archive, NULL, NULL, NULL);
  OUTPUT:
    RETVAL

#endif

=head2 archive_read_disk_set_gname_lookup

 my $status = archive_read_disk_set_gname_lookup($archive, $data, $lookup_callback, $cleanup_callback);

Register a callback for the lookup of GID from group names.  In order to deregister call
C<archive_read_disk_set_gname_lookup> with both callback functions set to C<undef>.

See L<Archive::Libarchive::XS::Callback> for calling conventions for the lookup and cleanup callbacks.

=cut

#if HAS_archive_read_disk_set_gname_lookup

int
archive_read_disk_set_gname_lookup(archive, data, lookup_callback, cleanup_callback)
    struct archive *archive
    SV *data
    SV *lookup_callback
    SV *cleanup_callback
  CODE:
    if(SvOK(cleanup_callback) || SvOK(lookup_callback))
      RETVAL = archive_read_disk_set_gname_lookup(archive, new_lookup_callback(data,lookup_callback,cleanup_callback), &mylookup_read_lookup, &mylookup_cleanup);
    else
      RETVAL = archive_read_disk_set_gname_lookup(archive, NULL, NULL, NULL);
  OUTPUT:
    RETVAL


#endif

=head2 archive_read_disk_set_uname_lookup

 my $status = archive_read_disk_set_uname_lookup($archive, $data, $lookup_callback, $cleanup_callback);

Register a callback for the lookup of UID from user names.  In order to deregister call
C<archive_read_disk_setugname_lookup> with both callback functions set to C<undef>.

See L<Archive::Libarchive::XS::Callback> for calling conventions for the lookup and cleanup callbacks.

=cut

#if HAS_archive_read_disk_set_uname_lookup

int
archive_read_disk_set_uname_lookup(archive, data, lookup_callback, cleanup_callback)
    struct archive *archive
    SV *data
    SV *lookup_callback
    SV *cleanup_callback
  CODE:
    if(SvOK(cleanup_callback) || SvOK(lookup_callback))
      RETVAL = archive_read_disk_set_uname_lookup(archive, new_lookup_callback(data,lookup_callback,cleanup_callback), &mylookup_read_lookup, &mylookup_cleanup);
    else
      RETVAL = archive_read_disk_set_uname_lookup(archive, NULL, NULL, NULL);
  OUTPUT:
    RETVAL


#endif

=head2 archive_write_disk_set_user_lookup

 my $status = archive_write_disk_set_user_lookup($archive, $data, $lookup_callback, $cleanup_callback);

Register a callback for the lookup of user names from user id numbers.  In order to deregister
call C<archive_write_disk_set_user_lookup> with both callback functions set to C<undef>.

See L<Archive::Libarchive::XS::Callback> for calling conventions for the lookup and cleanup callbacks.

=cut

#if HAS_archive_write_disk_set_user_lookup

int
archive_write_disk_set_user_lookup(archive, data, lookup_callback, cleanup_callback)
    struct archive *archive
    SV *data
    SV *lookup_callback
    SV *cleanup_callback
  CODE:
    if(SvOK(cleanup_callback) || SvOK(lookup_callback))
      RETVAL = archive_write_disk_set_user_lookup(archive, new_lookup_callback(data,lookup_callback,cleanup_callback), &mylookup_write_lookup, &mylookup_cleanup);
    else
      RETVAL = archive_write_disk_set_user_lookup(archive, NULL, NULL, NULL);
  OUTPUT:
    RETVAL

#endif

=head2 archive_entry_stat

 my($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $atime, $mtime, $ctime) = archive_entry_stat($entry);

Converts the various fields stored in the archive entry to the format used by L<stat|perlfunc#stat>.

The fields C<$blksize>, C<$blocks> supported by L<stat|perlfunc#stat>, are not supported by this function.

=head2 archive_entry_set_stat

 my $status = archive_entry_stat($entry, $dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $atime, $mtime, $ctime);

Converts the various fields in the format used by L<stat|perlfunc#stat> to the fields store in the archive entry.

The fields C<$blksize>, C<$blocks> supported by L<stat|perlfunc#stat>, are not supported by this function.

=head2 archive_entry_copy_stat

 my $status = archive_entry_stat($entry, $dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $atime, $mtime, $ctime);

Converts the various fields in the format used by L<stat|perlfunc#stat> to the fields store in the archive entry.

The fields C<$blksize>, C<$blocks> supported by L<stat|perlfunc#stat>, are not supported by this function.

This is an alias for L<#archive_entry_set_stat>.

=head2 archive_read_open_fh

 my $status = archive_read_open_fh($archive, $fh, $block_size);

Like L<#archive_read_open_filename>, except that it accepts a file handle and block
size rather than a filename.  Note that the file handle will not be automatically
closed at end-of-archive.

If not specified, a block size of 10240 will be used.

There is no corresponding archive_read_open_fh in the C version of libarchive.
This is provided in the place of C<archive_read_open_FILE> and C<archive_read_open_fd>,
which are not in the Perl bindings for libarchive.

lib/Archive/Libarchive/XS.xs  view on Meta::CPAN

 my $status = archive_write_free($archive);

Invokes C<archive_write_close> if it was not invoked manually, then
release all resources.

=cut

int
_archive_write_free(archive)
    struct archive *archive
  CODE:
    RETVAL = archive_write_free(archive);
  OUTPUT:
    RETVAL

=head2 archive_write_add_filter

 my $status = archive_write_add_filter($archive, $code);

A convenience function to set the filter based on the code.

=cut

#if HAS_archive_write_add_filter

int
archive_write_add_filter(archive, code)
    struct archive *archive
    int code

#endif

=head2 archive_write_add_filter_by_name

 my $status = archive_write_add_filter_by_name($archive, $name);

A convenience function to set the filter based on the name.

=cut

#if HAS_archive_write_add_filter_by_name

int
_archive_write_add_filter_by_name(archive, name)
    struct archive *archive
    const char *name
  CODE:
    RETVAL = archive_write_add_filter_by_name(archive, name);
  OUTPUT:
    RETVAL

#endif

=head2 archive_write_add_filter_program

 my $status = archive_write_add_filter_program($archive, $cmd);

The archive will be fed into the specified compression program.
The output of that program is blocked and written to the client
write callbacks.

=cut

#if HAS_archive_write_add_filter_program

int
_archive_write_add_filter_program(archive, cmd)
    struct archive *archive
    const char *cmd
  CODE:
    RETVAL = archive_write_add_filter_program(archive, cmd);
  OUTPUT:
    RETVAL

#endif

=head2 archive_write_set_format

 my $status = archive_write_set_format($archive, $code);

A convenience function to set the format based on the code.

=cut

int
archive_write_set_format(archive, code)
    struct archive *archive
    int code

=head2 archive_write_set_format_by_name

 my $status = archive_write_set_format_by_name($archive, $name);

A convenience function to set the format based on the name.

=cut

int
_archive_write_set_format_by_name(archive, name)
    struct archive *archive
    const char *name
  CODE:
    RETVAL = archive_write_set_format_by_name(archive, name);
  OUTPUT:
    RETVAL

=head2 archive_write_open_filename

 my $status = archive_write_open_filename($archive, $filename);

A convenience form of C<archive_write_open> that accepts a filename.  If you have
not invoked C<archive_write_set_bytes_in_last_block>, then
C<archive_write_open_filename> will adjust the last-block padding depending on the
file: it will enable padding when writing to standard output or to a character or
block device node, it will disable padding otherwise.  You can override this by
manually invoking C<archive_write_set_bytes_in_last_block> before C<calling
archive_write_open>.  The C<archive_write_open_filename> function is safe for use
with tape drives or other block-oriented devices.

If you pass in C<undef> as the C<$filename>, libarchive will write the

lib/Archive/Libarchive/XS.xs  view on Meta::CPAN

      archive,
      SvOK(callback) ? myskip : NULL
    );
  OUTPUT:
    RETVAL

#endif

=head2 archive_read_set_close_callback

 my $status = archive_read_set_close_callback($archive, $callback);

Set the close callback for the archive object.

=cut

#if HAS_archive_read_set_close_callback

int
_archive_read_set_close_callback(archive, callback)
    struct archive *archive
    SV *callback
  CODE:
    RETVAL = archive_read_set_close_callback(
      archive,
      SvOK(callback) ? myclose : NULL
    );
  OUTPUT:
    RETVAL

#endif

=head2 archive_read_set_seek_callback

 my $status = archive_read_set_seek_callback($archive, $callback);

Set the seek callback for the archive object.

=cut

#if HAS_archive_read_set_seek_callback

int
_archive_read_set_seek_callback(archive, callback)
    struct archive *archive
    SV *callback
  CODE:
    RETVAL = archive_read_set_seek_callback(
      archive,
      SvOK(callback) ? myseek : NULL
    );
  OUTPUT:
    RETVAL

#endif

=head2 archive_read_set_callback_data

 my $status = archive_read_set_callback_data($archive, $data);

Set the client data for callbacks.

=cut

#if HAS_archive_read_set_callback_data

int
_archive_read_set_callback_data(archive, data)
    struct archive *archive
    void *data
  CODE:
    /*
     * note: this isn't actually used as it is implemented
     * at the Perl level
     */
    RETVAL = archive_read_set_callback_data(archive, data);
  OUTPUT:
    RETVAL

#endif

=head2 archive_read_open1

 my $status = archive_read_open1($archive);

Opening freezes the callbacks.

=cut

#if HAS_archive_read_open1

int
archive_read_open1(archive)
    struct archive *archive

#endif

=head2 archive_read_next_header2

 my $status = archive_read_next_header2($archive, $entry);

Read the header for the next entry and populate the provided entry object.

=cut

#if HAS_archive_read_next_header2

int
archive_read_next_header2(archive, entry)
    struct archive *archive
    struct archive_entry *entry

#endif

=head2 archive_entry_atime_is_set

 my $bool = archive_entry_atime_is_set($entry);

Returns true if the access time property has been set on the archive entry.

=cut

#if HAS_archive_entry_atime_is_set

int
archive_entry_atime_is_set(entry)
    struct archive_entry *entry

#endif

=head2 archive_entry_mtime_is_set

 my $bool = archive_entry_mtime_is_set($entry);

Returns true if the mtime (modify time) property has been set on the archive entry.

=cut

#if HAS_archive_entry_mtime_is_set

int
archive_entry_mtime_is_set(entry)
    struct archive_entry *entry

#endif

lib/Archive/Libarchive/XS.xs  view on Meta::CPAN

      sv_setsv(entry1, &PL_sv_undef);
    else
      sv_setiv(entry1, PTR2IV(e1));
    if(e2 == NULL)
      sv_setsv(entry2, &PL_sv_undef);
    else
      sv_setiv(entry2, PTR2IV(e2));
    RETVAL = ARCHIVE_OK;

  OUTPUT:
    RETVAL
    entry1
    entry2

#endif

=head2 archive_entry_uid

 my $uid = archive_entry_uid($entry);

Get the UID (user id) property for the archive entry.

=cut

#if HAS_archive_entry_uid

__LA_INT64_T
archive_entry_uid(entry)
    struct archive_entry *entry

#endif

=head2 archive_entry_set_uid

 my $status = archive_entry_set_uid($entry, $uid);

Set the UID (user id) property for the archive entry.

=cut

#if HAS_archive_entry_set_uid

int
archive_entry_set_uid(entry, uid)
    struct archive_entry *entry
    __LA_INT64_T uid
  CODE:
    archive_entry_set_uid(entry, uid);
    RETVAL = ARCHIVE_OK;
  OUTPUT:
    RETVAL

#endif

=head2 archive_set_error

 my $status = archive_set_error($archive, $errno, $format, @args);

Sets the numeric error code and error description that will be returned by
L<#archive_errno> and L<#archive_error_string>.  This function should be
used within I/O callbacks to set system-specific error codes and error
descriptions.  This function accepts a printf-like format string and
arguments (via perl's L<sprintf|perlfunc#sprintf>.

=cut

#if HAS_archive_set_error

int
_archive_set_error(archive, status, string)
    struct archive *archive
    int status
    const char *string
  CODE:
    archive_set_error(archive, status, "%s", string);
    RETVAL = ARCHIVE_OK;
  OUTPUT:
    RETVAL

#endif

=head2 archive_entry_strmode

 my $strmode = archive_entry_strmode($entry);

Returns a string representation of the archive entry's permission mode,
a la the Unix C<ls> command (example: a mode of C<0644> should come back
as C<-rw-r--r-->.

=cut

#if HAS_archive_entry_strmode

string_or_null
archive_entry_strmode(entry)
    struct archive_entry *entry

#endif

=head2 archive_read_extract_set_skip_file

 my $status = archive_read_extract_set_skip_file($archive, $dev, $ino);

Record the dev/ino of a file that will not be written.  This is
generally set to the dev/ino of the archive being read.

=cut

#if HAS_archive_read_extract_set_skip_file

int
archive_read_extract_set_skip_file(archive, dev, ino)
    struct archive *archive
    __LA_INT64_T dev
    __LA_INT64_T ino
  CODE:
    archive_read_extract_set_skip_file(archive, dev, ino);
    RETVAL = ARCHIVE_OK;
  OUTPUT:
    RETVAL