4 END { print "\n\nPress enter to exit.\n"; <STDIN
> }
12 # Note to self: "perl errorlist.pl --source=../../source/i18n --output=../../source/i18n/tests/ps/Errors.cpp"
13 if (/[-\/]\?|--\?|--help
/) {
16 --source=../../source - root directory for source code
17 --output=../../source/ps/Errors.cpp - output file to generate
18 --help - route to enlightenment
21 } elsif (/^--source="?(.*?)"?$/) {
23 } elsif (/^--output="?(.*?)"?$/) {
28 $source ||= '../../source';
29 $output ||= "$source/ps/Errors.cpp";
31 print "Reading files from $source... ";
33 my (%topgroups, %groups, %types);
35 my @files = cpp_files
("$source/");
39 open my $f, $_ or die "Error opening file '$_' ($!)";
42 if (/^ERROR_GROUP\((.+?)\)/) {
44 } elsif (/^ERROR_SUBGROUP\((.+?)\)/) {
45 $groups{join '~', split /,\s*/, $1} = 1;
46 } elsif (/^ERROR_TYPE\((.+?)\)/) {
47 $types{join '~', split /,\s*/, $1} = 1;
54 # Add commas to number in groups of three
55 1 while $loc =~ s/(\d+)(\d{3})/$1,$2/;
57 print "(".@files." files read - $loc lines of code)\n";
58 print "Generating $output... ";
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;
65 open my $out, '>', "$output" or die "Error opening $output ($!)";
68 // Auto
-generated by errorlist
.pl
- do not edit
.
70 #include "precompiled.h"
76 for (sort keys %topgroups) {
77 print $out "class PSERROR_$_ : public PSERROR { protected: PSERROR_$_(const char* msg); };\n";
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";
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";
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
111 2001 PSERROR_Sec2_ Err1
113 ...so split into three sections (0 if null) plus final code...
118 $sec_codes[$_]{''} = 1 for 0..2;
121 my (@secs) = split /[~_]/;
123 $sec_codes[$_]{$secs[$_] || ''} = 1 for 0..2;
127 @
{$sec_codes[$n]}{sort keys %{$sec_codes[$n]}} = 0 .. keys(%{$sec_codes[$n]})-1;
130 my ($last_sec, $last_err) = ('', 0);
131 for (sort keys %types) {
132 my (@secs) = split /[~_]/;
134 my $id = join '', map chr $sec_codes[$_]{$secs[$_] || ''}, 0..2;
135 if ($id eq $last_sec) {
136 $id .= chr(++$last_err);
139 $id .= chr($last_err=1);
144 for (sort keys %types) {
145 my ($base, $name) = split /~/;
146 print $out "extern const PSRETURN PSRETURN_${base}_${name} = 0x".unpack('H*', $types{$_}).";\n";
151 for (sort keys %topgroups) {
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";
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";
171 for (sort keys %types) {
172 my $code = unpack 'H*', $types{$_};
174 print $out "extern const PSRETURN MASK__PSRETURN_$_ = 0xffffffff;\n";
175 print $out "extern const PSRETURN CODE__PSRETURN_$_ = 0x$code;\n";
178 # End of difficult bit.
182 for (sort keys %topgroups) {
183 print $out "PSERROR_${_}::PSERROR_${_}(const char* msg) : PSERROR(msg) { }\n";
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";
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";
203 PSERROR
::PSERROR
(const char
* msg
) : m_msg
(msg
) { }
205 const char
* PSERROR
::what
() const throw
()
207 return m_msg ? m_msg
: GetErrorString
(getCode
());
210 const char
* GetErrorString
(PSRETURN code
)
216 for (sort keys %types) {
217 (my $name = $_) =~ s/~/_/;
218 print $out qq{\tcase
0x
}.unpack('H*',$types{$_}).qq{: return "$name";\n};
223 default: return "Unrecognised error";
227 void ThrowError
(PSRETURN code
)
229 switch
(code
) // Use
'break' in case someone tries to
continue from the exception
233 for (sort keys %types) {
234 (my $name = $_) =~ s/~/_/;
235 print $out qq{\tcase
0x
}.unpack('H*',$types{$_}).qq{: throw PSERROR_
$name(); break;\n};
240 default: throw PSERROR_Error_InvalidError
(); // Hmm
...
248 opendir my $d, $_[0] or die "Error opening directory '$_[0]' ($!)";
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;