build/errorlist/errorlist.pl

   1 #!/usr/bin/perl -w
   2
   3 ++$|;
   4 END { print "\n\nPress enter to exit.\n"; <STDIN> }
   5
   6 use strict;
   7 use warnings;
   8
   9 my ($source, $output);
  10
  11 for (@ARGV) {
  12   # Note to self: "perl errorlist.pl --source=../../source/i18n --output=../../source/i18n/tests/ps/Errors.cpp"
  13   if (/[-\/]\?|--\?|--help/) {
  14     print <<EOH;
  15 $0 parameters:
  16   --source=../../source               - root directory for source code
  17   --output=../../source/ps/Errors.cpp - output file to generate
  18   --help                              - route to enlightenment
  19 EOH
  20     exit;
  21   } elsif (/^--source="?(.*?)"?$/) {
  22     $source = $1;
  23   } elsif (/^--output="?(.*?)"?$/) {
  24     $output = $1;
  25   }
  26 }
  27
  28 $source ||= '../../source';
  29 $output ||= "$source/ps/Errors.cpp";
  30
  31 print "Reading files from $source... ";
  32
  33 my (%topgroups, %groups, %types);
  34
  35 my @files = cpp_files("$source/");
  36
  37 my $loc = 0;
  38 for (@files) {
  39   open my $f, $_ or die "Error opening file '$_' ($!)";
  40   while (<$f>) {
  41     if (/^ERROR_/) {
  42       if (/^ERROR_GROUP\((.+?)\)/) {
  43         $topgroups{$1} = 1;
  44       } elsif (/^ERROR_SUBGROUP\((.+?)\)/) {
  45         $groups{join '~', split /,\s*/, $1} = 1;
  46       } elsif (/^ERROR_TYPE\((.+?)\)/) {
  47         $types{join '~', split /,\s*/, $1} = 1;
  48       }
  49     }
  50     ++$loc;
  51   }
  52 }
  53
  54 # Add commas to number in groups of three
  55 1 while $loc =~ s/(\d+)(\d{3})/$1,$2/;
  56
  57 print "(".@files." files read - $loc lines of code)\n";
  58 print "Generating $output... ";
  59
  60 # Add "PSERROR_Error_InvalidError", so that an error to throw when being
  61 # told to throw an error that doesn't exist exists.
  62 $topgroups{Error} = 1;
  63 $types{'Error~InvalidError'} = 1;
  64
  65 open my $out, '>', "$output" or die "Error opening $output ($!)";
  66
  67 print $out <<'.';
  68 // Auto-generated by errorlist.pl - do not edit.
  69
  70 #include "precompiled.h"
  71
  72 #include "Errors.h"
  73
  74 .
  75
  76 for (sort keys %topgroups) {
  77   print $out "class PSERROR_$_ : public PSERROR { protected: PSERROR_$_(const char* msg); };\n";
  78 }
  79
  80 print $out "\n";
  81
  82 for (sort { $a->[1] cmp $b->[1] } map [$_, do{(my $c=$_)=~s/~/_/;$c} ], keys %groups) {
  83   my ($base, $name) = split /~/, $_->[0];
  84   print $out "class PSERROR_${base}_$name : public PSERROR_$base { protected: PSERROR_${base}_$name(const char* msg); };\n";
  85 }
  86
  87 print $out "\n";
  88
  89 for (sort { $a->[1] cmp $b->[1] } map [$_, do{(my $c=$_)=~s/~/_/;$c} ], keys %types) {
  90   my ($base, $name) = split /~/, $_->[0];
  91   print $out "class PSERROR_${base}_$name : public PSERROR_$base { public: PSERROR_${base}_$name(); PSERROR_${base}_$name(const char* msg); PSRETURN getCode() const; };\n";
  92 }
  93
  94 print $out "\n";
  95
  96 # The difficult bit:
  97
  98 =pod
  99
 100 mask
 101 ****  PSERROR
 102 0001  PSERROR_          Err1
 103 1***  PSERROR_Sec1
 104 1001  PSERROR_Sec1_     Err1
 105 1002  PSERROR_Sec1_     Err2
 106 1003  PSERROR_Sec1_     Err3
 107 11**  PSERROR_Sec1_Sec1
 108 1101  PSERROR_Sec1_Sec1_Err1
 109 1102  PSERROR_Sec1_Sec1_Err2
 110 2***  PSERROR_Sec2
 111 2001  PSERROR_Sec2_     Err1
 112
 113 ...so split into three sections (0 if null) plus final code...
 114
 115 =cut
 116
 117 my @sec_codes;
 118 $sec_codes[$_]{''} = 1 for 0..2;
 119
 120 for (keys %types) {
 121   my (@secs) = split /[~_]/;
 122   my $err = pop @secs;
 123   $sec_codes[$_]{$secs[$_] || ''} = 1 for 0..2;
 124 }
 125
 126 for my $n (0..2) {
 127   @{$sec_codes[$n]}{sort keys %{$sec_codes[$n]}} = 0 .. keys(%{$sec_codes[$n]})-1;
 128 }
 129
 130 my ($last_sec, $last_err) = ('', 0);
 131 for (sort keys %types) {
 132   my (@secs) = split /[~_]/;
 133   my $err = pop @secs;
 134   my $id = join '', map chr $sec_codes[$_]{$secs[$_] || ''}, 0..2;
 135   if ($id eq $last_sec) {
 136     $id .= chr(++$last_err);
 137   } else {
 138     $last_sec = $id;
 139     $id .= chr($last_err=1);
 140   }
 141   $types{$_} = $id;
 142 }
 143
 144 for (sort keys %types) {
 145   my ($base, $name) = split /~/;
 146   print $out "extern const PSRETURN PSRETURN_${base}_${name} = 0x".unpack('H*', $types{$_}).";\n";
 147 }
 148
 149 print $out "\n";
 150
 151 for (sort keys %topgroups) {
 152   my (@secs) = $_;
 153   my $id = join '', map chr $sec_codes[$_]{$secs[$_] || ''}, 0..2;
 154   my $code = unpack 'H*', $id;
 155   (my $mask = $code) =~ s/(\d\d)/$1+0 ? 'ff' : '00'/ge;
 156   print $out "extern const PSRETURN MASK__PSRETURN_".join('_', @secs)." = 0x${mask}00;\n";
 157   print $out "extern const PSRETURN CODE__PSRETURN_".join('_', @secs)." = 0x${code}00;\n";
 158 }
 159
 160 for (sort keys %groups) {
 161   my (@secs) = split /[_~]/;
 162   my $id = join '', map chr $sec_codes[$_]{$secs[$_] || ''}, 0..2;
 163   my $code = unpack 'H*', $id;
 164   (my $mask = $code) =~ s/(\d\d)/$1+0 ? 'ff' : '00'/ge;
 165   print $out "extern const PSRETURN MASK__PSRETURN_".join('_', @secs)." = 0x${mask}00;\n";
 166   print $out "extern const PSRETURN CODE__PSRETURN_".join('_', @secs)." = 0x${code}00;\n";
 167 }
 168
 169 print $out "\n";
 170
 171 for (sort keys %types) {
 172   my $code = unpack 'H*', $types{$_};
 173   s/~/_/;
 174   print $out "extern const PSRETURN MASK__PSRETURN_$_ = 0xffffffff;\n";
 175   print $out "extern const PSRETURN CODE__PSRETURN_$_ = 0x$code;\n";
 176 }
 177
 178 # End of difficult bit.
 179
 180 print $out "\n";
 181
 182 for (sort keys %topgroups) {
 183   print $out "PSERROR_${_}::PSERROR_${_}(const char* msg) : PSERROR(msg) { }\n";
 184 }
 185
 186 for (sort keys %groups) {
 187   my ($base, $name) = split /~/;
 188   print $out "PSERROR_${base}_${name}::PSERROR_${base}_${name}(const char* msg) : PSERROR_$base(msg) { }\n";
 189 }
 190
 191 print $out "\n";
 192
 193 for (sort keys %types) {
 194   my ($base, $name) = split /~/;
 195   print $out "PSERROR_${base}_${name}::PSERROR_${base}_${name}() : PSERROR_$base(NULL) { }\n";
 196   print $out "PSERROR_${base}_${name}::PSERROR_${base}_${name}(const char* msg) : PSERROR_$base(msg) { }\n";
 197   print $out "PSRETURN PSERROR_${base}_${name}::getCode() const { return 0x".unpack('H*',$types{$_})."; }\n";
 198   print $out "\n";
 199 }
 200
 201 print $out <<".";
 202
 203 PSERROR::PSERROR(const char* msg) : m_msg(msg) { }
 204
 205 const char* PSERROR::what() const throw ()
 206 {
 207         return m_msg ? m_msg : GetErrorString(getCode());
 208 }
 209
 210 const char* GetErrorString(PSRETURN code)
 211 {
 212         switch (code)
 213         {
 214 .
 215
 216 for (sort keys %types) {
 217   (my $name = $_) =~ s/~/_/;
 218   print $out qq{\tcase 0x}.unpack('H*',$types{$_}).qq{: return "$name";\n};
 219 }
 220
 221 print $out <<".";
 222
 223         default: return "Unrecognised error";
 224         }
 225 }
 226
 227 void ThrowError(PSRETURN code)
 228 {
 229         switch (code)  // Use 'break' in case someone tries to continue from the exception
 230         {
 231 .
 232
 233 for (sort keys %types) {
 234   (my $name = $_) =~ s/~/_/;
 235   print $out qq{\tcase 0x}.unpack('H*',$types{$_}).qq{: throw PSERROR_$name(); break;\n};
 236 }
 237
 238 print $out <<".";
 239
 240         default: throw PSERROR_Error_InvalidError(); // Hmm...
 241         }
 242 }
 243 .
 244
 245 print "Finished.\n";
 246
 247 sub cpp_files {
 248   opendir my $d, $_[0] or die "Error opening directory '$_[0]' ($!)";
 249   my @f = readdir $d;
 250   my @files = map "$_[0]/$_", grep /\.(?:cpp|h)$/, @f;
 251   push @files, cpp_files("$_[0]/$_") for grep { !/^(?:workspaces|tools)$/ and /^[a-zA-Z0-9]+$/ and -d "$_[0]/$_" } @f;
 252   return @files;
 253 }