1
0
Fork 0
mirror of https://github.com/git/git.git synced 2024-11-19 07:24:50 +01:00
git/perl/Git.xs
Petr Baudis 24c4b71436 Git.pm: Swap hash_object() parameters
I'm about to introduce get_object() and it will be better for consistency
if the object type always goes first. And writing 'blob' there explicitly
is not much bother.

Signed-off-by: Petr Baudis <pasky@suse.cz>
Signed-off-by: Junio C Hamano <junkio@cox.net>
2006-07-02 17:14:42 -07:00

146 lines
2.4 KiB
Text

/* By carefully stacking #includes here (even if WE don't really need them)
* we strive to make the thing actually compile. Git header files aren't very
* nice. Perl headers are one of the signs of the coming apocalypse. */
#include <ctype.h>
/* Ok, it hasn't been so bad so far. */
/* libgit interface */
#include "../cache.h"
#include "../exec_cmd.h"
#define die perlyshadow_die__
/* XS and Perl interface */
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
#undef die
static char *
report_xs(const char *prefix, const char *err, va_list params)
{
static char buf[4096];
strcpy(buf, prefix);
vsnprintf(buf + strlen(prefix), 4096 - strlen(prefix), err, params);
return buf;
}
static void NORETURN
die_xs(const char *err, va_list params)
{
char *str;
str = report_xs("fatal: ", err, params);
croak(str);
}
static void
error_xs(const char *err, va_list params)
{
char *str;
str = report_xs("error: ", err, params);
warn(str);
}
MODULE = Git PACKAGE = Git
PROTOTYPES: DISABLE
BOOT:
{
set_error_routine(error_xs);
set_die_routine(die_xs);
}
# /* TODO: xs_call_gate(). See Git.pm. */
const char *
xs_version()
CODE:
{
RETVAL = GIT_VERSION;
}
OUTPUT:
RETVAL
const char *
xs_exec_path()
CODE:
{
RETVAL = git_exec_path();
}
OUTPUT:
RETVAL
void
xs__execv_git_cmd(...)
CODE:
{
const char **argv;
int i;
argv = malloc(sizeof(const char *) * (items + 1));
if (!argv)
croak("malloc failed");
for (i = 0; i < items; i++)
argv[i] = strdup(SvPV_nolen(ST(i)));
argv[i] = NULL;
execv_git_cmd(argv);
for (i = 0; i < items; i++)
if (argv[i])
free((char *) argv[i]);
free((char **) argv);
}
char *
xs_hash_object(type, file)
char *type;
SV *file;
CODE:
{
unsigned char sha1[20];
if (SvTYPE(file) == SVt_RV)
file = SvRV(file);
if (SvTYPE(file) == SVt_PVGV) {
/* Filehandle */
PerlIO *pio;
pio = IoIFP(sv_2io(file));
if (!pio)
croak("You passed me something weird - a dir glob?");
/* XXX: I just hope PerlIO didn't read anything from it yet.
* --pasky */
if (index_pipe(sha1, PerlIO_fileno(pio), type, 0))
croak("Unable to hash given filehandle");
/* Avoid any nasty surprises. */
PerlIO_close(pio);
} else {
/* String */
char *path = SvPV_nolen(file);
int fd = open(path, O_RDONLY);
struct stat st;
if (fd < 0 ||
fstat(fd, &st) < 0 ||
index_fd(sha1, fd, &st, 0, type))
croak("Unable to hash %s", path);
close(fd);
}
RETVAL = sha1_to_hex(sha1);
}
OUTPUT:
RETVAL