Introduce Git.pm (v4)
[git/dscho.git] / perl / Git.xs
blob1b81ce244113dd72620e532b26bd0c6b6797f640
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. */
7 /* libgit interface */
8 #include "../cache.h"
10 /* XS and Perl interface */
11 #include "EXTERN.h"
12 #include "perl.h"
13 #include "XSUB.h"
15 #include "ppport.h"
18 MODULE = Git            PACKAGE = Git
20 PROTOTYPES: DISABLE
22 # /* TODO: xs_call_gate(). See Git.pm. */
24 char *
25 xs_hash_object(file, type = "blob")
26         SV *file;
27         char *type;
28 CODE:
30         unsigned char sha1[20];
32         if (SvTYPE(file) == SVt_RV)
33                 file = SvRV(file);
35         if (SvTYPE(file) == SVt_PVGV) {
36                 /* Filehandle */
37                 PerlIO *pio;
39                 pio = IoIFP(sv_2io(file));
40                 if (!pio)
41                         croak("You passed me something weird - a dir glob?");
42                 /* XXX: I just hope PerlIO didn't read anything from it yet.
43                  * --pasky */
44                 if (index_pipe(sha1, PerlIO_fileno(pio), type, 0))
45                         croak("Unable to hash given filehandle");
46                 /* Avoid any nasty surprises. */
47                 PerlIO_close(pio);
49         } else {
50                 /* String */
51                 char *path = SvPV_nolen(file);
52                 int fd = open(path, O_RDONLY);
53                 struct stat st;
55                 if (fd < 0 ||
56                     fstat(fd, &st) < 0 ||
57                     index_fd(sha1, fd, &st, 0, type))
58                         croak("Unable to hash %s", path);
59                 close(fd);
60         }
61         RETVAL = sha1_to_hex(sha1);
63 OUTPUT:
64         RETVAL