This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Extract _cmd_l_calc_initial_end_and_i .
[perl5.git] / Porting / make_snapshot.pl
index 6ff3c93..70a4c3d 100755 (executable)
@@ -4,23 +4,33 @@ use warnings;
 use File::Path;
 use Cwd;
 
+# This is a quick and dirty snapshot generator for the perl5.git.perl.org 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
+
+$ENV{PATH}="/usr/local/bin:/bin/";
+
 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/branches/snapshot";
+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;
+chomp( $gitdir,$sha1);
 my $workdir= $gitdir;
+my $is_bare;
 if ( $workdir =~ s!/\.git\z!! ) {
-    chdir $workdir 
+
+    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";
@@ -30,25 +40,25 @@ chomp($sha1,$abbr,$tstamp);
 
 my $path= join "/", $zip_root, substr($sha1,0,2), substr($sha1,0,4);
 my $tar_file= "$sha1.tar.$$";
-my $gz_file= "$sha1.tgz";
+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=(
-              'origin/blead',
-              'origin/maint-5.10',
-              'origin/maint-5.8',
-              'origin/maint-5.8-dor',
-              'origin/maint-5.6',
-              'origin/maint-5.005',
-              'origin/maint-5.004',
+    my @branches=map { $is_bare ? $_ : "origin/$_" } (
+              'blead',
+              'maint-5.10',
+              'maint-5.8',
+              'maint-5.8-dor',
+              'maint-5.6',
+              'maint-5.005',
+              'maint-5.004',
     );
     my $branch;
     foreach my $b (@branches) {
-        $branch= $b and last 
+        $branch= $b and last
             if `git log --pretty='format:%H' $b | grep $sha1`;
     }
 
@@ -57,12 +67,13 @@ if (!-e "$path/$gz_file") {
     chdir $path;
     {
         open my $fh,">","$path/$$.patch" or die "Failed to open $$.patch for writing\n";
-        print $fh join(" ", $branch, $tstamp, $sha1, $describe) . "\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 "$path/$gz_file", -t STDOUT ? "\n" :"";
+print "ok\tperl-$abbr.tar.gz\t$path/$gz_file", -t STDOUT ? "\n" :"";