From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Thu, 13 Aug 2009 14:00:59 +0000 (+0100)
Subject: source.tar.gz source download
X-Git-Tag: 3.4~205
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.db-live.git;a=commitdiff_plain;h=d97ce2e06c50ce30882d3482dfaefa14e52b309f

source.tar.gz source download
---

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>