Skip to content

Commit af07fea

Browse files
authored
Merge pull request #192 from StrawberryPerl/releases_json_snippets
Generate snippets for releases.json file
2 parents 0b7e444 + 0a12c1a commit af07fea

File tree

10 files changed

+128
-10
lines changed

10 files changed

+128
-10
lines changed

Build.PL

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -39,7 +39,7 @@ my $builder = $class->new(
3939
'Archive::Zip' => 0,
4040
'Data::Dump' => 0,
4141
'Data::UUID' => 0,
42-
'Digest::SHA1' => 0,
42+
'Digest::SHA' => 0,
4343
'ExtUtils::MakeMaker' => 0,
4444
'File::Basename' => 0,
4545
'File::Copy' => 0,
@@ -55,6 +55,7 @@ my $builder = $class->new(
5555
'HTML::Entities' => 0,
5656
'IO::Capture' => 0,
5757
'IPC::Run3' => 0,
58+
'JSON::PP' => 0,
5859
'LWP::UserAgent' => 0,
5960
'Pod::Usage' => 0,
6061
'Portable::Dist' => '1.06',

devel.utils/diffzipdirs.pl

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@
1212
use File::Temp qw(tempfile tempdir);
1313

1414
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
15-
use Digest::SHA1 qw(sha1 sha1_hex sha1_base64);
15+
use Digest::SHA qw(sha1 sha1_hex sha1_base64 sha256 sha256_hex sha256_base64);
1616
use Data::Dump 'pp';
1717
use File::Glob 'bsd_glob';
1818
use File::Basename;

lib/Perl/Dist/Strawberry/Step.pm

Lines changed: 20 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,7 @@ use Text::Patch qw(patch);
1717
use Win32;
1818
use Win32::File::Object;
1919
use IPC::Run3;
20-
use Digest::SHA1;
20+
use Digest::SHA;
2121

2222
##### mandatory methods for all Step-like classes - new(), check(), run(), test()
2323

@@ -372,11 +372,25 @@ sub _restore_ro {
372372

373373
sub sha1_file {
374374
my ($self, $file) = @_;
375-
my $sha1 = Digest::SHA1->new;
376-
open FILE, '<', $file or die "ERROR: open failed";
377-
binmode FILE;
378-
$sha1->addfile(*FILE);
379-
close FILE;
375+
return $self->_sha_file($file, 1);
376+
}
377+
378+
sub sha256_file {
379+
my ($self, $file) = @_;
380+
return $self->_sha_file($file, 256);
381+
}
382+
383+
sub _sha_file {
384+
my ($self, $file, $alg) = @_;
385+
die "undefined SHA algorithm" if !defined $alg;
386+
# generalise this check if more algs are needed
387+
die "invalid SHA algorithm '$alg'" if $alg !~ /^1|256$/;
388+
my $sha1 = Digest::SHA->new($alg);
389+
#open FILE, '<', $file or die "ERROR: open failed";
390+
#binmode FILE;
391+
#$sha1->addfile(*FILE);
392+
#close FILE;
393+
$sha1->addfile($file, 'b');
380394
return $sha1->hexdigest;
381395
}
382396

lib/Perl/Dist/Strawberry/Step/OutputLogZIP.pm

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,7 @@ sub run {
2020
#store results
2121
$self->{data}->{output}->{log_zip} = $zip_file;
2222
$self->{data}->{output}->{log_zip_sha1} = $self->sha1_file($zip_file);
23+
$self->{data}->{output}->{log_zip_sha256} = $self->sha256_file($zip_file);
2324
}
2425

2526
1;

lib/Perl/Dist/Strawberry/Step/OutputMSI.pm

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,7 @@ use Data::Dump qw(pp);
1414
use Data::UUID;
1515
use Template;
1616
use IPC::Run3;
17-
use Digest::SHA1;
17+
use Digest::SHA;
1818
use Win32::TieRegistry qw( KEY_READ );
1919

2020
sub new {
@@ -140,6 +140,7 @@ sub run {
140140
#store results
141141
$self->{data}->{output}->{msi} = $msi_file;
142142
$self->{data}->{output}->{msi_sha1} = $self->sha1_file($msi_file); # will change after we sign MSI
143+
$self->{data}->{output}->{msi_sha256} = $self->sha256_file($msi_file); # will change after we sign MSI
143144
$self->{data}->{output}->{msi_guid} = $msi_guid;
144145

145146
}

lib/Perl/Dist/Strawberry/Step/OutputMSM_MSI.pm

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,7 @@ use Data::Dump qw(pp);
1414
use Data::UUID;
1515
use Template;
1616
use IPC::Run3;
17-
use Digest::SHA1;
17+
use Digest::SHA;
1818
use Win32::TieRegistry qw( KEY_READ );
1919

2020
sub new {
@@ -160,6 +160,7 @@ sub run {
160160
$self->{data}->{output}->{msm} = $msm_file;
161161
$self->{data}->{output}->{msm_sha1} = $self->sha1_file($msm_file);
162162
$self->{data}->{output}->{msi_sha1} = $self->sha1_file($msi_file); # will change after we sign MSI
163+
$self->{data}->{output}->{msi_sha256} = $self->sha256_file($msi_file); # will change after we sign MSI
163164
$self->{data}->{output}->{msi_guid} = $msi_guid;
164165
$self->{data}->{output}->{msm_guid} = $msm_guid;
165166
$self->{data}->{output}->{msm_id} = $msm_id;

lib/Perl/Dist/Strawberry/Step/OutputPdlZIP.pm

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,7 @@ sub run {
2020
#store results
2121
$self->{data}->{output}->{pdl_zip} = $zip_file;
2222
$self->{data}->{output}->{pdl_zip_sha1} = $self->sha1_file($zip_file);
23+
$self->{data}->{output}->{pdl_zip_sha256} = $self->sha256_file($zip_file);
2324
}
2425

2526
1;

lib/Perl/Dist/Strawberry/Step/OutputPortableZIP.pm

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,7 @@ sub run {
2020
#store results
2121
$self->{data}->{output}->{portable_zip} = $zip_file;
2222
$self->{data}->{output}->{portable_zip_sha1} = $self->sha1_file($zip_file);
23+
$self->{data}->{output}->{portable_zip_sha256} = $self->sha256_file($zip_file);
2324
}
2425

2526
1;
Lines changed: 97 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,97 @@
1+
package Perl::Dist::Strawberry::Step::OutputReleasesJSONSnippet;
2+
3+
use 5.012;
4+
use warnings;
5+
use base 'Perl::Dist::Strawberry::Step';
6+
7+
use Time::Piece;
8+
use JSON::PP;
9+
10+
use File::Spec::Functions qw(catfile);
11+
12+
sub run {
13+
my $self = shift;
14+
15+
my $output_basename = $self->global->{output_basename} // 'perl-output';
16+
my $json_file = catfile($self->global->{output_dir}, "${output_basename}_releases_snippet.json.");
17+
18+
$self->boss->message(2, "gonna create '$json_file'");
19+
# backup already existing json_file;
20+
$self->backup_file($json_file);
21+
22+
use Data::Printer;
23+
#p $self;
24+
my $params = $self->global;
25+
#p $params;
26+
27+
my $app_version = $params->{app_version};
28+
my $bits = $params->{bits};
29+
30+
my $t = localtime();
31+
my $year = $t->year;
32+
my $month = $t->month;
33+
my $date_ymd = $t->strftime('%Y-%m-%d');
34+
35+
my $name = "$month $year / $app_version / ${bits}bit";
36+
my $archname = "MSWin32-x${bits}-multi-thread";
37+
# next two if-blocks are unverified as we have not built these types
38+
if ($params->{perl_64bitint}) {
39+
$name .= ' / with USE_64_BIT_INT';
40+
$archname .= '-64int';
41+
}
42+
if ($params->{perl_ldouble}) {
43+
$name .= ' / with USE_LONG_DOUBLE';
44+
$archname .= '-ld';
45+
}
46+
47+
# could use a map but it would be less readable
48+
my @v_parts = split /,/, $params->{app_rc_version};
49+
my $numver = $v_parts[0] + 1e-3 * $v_parts[1] + 1e-6 * $v_parts[2] + 1e-9 * $v_parts[3];
50+
51+
my @editions = grep {$_ =~ /^(zip|portable_zip|msi|pdl_zip)$/} keys %{$params->{output}};
52+
53+
my $edition_hash = {};
54+
EDITION:
55+
foreach my $edition (sort @editions) {
56+
my $f = $params->{output}{$edition};
57+
if (!$f or !-e $f) {
58+
warn "Unable to locate $edition output $f, cannot add to releases.json snippet.";
59+
next EDITION;
60+
}
61+
62+
my $size = -s $f;
63+
# could use a proper method...
64+
my $re_sep = qr|[/\\]|;
65+
my @path = split $re_sep, $f;
66+
my $basename = $path[-1];
67+
68+
my $hash = {
69+
sha1 => $params->{output}{"${edition}_sha1"} // $self->sha1_file($f),
70+
sha256 => $params->{output}{"${edition}_sha256"} // $self->sha256_file($f),
71+
size => $size,
72+
url => "__XXXX_URL_placeholder__ $basename",
73+
};
74+
$edition_hash->{$edition} = $hash;
75+
}
76+
77+
78+
#build snippet
79+
my $snippet = {
80+
archname => $archname,
81+
date => $date_ymd,
82+
edition => $edition_hash,
83+
name => $name,
84+
numver => $numver,
85+
relnotes => "https://strawberryperl.com/release-notes/$params->{output_basename}.html",
86+
version => $app_version,
87+
};
88+
89+
#p $snippet;
90+
my $json_snippet = JSON::PP->new->utf8->pretty->canonical->encode($snippet);
91+
open my $fh, '>', $json_file or die "Unable to open $json_file, $!";
92+
print {$fh} $json_snippet;
93+
$fh->close;
94+
95+
}
96+
97+
1;

lib/Perl/Dist/Strawberry/Step/OutputZIP.pm

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,7 @@ sub run {
2020
#store results
2121
$self->{data}->{output}->{zip} = $zip_file;
2222
$self->{data}->{output}->{zip_sha1} = $self->sha1_file($zip_file);
23+
$self->{data}->{output}->{zip_sha256} = $self->sha256_file($zip_file);
2324
}
2425

2526
1;

0 commit comments

Comments
 (0)