Leaked source code of windows server 2003
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

150 lines
4.0 KiB

  1. @REM -----------------------------------------------------------------
  2. @REM
  3. @REM spfiledelta.cmd - JeremyD
  4. @REM Create lists of files used by SP scripts.
  5. @REM
  6. @REM Copyright (c) Microsoft Corporation. All rights reserved.
  7. @REM
  8. @REM -----------------------------------------------------------------
  9. @perl -x "%~f0" %*
  10. @goto :EOF
  11. #!perl
  12. #line 12
  13. use strict;
  14. use warnings;
  15. use lib $ENV{RAZZLETOOLPATH} . "\\PostBuildScripts";
  16. use lib $ENV{RAZZLETOOLPATH};
  17. use lib $ENV{RAZZLETOOLPATH} . "\\PostBuildScripts\\svcpack";
  18. use PbuildEnv;
  19. use ParseArgs;
  20. use Digest;
  21. use IO::Dir;
  22. use IO::File;
  23. use File::Basename;
  24. use SP;
  25. use Utils;
  26. sub Usage { print<<USAGE; exit(1) }
  27. USAGE
  28. parseargs('?' => \&Usage);
  29. my @skus = SP::sp_skus();
  30. exit if !@skus;
  31. my ($added, $changed, $removed);
  32. for my $sku (@skus) {
  33. my $gold = read_gold_info($sku);
  34. my $current = read_sku_info($sku);
  35. ($added->{$sku}, $changed->{$sku}, $removed->{$sku}) = diff($gold, $current);
  36. delete $changed->{$sku}{'i386\\driver.cab'};
  37. }
  38. my %files;
  39. for my $sku (@skus) {
  40. while (my ($file, $data) = each %{$added->{$sku}}) {
  41. $files{$file} = $data;
  42. }
  43. while (my ($file, $data) = each %{$changed->{$sku}}) {
  44. $files{$file} = $data;
  45. }
  46. }
  47. Utils::mkdir("$ENV{_NTPOSTBLD}\\SP\\data");
  48. my $fh = IO::File->new("$ENV{_NTPOSTBLD}\\SP\\data\\files.txt", 'w');
  49. for my $file (sort keys %files) {
  50. print $fh "$file\t$files{$file}{file}\n";
  51. }
  52. my $common_added = merge_diffs($added);
  53. my $common_changed = merge_diffs($changed);
  54. Utils::mkdir("$ENV{_NTPOSTBLD}\\SP");
  55. print_file_list("$ENV{_NTPOSTBLD}\\SP\\data\\added.txt", \%$common_added);
  56. print_file_list("$ENV{_NTPOSTBLD}\\SP\\data\\changed.txt", \%$common_changed);
  57. for my $sku (@skus) {
  58. Utils::mkdir("$ENV{_NTPOSTBLD}\\SP\\$sku");
  59. print_file_list("$ENV{_NTPOSTBLD}\\SP\\data\\$sku\\added.txt", \%{$added->{$sku}});
  60. print_file_list("$ENV{_NTPOSTBLD}\\SP\\data\\$sku\\changed.txt", \%{$changed->{$sku}});
  61. }
  62. sub print_file_list {
  63. my $out = shift;
  64. my $data = shift;
  65. my $fh = IO::File->new($out, 'w');
  66. for my $file (sort keys %$data) {
  67. print $fh "$file\t$data->{$file}{file}\n";
  68. }
  69. }
  70. sub merge_diffs {
  71. my $data = shift;
  72. my %common;
  73. my @skus = keys %$data;
  74. my $key_sku = $skus[0];
  75. FILE:
  76. for my $file (keys %{$data->{$key_sku}}) {
  77. for my $sku (@skus) {
  78. if (!$data->{$sku}{$file} or
  79. $data->{$sku}{$file}{hash} ne $data->{$key_sku}{$file}{hash}) {
  80. next FILE; # not mergeable
  81. }
  82. }
  83. $common{$file} = $data->{$key_sku}{$file};
  84. for my $sku (@skus) {
  85. delete $data->{$sku}{$file};
  86. }
  87. }
  88. return \%common;
  89. }
  90. sub diff {
  91. my ($gold, $current) = @_;
  92. my (%added, %changed, %removed);
  93. for my $file (keys %$gold) {
  94. if (!exists $current->{$file}) {
  95. $removed{$file} = {file => $gold->{$file}{file}, hash => '--deleted--'};
  96. }
  97. else {
  98. if ($gold->{$file}{hash} ne $current->{$file}{hash}) {
  99. $changed{$file} = $current->{$file};
  100. }
  101. }
  102. }
  103. for my $file (keys %$current) {
  104. if (!exists $gold->{$file}) {
  105. $added{$file} = $current->{$file};
  106. }
  107. }
  108. return (\%added, \%changed, \%removed);
  109. }
  110. sub read_sku_info {
  111. my $sku = shift;
  112. return read_info("$ENV{_NTPOSTBLD}\\SP\\data\\$sku\\file_info.txt");
  113. }
  114. sub read_gold_info {
  115. my $sku = shift;
  116. return read_info("$ENV{RAZZLETOOLPATH}\\postbuildscripts\\svcpack\\gold\\${sku}-$ENV{LANG}.txt");
  117. }
  118. sub read_info {
  119. my $file = shift;
  120. my %data;
  121. my $fh = IO::File->new($file, 'r') or die "$file $!";
  122. while (my $line = $fh->getline) {
  123. chomp($line);
  124. my ($relative, $file, $size, $mtime, $hash) = split /\t/, $line;
  125. $data{$relative} = {file => $file, hash => $hash};
  126. }
  127. return \%data;
  128. }