1 files changed, 64 insertions, 0 deletions
diff --git a/perl/Git.xs b/perl/Git.xs
new file mode 100644
index 0000000000..1b81ce2441
--- /dev/null
+++ b/perl/Git.xs
@@ -0,0 +1,64 @@
+/* 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"
+
+/* XS and Perl interface */
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include "ppport.h"
+
+
+MODULE = Git		PACKAGE = Git
+
+PROTOTYPES: DISABLE
+
+# /* TODO: xs_call_gate(). See Git.pm. */
+
+char *
+xs_hash_object(file, type = "blob")
+	SV *file;
+	char *type;
+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