Archive-Tar-Builder

 view release on metacpan or  search on metacpan

src/Builder.xs  view on Meta::CPAN

/*
 * Copyright (c) 2019, cPanel, L.L.C.
 * All rights reserved.
 * http://cpanel.net/
 *
 * This is free software; you can redistribute it and/or modify it under the
 * same terms as Perl itself.  See the Perl manual section 'perlartistic' for
 * further information.
 */

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"

#include <sys/types.h>
#include <errno.h>
#include "b_string.h"
#include "b_find.h"
#include "b_error.h"
#include "b_builder.h"

typedef b_builder * Archive__Tar__Builder;

static int user_lookup(SV *cache, uid_t uid, gid_t gid, b_string **user, b_string **group) {
    dSP;
    I32 retc;

    ENTER;
    SAVETMPS;

    /*
     * Prepare the stack for $cache->getpwuid()
     */
    PUSHMARK(SP);
    XPUSHs(cache);
    XPUSHs(sv_2mortal(newSViv(uid)));
    XPUSHs(sv_2mortal(newSViv(gid)));
    PUTBACK;

    retc = call_method("lookup", G_ARRAY);

    SPAGAIN;

    if (retc < 2) {
        goto error_lookup;
    }

    if (retc == 2) {
        size_t len = 0;
        SV *item;
        char *tmp;

        if ((item = POPs) != NULL && SvOK(item)) {
            tmp = SvPV(item, len);

            if ((*group = b_string_new_len(tmp, len)) == NULL) {
                goto error_string_new_group;
            }
        }

        if ((item = POPs) != NULL && SvOK(item)) {
            tmp = SvPV(item, len);

            if ((*user = b_string_new_len(tmp, len)) == NULL) {
                goto error_string_new_user;
            }
        }
    }

    PUTBACK;

    FREETMPS;
    LEAVE;

    return 0;

error_string_new_user:
    b_string_free(*group);

error_string_new_group:

error_lookup:
    PUTBACK;

    FREETMPS;
    LEAVE;

    return -1;
}

static b_string *hardlink_lookup(SV *cache, dev_t dev, ino_t ino, b_string *path) {
    dSP;



( run in 3.207 seconds using v1.01-cache-2.11-cpan-99c4e6809bf )