Andrew's git - gitweb.git/blob

   1/* By carefully stacking #includes here (even if WE don't really need them)
   2 * we strive to make the thing actually compile. Git header files aren't very
   3 * nice. Perl headers are one of the signs of the coming apocalypse. */
   4#include <ctype.h>
   5/* Ok, it hasn't been so bad so far. */
   6
   7/* libgit interface */
   8#include "../cache.h"
   9#include "../exec_cmd.h"
  10
  11#define die perlyshadow_die__
  12
  13/* XS and Perl interface */
  14#include "EXTERN.h"
  15#include "perl.h"
  16#include "XSUB.h"
  17
  18#include "ppport.h"
  19
  20#undef die
  21
  22
  23static char *
  24report_xs(const char *prefix, const char *err, va_list params)
  25{
  26        static char buf[4096];
  27        strcpy(buf, prefix);
  28        vsnprintf(buf + strlen(prefix), 4096 - strlen(prefix), err, params);
  29        return buf;
  30}
  31
  32static void NORETURN
  33die_xs(const char *err, va_list params)
  34{
  35        char *str;
  36        str = report_xs("fatal: ", err, params);
  37        croak(str);
  38}
  39
  40static void
  41error_xs(const char *err, va_list params)
  42{
  43        char *str;
  44        str = report_xs("error: ", err, params);
  45        warn(str);
  46}
  47
  48
  49MODULE = Git            PACKAGE = Git
  50
  51PROTOTYPES: DISABLE
  52
  53
  54BOOT:
  55{
  56        set_error_routine(error_xs);
  57        set_die_routine(die_xs);
  58}
  59
  60
  61# /* TODO: xs_call_gate(). See Git.pm. */
  62
  63
  64const char *
  65xs_version()
  66CODE:
  67{
  68        RETVAL = GIT_VERSION;
  69}
  70OUTPUT:
  71        RETVAL
  72
  73
  74const char *
  75xs_exec_path()
  76CODE:
  77{
  78        RETVAL = git_exec_path();
  79}
  80OUTPUT:
  81        RETVAL
  82
  83
  84void
  85xs__execv_git_cmd(...)
  86CODE:
  87{
  88        const char **argv;
  89        int i;
  90
  91        argv = malloc(sizeof(const char *) * (items + 1));
  92        if (!argv)
  93                croak("malloc failed");
  94        for (i = 0; i < items; i++)
  95                argv[i] = strdup(SvPV_nolen(ST(i)));
  96        argv[i] = NULL;
  97
  98        execv_git_cmd(argv);
  99
 100        for (i = 0; i < items; i++)
 101                if (argv[i])
 102                        free((char *) argv[i]);
 103        free((char **) argv);
 104}
 105
 106char *
 107xs_hash_object(type, file)
 108        char *type;
 109        SV *file;
 110CODE:
 111{
 112        unsigned char sha1[20];
 113
 114        if (SvTYPE(file) == SVt_RV)
 115                file = SvRV(file);
 116
 117        if (SvTYPE(file) == SVt_PVGV) {
 118                /* Filehandle */
 119                PerlIO *pio;
 120
 121                pio = IoIFP(sv_2io(file));
 122                if (!pio)
 123                        croak("You passed me something weird - a dir glob?");
 124                /* XXX: I just hope PerlIO didn't read anything from it yet.
 125                 * --pasky */
 126                if (index_pipe(sha1, PerlIO_fileno(pio), type, 0))
 127                        croak("Unable to hash given filehandle");
 128                /* Avoid any nasty surprises. */
 129                PerlIO_close(pio);
 130
 131        } else {
 132                /* String */
 133                char *path = SvPV_nolen(file);
 134                int fd = open(path, O_RDONLY);
 135                struct stat st;
 136
 137                if (fd < 0 ||
 138                    fstat(fd, &st) < 0 ||
 139                    index_fd(sha1, fd, &st, 0, type))
 140                        croak("Unable to hash %s", path);
 141                close(fd);
 142        }
 143        RETVAL = sha1_to_hex(sha1);
 144}
 145OUTPUT:
 146        RETVAL