GPL_bin_fullset/NaturalDocs/Modules/NaturalDocs/Error.pm

   1 ###############################################################################
   2 #
   3 #   Package: NaturalDocs::Error
   4 #
   5 ###############################################################################
   6 #
   7 #   Manages all aspects of error handling in Natural Docs.
   8 #
   9 ###############################################################################
  10
  11 # This file is part of Natural Docs, which is Copyright © 2003-2010 Greg Valure
  12 # Natural Docs is licensed under version 3 of the GNU Affero General Public License (AGPL)
  13 # Refer to License.txt for the complete details
  14
  15 use strict;
  16 use integer;
  17
  18 $SIG{'__DIE__'} = \&NaturalDocs::Error::CatchDeath;
  19
  20
  21 package NaturalDocs::Error;
  22
  23
  24 ###############################################################################
  25 # Group: Variables
  26
  27
  28 #
  29 #   handle: FH_CRASHREPORT
  30 #   The filehandle used for generating crash reports.
  31 #
  32
  33
  34 #
  35 #   var: stackTrace
  36 #   The stack trace generated by <CatchDeath()>.
  37 #
  38 my $stackTrace;
  39
  40
  41 #
  42 #   var: softDeath
  43 #   Whether the program exited using <SoftDeath()>.
  44 #
  45 my $softDeath;
  46
  47
  48 #
  49 #   var: currentAction
  50 #   What Natural Docs was doing when it crashed.  This stores strings generated by functions like <OnStartParsing()>.
  51 #
  52 my $currentAction;
  53
  54
  55 ###############################################################################
  56 # Group: Functions
  57
  58
  59 #
  60 #   Function: SoftDeath
  61 #
  62 #   Generates a "soft" death, which means the program exits like with Perl's die(), but no crash report will be generated.
  63 #
  64 #   Parameter:
  65 #
  66 #       message - The error message to die with.
  67 #
  68 sub SoftDeath #(message)
  69     {
  70     my ($self, $message) = @_;
  71
  72     $softDeath = 1;
  73     if ($message !~ /\n$/)
  74         {  $message .= "\n";  };
  75
  76     die $message;
  77     };
  78
  79
  80 #
  81 #   Function: OnStartParsing
  82 #
  83 #   Called whenever <NaturalDocs::Parser> starts parsing a source file.
  84 #
  85 sub OnStartParsing #(FileName file)
  86     {
  87     my ($self, $file) = @_;
  88     $currentAction = 'Parsing ' . $file;
  89     };
  90
  91
  92 #
  93 #   Function: OnEndParsing
  94 #
  95 #   Called whenever <NaturalDocs::Parser> is done parsing a source file.
  96 #
  97 sub OnEndParsing #(FileName file)
  98     {
  99     my ($self, $file) = @_;
 100     $currentAction = undef;
 101     };
 102
 103
 104 #
 105 #   Function: OnStartBuilding
 106 #
 107 #   Called whenever <NaturalDocs::Builder> starts building a source file.
 108 #
 109 sub OnStartBuilding #(FileName file)
 110     {
 111     my ($self, $file) = @_;
 112     $currentAction = 'Building ' . $file;
 113     };
 114
 115
 116 #
 117 #   Function: OnEndBuilding
 118 #
 119 #   Called whenever <NaturalDocs::Builder> is done building a source file.
 120 #
 121 sub OnEndBuilding #(FileName file)
 122     {
 123     my ($self, $file) = @_;
 124     $currentAction = undef;
 125     };
 126
 127
 128 #
 129 #   Function: HandleDeath
 130 #
 131 #   Should be called whenever Natural Docs dies out of execution.
 132 #
 133 sub HandleDeath
 134     {
 135     my $self = shift;
 136
 137     my $reason = $::EVAL_ERROR;
 138     $reason =~ s/[\n\r]+$//;
 139
 140     my $errorMessage =
 141          "\n"
 142          . "Natural Docs encountered the following error and was stopped:\n"
 143          . "\n"
 144          . "   " . $reason . "\n"
 145          . "\n"
 146
 147          . "You can get help at the following web site:\n"
 148          . "\n"
 149          . "   " . NaturalDocs::Settings->AppURL() . "\n"
 150          . "\n";
 151
 152     if (!$softDeath)
 153         {
 154         my $crashReport = $self->GenerateCrashReport();
 155
 156         if ($crashReport)
 157             {
 158             $errorMessage .=
 159              "If sending an error report, please include the information found in the\n"
 160              . "following file:\n"
 161              . "\n"
 162              . "   " . $crashReport . "\n"
 163              . "\n";
 164             }
 165         else
 166             {
 167             $errorMessage .=
 168              "If sending an error report, please include the following information:\n"
 169              . "\n"
 170              . "   Natural Docs version: " . NaturalDocs::Settings->TextAppVersion() . "\n"
 171              . "   Perl version: " . $self->PerlVersion() . " on " . $::OSNAME . "\n"
 172              . "\n";
 173              };
 174         };
 175
 176     die $errorMessage;
 177     };
 178
 179
 180 ###############################################################################
 181 # Group: Support Functions
 182
 183
 184 #
 185 #   Function: PerlVersion
 186 #   Returns the current Perl version as a string.
 187 #
 188 sub PerlVersion
 189     {
 190     my $self = shift;
 191
 192     my $perlVersion;
 193
 194     if ($^V)
 195         {  $perlVersion = sprintf('%vd', $^V);  }
 196     if (!$perlVersion || substr($perlVersion, 0, 1) eq '%')
 197         {  $perlVersion = $];  };
 198
 199     return $perlVersion;
 200     };
 201
 202
 203 #
 204 #   Function: GenerateCrashReport
 205 #
 206 #   Generates a report and returns the <FileName> it's located at.  Returns undef if it could not generate one.
 207 #
 208 sub GenerateCrashReport
 209     {
 210     my $self = shift;
 211
 212     my $errorMessage = $::EVAL_ERROR;
 213     $errorMessage =~ s/[\r\n]+$//;
 214
 215     my $reportDirectory = NaturalDocs::Settings->ProjectDirectory();
 216
 217     if (!$reportDirectory || !-d $reportDirectory)
 218         {  return undef;  };
 219
 220     my $file = NaturalDocs::File->JoinPaths($reportDirectory, 'LastCrash.txt');
 221
 222     open(FH_CRASHREPORT, '>' . $file) or return undef;
 223
 224     print FH_CRASHREPORT
 225     'Crash Message:' . "\n\n"
 226     . '   ' . $errorMessage . "\n\n";
 227
 228     if ($currentAction)
 229         {
 230         print FH_CRASHREPORT
 231         'Current Action:' . "\n\n"
 232         . '   ' . $currentAction . "\n\n";
 233         };
 234
 235     print FH_CRASHREPORT
 236     'Natural Docs version ' . NaturalDocs::Settings->TextAppVersion() . "\n"
 237     . 'Perl version ' . $self->PerlVersion . ' on ' . $::OSNAME . "\n\n"
 238     . 'Command Line:' . "\n\n"
 239     . '   ' . join(' ', @ARGV) . "\n\n";
 240
 241     if ($stackTrace)
 242         {
 243         print FH_CRASHREPORT
 244         'Stack Trace:' . "\n\n"
 245         . $stackTrace;
 246         }
 247     else
 248         {
 249         print FH_CRASHREPORT
 250         'Stack Trace not available.' . "\n\n";
 251         };
 252
 253     close(FH_CRASHREPORT);
 254     return $file;
 255     };
 256
 257
 258 ###############################################################################
 259 # Group: Signal Handlers
 260
 261
 262 #
 263 #   Function: CatchDeath
 264 #
 265 #   Catches Perl die calls.
 266 #
 267 #   *IMPORTANT:* This function is a signal handler and should not be called manually.  Also, because of this, it does not have
 268 #   a $self parameter.
 269 #
 270 #   Parameters:
 271 #
 272 #       message - The error message to die with.
 273 #
 274 sub CatchDeath #(message)
 275     {
 276     # No $self because it's a signal handler.
 277     my $message = shift;
 278
 279     if (!$NaturalDocs::Error::softDeath)
 280         {
 281         my $i = 0;
 282         my ($lastPackage, $lastFile, $lastLine, $lastFunction);
 283
 284         while (my ($package, $file, $line, $function) = caller($i))
 285             {
 286             if ($i != 0)
 287                 {  $stackTrace .= ', called from' . "\n";  };
 288
 289             $stackTrace .= '   ' . $function;
 290
 291             if (defined $lastLine)
 292                 {
 293                 $stackTrace .= ', line ' . $lastLine;
 294
 295                 if ($function !~ /^NaturalDocs::/)
 296                     {  $stackTrace .= ' of ' . $lastFile;  };
 297                 };
 298
 299             ($lastPackage, $lastFile, $lastLine, $lastFunction) = ($package, $file, $line, $function);
 300             $i++;
 301             };
 302         };
 303     };
 304
 305
 306 1;