[21711] | 1 | package diffutil;
|
---|
| 2 |
|
---|
| 3 | BEGIN {
|
---|
| 4 | die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
|
---|
| 5 | die "GSDLOS not set\n" unless defined $ENV{'GSDLOS'};
|
---|
| 6 | unshift (@INC, "$ENV{'GSDLHOME'}/perllib");
|
---|
| 7 | unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan");
|
---|
| 8 | }
|
---|
| 9 | use util;
|
---|
| 10 |
|
---|
| 11 |
|
---|
| 12 |
|
---|
| 13 | sub files_in_dir
|
---|
| 14 | {
|
---|
| 15 | my ($dirname) =@_;
|
---|
| 16 |
|
---|
| 17 | opendir(DIR, $dirname) || die "can't opendir $dirname: $!";
|
---|
[27967] | 18 | my $skipdirs_re = qr/^cached$/;
|
---|
| 19 | @local_files = grep { /^\w/ && ((-d &util::filename_cat($dirname,$_) && $_ !~ m/$skipdirs_re/) || -f &util::filename_cat($dirname,$_))} readdir(DIR);
|
---|
[21711] | 20 | closedir DIR;
|
---|
| 21 |
|
---|
| 22 | return @local_files;
|
---|
| 23 | }
|
---|
| 24 |
|
---|
| 25 | sub GetErrors
|
---|
| 26 | {
|
---|
| 27 | my ($aryErrors,$aryReturnErrors,$intLineCount) = @_;
|
---|
| 28 | for(my $intCounter = 0; $intCounter < $intLineCount ; $intCounter++)
|
---|
| 29 | {
|
---|
| 30 | if(my $strAError = shift(@{$aryErrors}))
|
---|
| 31 | {
|
---|
| 32 | $strAError =~ s/^(<( )*)|^(>( )*)//g;
|
---|
| 33 | push(@{$aryReturnErrors},$strAError);
|
---|
| 34 | }
|
---|
| 35 | else {return 0;}
|
---|
| 36 | }
|
---|
| 37 | return 1;
|
---|
| 38 | }
|
---|
| 39 |
|
---|
| 40 | sub IgnoreExp
|
---|
| 41 | {
|
---|
| 42 | my ($strModel,$strTest,$strIgnoreExp) = @_;
|
---|
| 43 |
|
---|
| 44 | if($strIgnoreExp eq "")
|
---|
| 45 | {
|
---|
| 46 | return 0;
|
---|
| 47 | }
|
---|
| 48 | else
|
---|
| 49 | {
|
---|
[27604] | 50 | if($strModel =~ m/$strIgnoreExp/ && $strTest =~ m/$strIgnoreExp/) #if($strModel =~ m/$strIgnoreExp/mg && $strTest =~ m/$strIgnoreExp/mg)
|
---|
[21711] | 51 | {
|
---|
| 52 | return 1;
|
---|
| 53 | }
|
---|
| 54 | else {return 0;}
|
---|
| 55 | }
|
---|
| 56 | }
|
---|
| 57 |
|
---|
| 58 | sub GenerateOutput
|
---|
| 59 | {
|
---|
| 60 | my ($strResult,$strIgnoreExp) = @_;
|
---|
| 61 | if($strResult eq "") {return "";}
|
---|
| 62 |
|
---|
| 63 | my @aryErrors = split ("\n",$strResult);
|
---|
| 64 | my $strErrorMessage = "";
|
---|
| 65 | my $intCounter = 0;
|
---|
| 66 | my $hashptErrorLines;
|
---|
[27604] | 67 |
|
---|
[21711] | 68 | while(my $strFirstLine = shift(@aryErrors))
|
---|
| 69 | {
|
---|
| 70 | my $charResultChar;
|
---|
| 71 | my @aryModelErrors;
|
---|
| 72 | my @aryTestErrors;
|
---|
| 73 | my $strAError = "";
|
---|
| 74 |
|
---|
| 75 | if($strFirstLine =~ m/(\d+,)*\d+[a-z]\d+(,\d+)*/)
|
---|
| 76 | {
|
---|
| 77 | $charResultChar = $strFirstLine;
|
---|
| 78 | $charResultChar =~ s/\d|\W//g;
|
---|
| 79 | my @aryRightLeft = split($charResultChar,$strFirstLine);
|
---|
| 80 | my @aryModelLines = split(",",$aryRightLeft[0]);
|
---|
| 81 | my @aryTestLines = split(",",$aryRightLeft[1]);
|
---|
| 82 | my $intModelLineCount = 0;
|
---|
| 83 | my $intTestLineCount = 0;
|
---|
| 84 |
|
---|
| 85 | if(scalar(@aryModelLines)> 2 || scalar(@aryTestLines)> 2){die "Error Found!!\n";}
|
---|
| 86 |
|
---|
| 87 | $intModelLineCount = (scalar(@aryModelLines) == 1) ? 1 : ($aryModelLines[1] - $aryModelLines[0] + 1);
|
---|
| 88 | $intTestLineCount = (scalar(@aryTestLines) == 1) ? 1 : ($aryTestLines[1] - $aryTestLines[0] + 1);
|
---|
| 89 |
|
---|
| 90 | if($charResultChar eq "c")
|
---|
| 91 | {
|
---|
| 92 | die "Nothing to parse 1\n" unless(&GetErrors(\@aryErrors,\@aryModelErrors,$intModelLineCount) == 1);
|
---|
| 93 |
|
---|
| 94 | if($aryErrors[0] eq "---")
|
---|
| 95 | {
|
---|
| 96 | my $strExtra = shift(@aryErrors);
|
---|
| 97 | }
|
---|
| 98 | else
|
---|
| 99 | {
|
---|
| 100 | print "Incorrect format of diff program\n";
|
---|
| 101 | }
|
---|
| 102 | #die "Nothing to parse 2\n" unless(my $strExtra = shift(@aryErrors));
|
---|
| 103 | #die "Error Occoured: $strResult\n" unless($strExtra eq "---");
|
---|
| 104 |
|
---|
| 105 | die "Nothing to parse 3\n" unless(&GetErrors(\@aryErrors,\@aryTestErrors,$intTestLineCount) == 1);
|
---|
| 106 |
|
---|
| 107 | if($intModelLineCount == 1 && $intTestLineCount == 1 &&
|
---|
| 108 | &IgnoreExp($aryModelErrors[0],$aryModelErrors[0],$strIgnoreExp) == 1)
|
---|
[27604] | 109 | #&IgnoreExp($aryModelErrors[0],$aryTestErrors[0],$strIgnoreExp) == 1) # 2nd param should be aryTestErrors?
|
---|
[21711] | 110 | {
|
---|
| 111 | $strAError = "";
|
---|
| 112 | }
|
---|
| 113 | else
|
---|
| 114 | {
|
---|
| 115 | $strAError .= "Differences found between Model and Test Collection\n";
|
---|
| 116 | $strAError .= "--------------------------------------------------------------------------\n";
|
---|
| 117 |
|
---|
| 118 | $strAError .= "Model Collection:\n";
|
---|
| 119 | for(my $intCounter = 0; $intCounter < $intModelLineCount ; $intCounter++)
|
---|
| 120 | {
|
---|
| 121 | my $intOutLine = $aryModelLines[0] + $intCounter;
|
---|
| 122 | $strAError .= " Line $intOutLine \t($aryModelErrors[$intCounter])\n";
|
---|
| 123 | }
|
---|
| 124 | $strAError .= "Test Collection:\n";
|
---|
| 125 | for(my $intCounter = 0; $intCounter < $intTestLineCount ; $intCounter++)
|
---|
| 126 | {
|
---|
| 127 | my $intOutLine = $aryTestLines[0] + $intCounter;
|
---|
| 128 | $strAError .= " Line $intOutLine \t($aryTestErrors[$intCounter])\n";
|
---|
| 129 | }
|
---|
| 130 | }
|
---|
| 131 | }
|
---|
| 132 |
|
---|
| 133 | elsif($charResultChar eq "a")
|
---|
| 134 | {
|
---|
| 135 | die "Nothing to parse 4\n" unless(&GetErrors(\@aryErrors,\@aryTestErrors,$intTestLineCount) == 1);
|
---|
| 136 | $strAError .= "Missing in Model Collection\n";
|
---|
| 137 | $strAError .= "--------------------------------------------------------------------------\n";
|
---|
| 138 | $strAError .= "In Test Collection but not in Model Collection (Mismatch from Line $aryModelLines[0]):\n";
|
---|
| 139 | for(my $intCounter = 0; $intCounter < $intTestLineCount ; $intCounter++)
|
---|
| 140 | {
|
---|
| 141 | my $intOutLine = $aryTestLines[0] + $intCounter;
|
---|
| 142 | $strAError .= " Line $intOutLine \t($aryTestErrors[$intCounter])\n";
|
---|
| 143 | }
|
---|
| 144 | }
|
---|
| 145 |
|
---|
| 146 | elsif($charResultChar eq "d")
|
---|
| 147 | {
|
---|
| 148 | die "Nothing to parse 5:$strResult\n" unless( &GetErrors(\@aryErrors,\@aryModelErrors,$intModelLineCount) == 1);
|
---|
| 149 | $strAError .= "Missing in Test Collection\n";
|
---|
| 150 | $strAError .= "--------------------------------------------------------------------------\n";
|
---|
| 151 | $strAError .= "In Model Collection but not in Test Collection (Mismatch from Line $aryTestLines[0]):\n";
|
---|
| 152 | for(my $intCounter = 0; $intCounter < $intModelLineCount ; $intCounter++)
|
---|
| 153 | {
|
---|
| 154 | my $intOutLine = $aryModelLines[0] + $intCounter;
|
---|
| 155 | $strAError .= " Line $intOutLine \t($aryModelErrors[$intCounter])\n";
|
---|
| 156 | }
|
---|
| 157 | }
|
---|
| 158 | else
|
---|
| 159 | {
|
---|
| 160 | die "Missing comparsion type!!\n";
|
---|
| 161 | }
|
---|
| 162 |
|
---|
| 163 | }
|
---|
| 164 | else
|
---|
| 165 | {
|
---|
| 166 | die "$strResult\n";
|
---|
| 167 | }
|
---|
| 168 | if($strAError ne ""){$strErrorMessage .= "\n".$strAError;}
|
---|
| 169 | }
|
---|
| 170 |
|
---|
| 171 | return $strErrorMessage;
|
---|
| 172 | }
|
---|
| 173 |
|
---|
| 174 | 1;
|
---|