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