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
  32void
  33die_xs(const char *err, va_list params)
  34{
  35        char *str;
  36        str = report_xs("fatal: ", err, params);
  37        croak(str);
  38}
  39
  40int
  41error_xs(const char *err, va_list params)
  42{
  43        char *str;
  44        str = report_xs("error: ", err, params);
  45        warn(str);
  46        return -1;
  47}
  48
  49
  50MODULE = Git            PACKAGE = Git
  51
  52PROTOTYPES: DISABLE
  53
  54
  55BOOT:
  56{
  57        set_error_routine(error_xs);
  58        set_die_routine(die_xs);
  59}
  60
  61
  62# /* TODO: xs_call_gate(). See Git.pm. */
  63
  64
  65const char *
  66xs_version()
  67CODE:
  68{
  69        RETVAL = GIT_VERSION;
  70}
  71OUTPUT:
  72        RETVAL
  73
  74
  75const char *
  76xs_exec_path()
  77CODE:
  78{
  79        RETVAL = git_exec_path();
  80}
  81OUTPUT:
  82        RETVAL
  83
  84
  85void
  86xs__execv_git_cmd(...)
  87CODE:
  88{
  89        const char **argv;
  90        int i;
  91
  92        argv = malloc(sizeof(const char *) * (items + 1));
  93        if (!argv)
  94                croak("malloc failed");
  95        for (i = 0; i < items; i++)
  96                argv[i] = strdup(SvPV_nolen(ST(i)));
  97        argv[i] = NULL;
  98
  99        execv_git_cmd(argv);
 100
 101        for (i = 0; i < items; i++)
 102                if (argv[i])
 103                        free((char *) argv[i]);
 104        free((char **) argv);
 105}
 106
 107char *
 108xs_hash_object(file, type = "blob")
 109        SV *file;
 110        char *type;
 111CODE:
 112{
 113        unsigned char sha1[20];
 114
 115        if (SvTYPE(file) == SVt_RV)
 116                file = SvRV(file);
 117
 118        if (SvTYPE(file) == SVt_PVGV) {
 119                /* Filehandle */
 120                PerlIO *pio;
 121
 122                pio = IoIFP(sv_2io(file));
 123                if (!pio)
 124                        croak("You passed me something weird - a dir glob?");
 125                /* XXX: I just hope PerlIO didn't read anything from it yet.
 126                 * --pasky */
 127                if (index_pipe(sha1, PerlIO_fileno(pio), type, 0))
 128                        croak("Unable to hash given filehandle");
 129                /* Avoid any nasty surprises. */
 130                PerlIO_close(pio);
 131
 132        } else {
 133                /* String */
 134                char *path = SvPV_nolen(file);
 135                int fd = open(path, O_RDONLY);
 136                struct stat st;
 137
 138                if (fd < 0 ||
 139                    fstat(fd, &st) < 0 ||
 140                    index_fd(sha1, fd, &st, 0, type))
 141                        croak("Unable to hash %s", path);
 142                close(fd);
 143        }
 144        RETVAL = sha1_to_hex(sha1);
 145}
 146OUTPUT:
 147        RETVAL