Porting/make_snapshot.pl

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4 use File::Path;
   5 use 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
  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";
  18 my $zip_root= $ENV{PERL_SNAPSHOT_ZIP_ROOT} || "/gitcommon/snapshot/tgz";
  19 my $gitdir= shift || `git rev-parse --git-dir`
  20     or die "Not a git repo!\n";
  21 chomp( $gitdir,$sha1);
  22 my $workdir= $gitdir;
  23 my $is_bare;
  24 if ( $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";
  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.$$";
  43 my $gz_file= "$sha1.tar.gz";
  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");
  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 }
  78 print "ok\tperl-$abbr.tar.gz\t$path/$gz_file", -t STDOUT ? "\n" :"";
  79