Commit | Line | Data |
a23cb041 |
1 | #!/usr/bin/perl |
2 | use strict; |
3 | use warnings; |
4 | use File::Path; |
5 | use Cwd; |
6 | |
fe4f7787 |
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 | |
a23cb041 |
13 | use POSIX qw(strftime); |
14 | sub isotime { strftime "%Y-%m-%d.%H:%M:%S",gmtime(shift||time) } |
15 | |
16 | my ($abbr,$sha1,$tstamp); |
17 | $sha1= shift || "HEAD"; |
fe4f7787 |
18 | my $zip_root= $ENV{PERL_SNAPSHOT_ZIP_ROOT} || "/gitcommon/snapshot/tgz"; |
a23cb041 |
19 | my $gitdir= shift || `git rev-parse --git-dir` |
20 | or die "Not a git repo!\n"; |
fe4f7787 |
21 | chomp( $gitdir,$sha1); |
a23cb041 |
22 | my $workdir= $gitdir; |
fe4f7787 |
23 | my $is_bare; |
a23cb041 |
24 | if ( $workdir =~ s!/\.git\z!! ) { |
fe4f7787 |
25 | |
26 | chdir $workdir |
a23cb041 |
27 | or die "Failed to chdir to $workdir\n"; |
28 | } else { |
fe4f7787 |
29 | $is_bare= 1; |
a23cb041 |
30 | chdir $workdir |
31 | or die "Failed to chdir to bare repo $workdir\n"; |
32 | } |
fe4f7787 |
33 | #'die $workdir; |
a23cb041 |
34 | |
35 | ($sha1, $abbr,$tstamp)= split /\s+/, `git log --pretty='format:%H %h %ct' -1 $sha1` |
36 | or die "Failed to parse '$sha1'\n"; |
37 | chomp($sha1,$abbr,$tstamp); |
38 | |
39 | #die "'$sha1','$abbr'\n"; |
40 | |
41 | my $path= join "/", $zip_root, substr($sha1,0,2), substr($sha1,0,4); |
42 | my $tar_file= "$sha1.tar.$$"; |
fe4f7787 |
43 | my $gz_file= "$sha1.tar.gz"; |
a23cb041 |
44 | my $prefix= "perl-$abbr/"; |
45 | |
46 | if (!-e "$path/$gz_file") { |
47 | mkpath $path if !-d $path; |
48 | |
49 | system("git archive --format=tar --prefix=$prefix $sha1 > $path/$tar_file"); |
fe4f7787 |
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', |
a23cb041 |
58 | ); |
59 | my $branch; |
60 | foreach my $b (@branches) { |
fe4f7787 |
61 | $branch= $b and last |
a23cb041 |
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"; |
fe4f7787 |
70 | print $fh join(" ", $branch, isotime($tstamp), $sha1, $describe) . "\n"; |
a23cb041 |
71 | close $fh; |
72 | } |
73 | system("tar -f $tar_file --transform='s,^$$,$prefix,g' --owner=root --group=root --mode=664 --append $$.patch"); |
40c53909 |
74 | unlink "$$.patch"; |
a23cb041 |
75 | system("gzip -S .gz -9 $tar_file"); |
76 | rename "$tar_file.gz", "$gz_file"; |
77 | } |
fe4f7787 |
78 | print "ok\tperl-$abbr.tar.gz\t$path/$gz_file", -t STDOUT ? "\n" :""; |
a23cb041 |
79 | |