From d97ce2e06c50ce30882d3482dfaefa14e52b309f Mon Sep 17 00:00:00 2001
From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Thu, 13 Aug 2009 15:00:59 +0100
Subject: [PATCH] source.tar.gz source download

---
 yarrg/CommodsWeb.pm     | 14 ++++++++++++--
 yarrg/web/source.tar.gz | 35 +++++++++++++++++++++++++++++++++++
 2 files changed, 47 insertions(+), 2 deletions(-)
 create mode 100644 yarrg/web/source.tar.gz

diff --git a/yarrg/CommodsWeb.pm b/yarrg/CommodsWeb.pm
index 5e1520e..f82e09c 100644
--- a/yarrg/CommodsWeb.pm
+++ b/yarrg/CommodsWeb.pm
@@ -43,20 +43,30 @@ BEGIN {
     our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
     $VERSION     = 1.00;
     @ISA         = qw(Exporter);
-    @EXPORT      = qw(&dbw_connect &ocean_list);
+    @EXPORT      = qw(&dbw_connect &ocean_list $sourcebasedir);
     %EXPORT_TAGS = ( );
 
     @EXPORT_OK   = qw();
 }
 
 our $datadir='.';
+our $sourcebasedir;
 
 for my $dir (@INC) {
     if ($dir =~ m/\.perl-lib$/) {
-	$datadir= "$dir/DATA";
+	$sourcebasedir= "$dir/..";
+	if (stat "$dir/DATA") {
+	    $datadir= "$dir/DATA";
+	} elsif ($!==&ENOENT) {
+	    $datadir= "$dir";
+	} else {
+	    die "stat $dir/DATA $!";
+	}
 	last;
     }
 }
+defined $sourcebasedir or
+    die "no source base dir in @INC";
 
 my @ocean_list;
 
diff --git a/yarrg/web/source.tar.gz b/yarrg/web/source.tar.gz
new file mode 100644
index 0000000..0efb98b
--- /dev/null
+++ b/yarrg/web/source.tar.gz
@@ -0,0 +1,35 @@
+<%perl>
+use IO::Pipe;
+use CommodsWeb;
+
+$r->content_type('application/octet-stream');
+$m->flush_buffer();
+
+$ENV{'YPPSC_YARRG_SRCBASE'}= $sourcebasedir;
+my $pipe= new IO::Pipe or die $!;
+my $pid= fork();  defined $pid or die $!;
+if (!$pid) {
+	$pipe->writer();
+	exec '/bin/sh','-c','
+		cd -P "$YPPSC_YARRG_SRCBASE"
+		(
+		 git-ls-files -z;
+		 if test -d .git; then find .git -print0; fi
+		) | cpio -Hustar -o --quiet -0 -R 1000:1000
+	';
+	die $!;
+}
+$pipe->reader();
+
+my ($d, $l);
+while ($l= read $pipe, $d, 65536) {
+	print $d;
+	$m->flush_buffer();
+}
+waitpid $pid,0;
+defined $l or die "read pipe $!";
+$pipe->error and die "pipe error $!";
+close $pipe;
+# deliberately ignore errors
+
+</%perl>
-- 
2.30.2