1#!/usr/bin/perl
2use strict;
3use warnings;
4use File::Path;
5use Cwd;
6
7# This is a quick and dirty snapshot generator for the perl5.git.perl.org web page
8# to use to generate the snapshot files. Yes it is ugly and contains hard coded crap
9# and could use some love. But for this todo I am out of time now. -- Yves
10
11$ENV{PATH}="/usr/local/bin:/bin/";
12
13use POSIX qw(strftime);
14sub isotime { strftime "%Y-%m-%d.%H:%M:%S",gmtime(shift||time) }
15
16my ($abbr,$sha1,$tstamp);
17$sha1= shift || "HEAD";
18my $zip_root= $ENV{PERL_SNAPSHOT_ZIP_ROOT} || "/gitcommon/snapshot/tgz";
19my $gitdir= shift || `git rev-parse --git-dir`
20    or die "Not a git repo!\n";
21chomp( $gitdir,$sha1);
22my $workdir= $gitdir;
23my $is_bare;
24if ( $workdir =~ s!/\.git\z!! ) {
25
26    chdir $workdir
27        or die "Failed to chdir to $workdir\n";
28} else {
29    $is_bare= 1;
30    chdir $workdir
31        or die "Failed to chdir to bare repo $workdir\n";
32}
33#'die $workdir;
34
35($sha1, $abbr,$tstamp)= split /\s+/, `git log --pretty='format:%H %h %ct' -1 $sha1`
36    or die "Failed to parse '$sha1'\n";
37chomp($sha1,$abbr,$tstamp);
38
39#die "'$sha1','$abbr'\n";
40
41my $path= join "/", $zip_root, substr($sha1,0,2), substr($sha1,0,4);
42my $tar_file= "$sha1.tar.$$";
43my $gz_file= "$sha1.tar.gz";
44my $prefix= "perl-$abbr/";
45
46if (!-e "$path/$gz_file") {
47    mkpath $path if !-d $path;
48
49    system("git archive --format=tar --prefix=$prefix $sha1 > $path/$tar_file");
50    my @branches=map { $is_bare ? $_ : "origin/$_" } (
51              'blead',
52              'maint-5.10',
53              'maint-5.8',
54              'maint-5.8-dor',
55              'maint-5.6',
56              'maint-5.005',
57              'maint-5.004',
58    );
59    my $branch;
60    foreach my $b (@branches) {
61        $branch= $b and last
62            if `git log --pretty='format:%H' $b | grep $sha1`;
63    }
64
65    $branch ||= "unknown-branch";
66    chomp(my $describe= `git describe`);
67    chdir $path;
68    {
69        open my $fh,">","$path/$$.patch" or die "Failed to open $$.patch for writing\n";
70        print $fh join(" ", $branch, isotime($tstamp), $sha1, $describe) . "\n";
71        close $fh;
72    }
73    system("tar -f $tar_file --transform='s,^$$,$prefix,g' --owner=root --group=root --mode=664 --append $$.patch");
74    unlink "$$.patch";
75    system("gzip -S .gz -9 $tar_file");
76    rename "$tar_file.gz", "$gz_file";
77}
78print "ok\tperl-$abbr.tar.gz\t$path/$gz_file", -t STDOUT ? "\n" :"";
79
80