Skip to content


Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 4eb81ef279
Fetching contributors…

Cannot retrieve contributors at this time

executable file 80 lines (67 sloc) 2.386 kb
use strict;
use warnings;
use File::Path;
use Cwd;
# This is a quick and dirty snapshot generator for the web page
# to use to generate the snapshot files. Yes it is ugly and contains hard coded crap
# and could use some love. But for this todo I am out of time now. -- Yves
use POSIX qw(strftime);
sub isotime { strftime "%Y-%m-%d.%H:%M:%S",gmtime(shift||time) }
my ($abbr,$sha1,$tstamp);
$sha1= shift || "HEAD";
my $zip_root= $ENV{PERL_SNAPSHOT_ZIP_ROOT} || "/gitcommon/snapshot/tgz";
my $gitdir= shift || `git rev-parse --git-dir`
or die "Not a git repo!\n";
chomp( $gitdir,$sha1);
my $workdir= $gitdir;
my $is_bare;
if ( $workdir =~ s!/\.git\z!! ) {
chdir $workdir
or die "Failed to chdir to $workdir\n";
} else {
$is_bare= 1;
chdir $workdir
or die "Failed to chdir to bare repo $workdir\n";
#'die $workdir;
($sha1, $abbr,$tstamp)= split /\s+/, `git log --pretty='format:%H %h %ct' -1 $sha1`
or die "Failed to parse '$sha1'\n";
#die "'$sha1','$abbr'\n";
my $path= join "/", $zip_root, substr($sha1,0,2), substr($sha1,0,4);
my $tar_file= "$sha1.tar.$$";
my $gz_file= "$sha1.tar.gz";
my $prefix= "perl-$abbr/";
if (!-e "$path/$gz_file") {
mkpath $path if !-d $path;
system("git archive --format=tar --prefix=$prefix $sha1 > $path/$tar_file");
my @branches=map { $is_bare ? $_ : "origin/$_" } (
my $branch;
foreach my $b (@branches) {
$branch= $b and last
if `git log --pretty='format:%H' $b | grep $sha1`;
$branch ||= "unknown-branch";
chomp(my $describe= `git describe`);
chdir $path;
open my $fh,">","$path/$$.patch" or die "Failed to open $$.patch for writing\n";
print $fh join(" ", $branch, isotime($tstamp), $sha1, $describe) . "\n";
close $fh;
system("tar -f $tar_file --transform='s,^$$,$prefix,g' --owner=root --group=root --mode=664 --append $$.patch");
unlink "$$.patch";
system("gzip -S .gz -9 $tar_file");
rename "$tar_file.gz", "$gz_file";
print "ok\tperl-$abbr.tar.gz\t$path/$gz_file", -t STDOUT ? "\n" :"";
Jump to Line
Something went wrong with that request. Please try again.