244 lines
5.7 KiB
Perl
Executable File
244 lines
5.7 KiB
Perl
Executable File
#!perl -w
|
|
|
|
++$|;
|
|
END { print "\n\nPress enter to exit.\n"; <STDIN> }
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
my ($source, $output);
|
|
|
|
for (@ARGV) {
|
|
# Note to self: "perl errorlist.pl --source=../../source/i18n --output=../../source/i18n/tests/ps/Errors.cpp"
|
|
if (/[-\/]\?|--\?|--help/) {
|
|
print <<EOH;
|
|
$0 parameters:
|
|
--source=../../source - root directory for source code
|
|
--output=../../source/ps/Errors.cpp - output file to generate
|
|
--help - route to enlightenment
|
|
EOH
|
|
exit;
|
|
} elsif (/^--source="?(.*?)"?$/) {
|
|
$source = $1;
|
|
} elsif (/^--output="?(.*?)"?$/) {
|
|
$output = $1;
|
|
}
|
|
}
|
|
|
|
$source ||= '../../source';
|
|
$output ||= "$source/ps/Errors.cpp";
|
|
|
|
print "Reading files from $source... ";
|
|
|
|
my (%topgroups, %groups, %types);
|
|
|
|
my @files = cpp_files("$source/");
|
|
|
|
my $loc = 0;
|
|
for (@files) {
|
|
open my $f, $_ or die "Error opening file '$_' ($!)";
|
|
while (<$f>) {
|
|
if (/^ERROR_/) {
|
|
if (/^ERROR_GROUP\((.+?)\)/) {
|
|
$topgroups{$1} = 1;
|
|
} elsif (/^ERROR_SUBGROUP\((.+?)\)/) {
|
|
$groups{join '~', split /,\s*/, $1} = 1;
|
|
} elsif (/^ERROR_TYPE\((.+?)\)/) {
|
|
$types{join '~', split /,\s*/, $1} = 1;
|
|
}
|
|
}
|
|
++$loc;
|
|
}
|
|
}
|
|
|
|
# Add commas to number in groups of three
|
|
1 while $loc =~ s/(\d+)(\d{3})/$1,$2/;
|
|
|
|
print "(".@files." files read - $loc lines of code)\n";
|
|
print "Generating $output... ";
|
|
|
|
# Add "PSERROR_Error_InvalidError", so that an error to throw when being
|
|
# told to throw an error that doesn't exist exists.
|
|
$topgroups{Error} = 1;
|
|
$types{'Error~InvalidError'} = 1;
|
|
|
|
open my $out, '>', "$output" or die "Error opening $output ($!)";
|
|
|
|
print $out <<'.';
|
|
// Auto-generated by errorlist.pl - do not edit.
|
|
|
|
#include "precompiled.h"
|
|
|
|
#include "Errors.h"
|
|
|
|
.
|
|
|
|
for (sort keys %topgroups) {
|
|
print $out "class PSERROR_$_ : public PSERROR {};\n";
|
|
}
|
|
|
|
print $out "\n";
|
|
|
|
for (sort { $a->[1] cmp $b->[1] } map [$_, do{(my $c=$_)=~s/~/_/;$c} ], keys %groups) {
|
|
my ($base, $name) = split /~/, $_->[0];
|
|
print $out "class PSERROR_${base}_$name : public PSERROR_$base {};\n";
|
|
}
|
|
|
|
print $out "\n";
|
|
|
|
for (sort { $a->[1] cmp $b->[1] } map [$_, do{(my $c=$_)=~s/~/_/;$c} ], keys %types) {
|
|
my ($base, $name) = split /~/, $_->[0];
|
|
print $out "class PSERROR_${base}_$name : public PSERROR_$base { public: PSRETURN getCode() const; };\n";
|
|
}
|
|
|
|
print $out "\n";
|
|
|
|
# The difficult bit:
|
|
|
|
=pod
|
|
|
|
mask
|
|
**** PSERROR
|
|
0001 PSERROR_ Err1
|
|
1*** PSERROR_Sec1
|
|
1001 PSERROR_Sec1_ Err1
|
|
1002 PSERROR_Sec1_ Err2
|
|
1003 PSERROR_Sec1_ Err3
|
|
11** PSERROR_Sec1_Sec1
|
|
1101 PSERROR_Sec1_Sec1_Err1
|
|
1102 PSERROR_Sec1_Sec1_Err2
|
|
2*** PSERROR_Sec2
|
|
2001 PSERROR_Sec2_ Err1
|
|
|
|
...so split into three sections (0 if null) plus final code...
|
|
|
|
=cut
|
|
|
|
my @sec_codes;
|
|
$sec_codes[$_]{''} = 1 for 0..2;
|
|
|
|
for (keys %types) {
|
|
my (@secs) = split /[~_]/;
|
|
my $err = pop @secs;
|
|
$sec_codes[$_]{$secs[$_] || ''} = 1 for 0..2;
|
|
}
|
|
|
|
for my $n (0..2) {
|
|
@{$sec_codes[$n]}{sort keys %{$sec_codes[$n]}} = 0 .. keys(%{$sec_codes[$n]})-1;
|
|
}
|
|
|
|
my ($last_sec, $last_err) = ('', 0);
|
|
for (sort keys %types) {
|
|
my (@secs) = split /[~_]/;
|
|
my $err = pop @secs;
|
|
my $id = join '', map chr $sec_codes[$_]{$secs[$_] || ''}, 0..2;
|
|
if ($id eq $last_sec) {
|
|
$id .= chr(++$last_err);
|
|
} else {
|
|
$last_sec = $id;
|
|
$id .= chr($last_err=1);
|
|
}
|
|
$types{$_} = $id;
|
|
}
|
|
|
|
for (sort keys %types) {
|
|
my ($base, $name) = split /~/;
|
|
print $out "extern const PSRETURN PSRETURN_${base}_${name} = 0x".unpack('H*', $types{$_}).";\n";
|
|
}
|
|
|
|
print $out "\n";
|
|
|
|
for (sort keys %topgroups) {
|
|
my (@secs) = $_;
|
|
my $id = join '', map chr $sec_codes[$_]{$secs[$_] || ''}, 0..2;
|
|
my $code = unpack 'H*', $id;
|
|
(my $mask = $code) =~ s/(\d\d)/$1+0 ? 'ff' : '00'/ge;
|
|
print $out "extern const PSRETURN MASK__PSRETURN_".join('_', @secs)." = 0x${mask}00;\n";
|
|
print $out "extern const PSRETURN CODE__PSRETURN_".join('_', @secs)." = 0x${code}00;\n";
|
|
}
|
|
|
|
for (sort keys %groups) {
|
|
my (@secs) = split /[_~]/;
|
|
my $id = join '', map chr $sec_codes[$_]{$secs[$_] || ''}, 0..2;
|
|
my $code = unpack 'H*', $id;
|
|
(my $mask = $code) =~ s/(\d\d)/$1+0 ? 'ff' : '00'/ge;
|
|
print $out "extern const PSRETURN MASK__PSRETURN_".join('_', @secs)." = 0x${mask}00;\n";
|
|
print $out "extern const PSRETURN CODE__PSRETURN_".join('_', @secs)." = 0x${code}00;\n";
|
|
}
|
|
|
|
print $out "\n";
|
|
|
|
for (sort keys %types) {
|
|
my $code = unpack 'H*', $types{$_};
|
|
s/~/_/;
|
|
print $out "extern const PSRETURN MASK__PSRETURN_$_ = 0xffffffff;\n";
|
|
print $out "extern const PSRETURN CODE__PSRETURN_$_ = 0x$code;\n";
|
|
}
|
|
|
|
# End of difficult bit.
|
|
|
|
print $out "\n";
|
|
|
|
|
|
for (sort keys %types) {
|
|
my ($base, $name) = split /~/;
|
|
print $out qq~PSRETURN PSERROR_${base}_${name}::getCode() const { return 0x~.unpack('H*',$types{$_}).qq~; }\n~;
|
|
}
|
|
|
|
print $out <<".";
|
|
|
|
const char* PSERROR::what() const throw ()
|
|
{
|
|
return GetErrorString(getCode());
|
|
}
|
|
|
|
const char* GetErrorString(const PSERROR& err)
|
|
{
|
|
return GetErrorString(err.getCode());
|
|
}
|
|
|
|
const char* GetErrorString(PSRETURN code)
|
|
{
|
|
switch (code)
|
|
{
|
|
.
|
|
|
|
for (sort keys %types) {
|
|
(my $name = $_) =~ s/~/_/;
|
|
print $out qq{\tcase 0x}.unpack('H*',$types{$_}).qq{: return "$name";\n};
|
|
}
|
|
|
|
print $out <<".";
|
|
|
|
default: return "Unrecognised error";
|
|
}
|
|
}
|
|
|
|
void ThrowError(PSRETURN code)
|
|
{
|
|
switch (code) // Use 'break' in case someone tries to continue from the exception
|
|
{
|
|
.
|
|
|
|
for (sort keys %types) {
|
|
(my $name = $_) =~ s/~/_/;
|
|
print $out qq{\tcase 0x}.unpack('H*',$types{$_}).qq{: throw PSERROR_$name(); break;\n};
|
|
}
|
|
|
|
print $out <<".";
|
|
|
|
default: throw PSERROR_Error_InvalidError(); // Hmm...
|
|
}
|
|
}
|
|
.
|
|
|
|
print "Finished.\n";
|
|
|
|
sub cpp_files {
|
|
opendir my $d, $_[0] or die "Error opening directory '$_[0]' ($!)";
|
|
my @f = readdir $d;
|
|
my @files = map "$_[0]/$_", grep /\.(?:cpp|h)$/, @f;
|
|
push @files, cpp_files("$_[0]/$_") for grep { !/^(?:workspaces|tools)$/ and /^[a-zA-Z0-9]+$/ and -d "$_[0]/$_" } @f;
|
|
return @files;
|
|
}
|