File: make_snapshot.pl

package info (click to toggle)
perl 5.24.1-3+deb9u5
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 103,716 kB
  • sloc: perl: 559,611; ansic: 293,886; sh: 67,316; pascal: 7,632; cpp: 3,895; makefile: 2,436; xml: 2,410; yacc: 989; sed: 6; lisp: 1
file content (79 lines) | stat: -rwxr-xr-x 2,386 bytes parent folder | download | duplicates (8)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
#!/usr/bin/perl
use strict;
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/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";
chomp($sha1,$abbr,$tstamp);

#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/$_" } (
              '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
            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" :"";