23 my $previousPdkLabel = shift or die "Second argument must be hg label to compare against\n"; |
23 my $previousPdkLabel = shift or die "Second argument must be hg label to compare against\n"; |
24 my $detailsTsvFilename = shift or die "Third argument must be filename to write detailed TSV data into\n"; |
24 my $detailsTsvFilename = shift or die "Third argument must be filename to write detailed TSV data into\n"; |
25 defined shift and die "No more than three arguments please\n"; |
25 defined shift and die "No more than three arguments please\n"; |
26 |
26 |
27 # Use external scripts to get the raw data and produce the CSV summary (to go into Excel, etc) |
27 # Use external scripts to get the raw data and produce the CSV summary (to go into Excel, etc) |
28 system("perl $FindBin::Bin\\..\\clone_packages\\clone_all_packages.pl -packagelist $bomInfoFile -exec -- hg status -A --rev $previousPdkLabel 2>&1 | perl $FindBin::Bin\\..\\williamr\\summarise_hg_status.pl 2> nul: > $detailsTsvFilename"); |
28 my @pkgErrors = `perl $FindBin::Bin\\..\\clone_packages\\clone_all_packages.pl -packagelist $bomInfoFile -exec -- hg status -A --rev $previousPdkLabel 2>&1 | perl $FindBin::Bin\\..\\williamr\\summarise_hg_status.pl 2>&1 > $detailsTsvFilename`; |
29 |
29 |
30 # The redirection above means that we discard STDERR from summarise_hg_status, |
30 # The redirection above means that we capture STDERR from summarise_hg_status, |
31 # which lists packages for which it was unable to generate any data |
31 # which lists packages for which it was unable to generate any data |
32 # |
32 # |
33 # It's discarded because that happens either because it's a new package or has |
33 # It's captured because that happens either because it's a new package or has |
34 # moved from SFL -> EPL or we've reverted to using the MCL instead of the FCL |
34 # moved from SFL -> EPL or we've reverted to using the MCL instead of the FCL |
35 # (in which cases it's dealt with in another part of the release notes) or it |
35 # (in which case it's dealt with in another part of the release notes) or it |
36 # just hasn't had any changes since the last release |
36 # just hasn't had any changes since the last release |
37 |
37 |
38 # Input from TSV file |
38 # Input from TSV file |
39 my @rawData; |
39 my @rawData; |
40 open my $fh, "<", $detailsTsvFilename; |
40 open my $fh, "<", $detailsTsvFilename; |
63 # Accumulate the total number of files in the old revision of the pkg |
63 # Accumulate the total number of files in the old revision of the pkg |
64 $cookedData{$datum->{Package}}->{totalFiles} += $datum->{Count} unless $datum->{Change} eq "A"; |
64 $cookedData{$datum->{Package}}->{totalFiles} += $datum->{Count} unless $datum->{Change} eq "A"; |
65 $cookedData{$datum->{Package}}->{same} += $datum->{Count} if $datum->{Change} eq "same"; |
65 $cookedData{$datum->{Package}}->{same} += $datum->{Count} if $datum->{Change} eq "same"; |
66 $cookedData{$datum->{Package}}->{addRemove} += $datum->{Count} if $datum->{Change} =~ m{^[AR]$}; |
66 $cookedData{$datum->{Package}}->{addRemove} += $datum->{Count} if $datum->{Change} =~ m{^[AR]$}; |
67 } |
67 } |
|
68 # Add the "exception" packages |
|
69 foreach my $package (@pkgErrors) |
|
70 { |
|
71 chomp $package; |
|
72 $package =~ s{No valid comparison for }{}; |
|
73 $cookedData{$package}->{exception} = "Package is brand new, or converted from SFL -> EPL, or has transitioned from FCL back to MCL (not covered in this section)\n"; |
|
74 } |
68 |
75 |
69 # Cut-off for "interesting" packages |
76 # Cut-off for "interesting" packages |
|
77 |
70 foreach my $package (keys %cookedData) |
78 foreach my $package (keys %cookedData) |
71 { |
79 { |
72 # Ensure items are defined |
80 # Ensure items are defined |
73 $cookedData{$package}->{totalFiles} |= 1; |
81 $cookedData{$package}->{totalFiles} |= 1; |
74 $cookedData{$package}->{same} |= 0; |
82 $cookedData{$package}->{same} |= 0; |
75 $cookedData{$package}->{addRemove} |= 0; |
83 $cookedData{$package}->{addRemove} |= 0; |
76 $cookedData{$package}->{percentChurn} = 100 * (1 - ($cookedData{$package}->{same} / $cookedData{$package}->{totalFiles})); |
84 $cookedData{$package}->{percentChurn} = 100 * (1 - ($cookedData{$package}->{same} / $cookedData{$package}->{totalFiles})); |
|
85 $cookedData{$package}->{exception} |= ""; |
77 |
86 |
78 # More than N files added + removed |
87 # More than N files added + removed |
79 next if $cookedData{$package}->{addRemove} >= 400; |
88 next if $cookedData{$package}->{addRemove} >= 400; |
80 # More than M% churn |
89 # More than M% churn |
81 next if $cookedData{$package}->{percentChurn} > 30; |
90 next if $cookedData{$package}->{percentChurn} > 30; |
|
91 # Unable to compare at all |
|
92 next if $cookedData{$package}->{exception}; |
82 # Nothing interesting about this package |
93 # Nothing interesting about this package |
83 delete $cookedData{$package}; |
94 delete $cookedData{$package}; |
84 } |
95 } |
85 |
96 |
86 # Output |
97 # Output |