chiark / gitweb /
source.tar.gz source download
authorIan Jackson <ijackson@chiark.greenend.org.uk>
Thu, 13 Aug 2009 14:00:59 +0000 (15:00 +0100)
committerIan Jackson <ijackson@chiark.greenend.org.uk>
Thu, 13 Aug 2009 14:00:59 +0000 (15:00 +0100)
yarrg/CommodsWeb.pm
yarrg/web/source.tar.gz [new file with mode: 0644]

index 5e1520e22f45a3e0d3853f53e6523f1b370e6e5c..f82e09cb2de18fad2d1ec7db7a195516b9e4c264 100644 (file)
@@ -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 (file)
index 0000000..0efb98b
--- /dev/null
@@ -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>