From: Christian Hansen <chansen@cpan.org>
Date: Tue, 14 Jun 2005 15:16:24 +0000 (+0000)
Subject: Added Catalyst::Exception
X-Git-Tag: 5.7099_04~1316
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=a2f2cde95194a17fe2401ae58c92b5494bac599f;hp=ae4e40a7d5968d8086a86bff588a0989f167d5db

Added Catalyst::Exception
---

diff --git a/Changes b/Changes
index 1f7301e..66d132c 100644
--- a/Changes
+++ b/Changes
@@ -1,11 +1,12 @@
 This file documents the revision history for Perl extension Catalyst.
 
-5.24  2005-06-03 02:30:00
+5.24  2005-00-00 00:00:00
         - Make module build cons README automatically.
         - Prettify home path by resolving '..' (Andy Grundman)
         - Improved helper templates a bit, new naming scheme for tests...
         - Added support for case sensitivity, MyApp->config->{case_sensitive}
         - Added $c->detach for non returning forwards
+        - Added unified error handling, Catalyst::Exception
 
 5.23  2005-06-03 02:30:00
         - added support for non Catalyst::Base components to live in namespace
diff --git a/MANIFEST b/MANIFEST
index 9201f55..06b7747 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -28,6 +28,7 @@ lib/Catalyst/Engine/HTTP/Daemon.pm
 lib/Catalyst/Engine/SpeedyCGI.pm
 lib/Catalyst/Engine/SpeedyCGI/Base.pm
 lib/Catalyst/Engine/Test.pm
+lib/Catalyst/Exception.pm
 lib/Catalyst/Helper.pm
 lib/Catalyst/Log.pm
 lib/Catalyst/Manual.pod
diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index 599a95d..ebf88a3 100644
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -3,6 +3,7 @@ package Catalyst;
 use strict;
 use base 'Catalyst::Base';
 use UNIVERSAL::require;
+use Catalyst::Exception;
 use Catalyst::Log;
 use Catalyst::Utils;
 use Text::ASCIITable;
@@ -187,7 +188,9 @@ sub import {
             }
 
             else {
-                die( qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
+                Catalyst::Exception->throw(
+                    message => qq/Unsupported mod_perl version: $ENV{MOD_PERL}/
+                );
             }
         }
 
@@ -196,7 +199,9 @@ sub import {
         }
 
         else {
-            die( qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
+            Catalyst::Exception->throw(
+                message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/
+            );
         }
     }
 
@@ -229,7 +234,11 @@ sub import {
 
             $plugin->require;
 
-            if ($@) { die qq/Couldn't load plugin "$plugin", "$@"/ }
+            if ( $@ ) { 
+                Catalyst::Exception->throw(
+                    message => qq/Couldn't load plugin "$plugin", "$@"/
+                );
+            }
             else {
                 push @plugins, $plugin;
                 no strict 'refs';
@@ -254,7 +263,13 @@ sub import {
     $dispatcher = "Catalyst::Dispatcher::$appdis" if $appdis;
 
     $dispatcher->require;
-    die qq/Couldn't load dispatcher "$dispatcher", "$@"/ if $@;
+    
+    if ( $@ ) {
+        Catalyst::Exception->throw(
+            message => qq/Couldn't load dispatcher "$dispatcher", "$@"/
+        );
+    }
+
     {
         no strict 'refs';
         push @{"$caller\::ISA"}, $dispatcher;
@@ -269,7 +284,12 @@ sub import {
     $engine = "Catalyst::Engine::$appeng" if $appeng;
 
     $engine->require;
-    die qq/Couldn't load engine "$engine", "$@"/ if $@;
+    
+    if ( $@ ) {
+        Catalyst::Exception->throw(
+            message => qq/Couldn't load engine "$engine", "$@"/
+        );
+    }
 
     {
         no strict 'refs';
@@ -350,13 +370,24 @@ Classdata accessor/mutator will be created, class loaded and instantiated.
 sub plugin {
     my ( $class, $name, $plugin, @args ) = @_;
     $plugin->require;
-    my $error = $UNIVERSAL::require::ERROR;
-    die qq/Couldn't load instant plugin "$plugin", "$error"/ if $error;
+    
+    if ( my $error = $UNIVERSAL::require::ERROR ) {
+        Catalyst::Exception->throw(
+            message => qq/Couldn't load instant plugin "$plugin", "$error"/
+        );
+    }    
+    
     eval { $plugin->import };
     $class->mk_classdata($name);
     my $obj;
     eval { $obj = $plugin->new(@args) };
-    die qq/Couldn't instantiate instant plugin "$plugin", "$@"/ if $@;
+
+    if ( $@ ) {
+        Catalyst::Exception->throw(
+            message => qq/Couldn't instantiate instant plugin "$plugin", "$@"/
+        );
+    }
+
     $class->$name($obj);
     $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
       if $class->debug;
diff --git a/lib/Catalyst/Base.pm b/lib/Catalyst/Base.pm
index dd38bea..789c6ab 100644
--- a/lib/Catalyst/Base.pm
+++ b/lib/Catalyst/Base.pm
@@ -2,6 +2,8 @@ package Catalyst::Base;
 
 use strict;
 use base qw/Class::Data::Inheritable Class::Accessor::Fast/;
+
+use Catalyst::Exception;
 use NEXT;
 
 __PACKAGE__->mk_classdata($_) for qw/_attr_cache _action_cache _config/;
@@ -104,7 +106,10 @@ sub config {
 =cut
 
 sub process {
-    die( ( ref $_[0] || $_[0] ) . " did not override Catalyst::Base::process" );
+
+    Catalyst::Exception->throw( 
+        message => ( ref $_[0] || $_[0] ) . " did not override Catalyst::Base::process"
+    );
 }
 
 =item FETCH_CODE_ATTRIBUTES
diff --git a/lib/Catalyst/Dispatcher.pm b/lib/Catalyst/Dispatcher.pm
index 72a8ef3..ffb20e9 100644
--- a/lib/Catalyst/Dispatcher.pm
+++ b/lib/Catalyst/Dispatcher.pm
@@ -2,6 +2,7 @@ package Catalyst::Dispatcher;
 
 use strict;
 use base 'Class::Data::Inheritable';
+use Catalyst::Exception;
 use Catalyst::Utils;
 use Text::ASCIITable;
 use Tree::Simple;
diff --git a/lib/Catalyst/Engine.pm b/lib/Catalyst/Engine.pm
index f2bcba3..691bd67 100644
--- a/lib/Catalyst/Engine.pm
+++ b/lib/Catalyst/Engine.pm
@@ -10,6 +10,7 @@ use HTML::Entities;
 use HTTP::Headers;
 use Time::HiRes qw/gettimeofday tv_interval/;
 use Text::ASCIITable;
+use Catalyst::Exception;
 use Catalyst::Request;
 use Catalyst::Request::Upload;
 use Catalyst::Response;
@@ -732,8 +733,12 @@ sub setup_components {
         eval { $instance = $component->new( $context, $config ); };
 
         if ( my $error = $@ ) {
+            
             chomp $error;
-            die qq/Couldn't instantiate component "$component", "$error"/;
+            
+            Catalyst::Exception->throw( 
+                message => qq/Couldn't instantiate component "$component", "$error"/
+            );
         }
 
         return $instance;
@@ -752,8 +757,12 @@ sub setup_components {
     };
 
     if ( my $error = $@ ) {
+        
         chomp $error;
-        die qq/Couldn't load components "$error"/;
+        
+        Catalyst::Exception->throw( 
+            message => qq/Couldn't load components "$error"/ 
+        );
     }
 
     for my $component ( $self->_components($self) ) {
diff --git a/lib/Catalyst/Engine/CGI.pm b/lib/Catalyst/Engine/CGI.pm
index 409ce5a..11d8ebf 100644
--- a/lib/Catalyst/Engine/CGI.pm
+++ b/lib/Catalyst/Engine/CGI.pm
@@ -3,6 +3,7 @@ package Catalyst::Engine::CGI;
 use strict;
 use base 'Catalyst::Engine::CGI::Base';
 
+use Catalyst::Exception;
 use CGI;
 
 our @compile = qw[
@@ -132,7 +133,10 @@ sub prepare_request {
 
         else {
             my $class = ref($object);
-            die( qq/Invalid argument $object/ );
+            
+            Catalyst::Exception->throw(
+                message => qq/Unknown object '$object'/
+            );
         }
     }
 
diff --git a/lib/Catalyst/Engine/HTTP/Base.pm b/lib/Catalyst/Engine/HTTP/Base.pm
index a5df9b8..ec0f2d5 100644
--- a/lib/Catalyst/Engine/HTTP/Base.pm
+++ b/lib/Catalyst/Engine/HTTP/Base.pm
@@ -3,6 +3,7 @@ package Catalyst::Engine::HTTP::Base;
 use strict;
 use base 'Catalyst::Engine';
 
+use Catalyst::Exception;
 use Class::Struct ();
 use HTTP::Headers::Util 'split_header_words';
 use HTTP::Request;
@@ -115,8 +116,14 @@ sub prepare_parameters {
             if ( $parameters{filename} ) {
 
                 my $fh = File::Temp->new( UNLINK => 0 );
-                $fh->write( $part->content ) or die $!;
-                $fh->flush or die $!;
+                
+                unless ( $fh->write( $part->content ) ) {
+                    Catalyst::Exception->throw( message => $! );
+                }
+                
+                unless ( $fh->flush ) {
+                    Catalyst::Exception->throw( message => $! );
+                }
 
                 my $upload = Catalyst::Request::Upload->new(
                     filename => $parameters{filename},
@@ -125,7 +132,9 @@ sub prepare_parameters {
                     type     => $part->content_type
                 );
 
-                $fh->close;
+                unless ( $fh->close ) {
+                    Catalyst::Exception->throw( message => $! );
+                }
 
                 push( @uploads, $parameters{name}, $upload );
                 push( @params,  $parameters{name}, $parameters{filename} );
diff --git a/lib/Catalyst/Engine/HTTP/Daemon.pm b/lib/Catalyst/Engine/HTTP/Daemon.pm
index 168f9c3..aeaeea5 100644
--- a/lib/Catalyst/Engine/HTTP/Daemon.pm
+++ b/lib/Catalyst/Engine/HTTP/Daemon.pm
@@ -3,6 +3,7 @@ package Catalyst::Engine::HTTP::Daemon;
 use strict;
 use base 'Catalyst::Engine::HTTP::Base';
 
+use Catalyst::Exception;
 use IO::Select;
 use IO::Socket;
 
@@ -95,7 +96,10 @@ sub run {
     );
 
     unless ( defined $daemon ) {
-        die(qq/Failed to create daemon. Reason: '$!'/);
+
+        Catalyst::Exception->throw(
+            message =>  qq/Failed to create daemon. Reason: '$!'/
+        );
     }
 
     my $base = URI->new( $daemon->url )->canonical;
diff --git a/lib/Catalyst/Exception.pm b/lib/Catalyst/Exception.pm
new file mode 100644
index 0000000..fbb75e4
--- /dev/null
+++ b/lib/Catalyst/Exception.pm
@@ -0,0 +1,64 @@
+package Catalyst::Exception;
+
+BEGIN { 
+    push( @ISA, $CATALYST_EXCEPTION_CLASS || 'Catalyst::Exception::Base' );
+}
+
+use strict;
+use vars qw[@ISA $CATALYST_EXCEPTION_CLASS];
+
+package Catalyst::Exception::Base;
+
+use strict;
+use Carp ();
+
+=head1 NAME
+
+Catalyst::Exception - Catalyst Exception Class
+
+=head1 SYNOPSIS
+
+   Catalyst::Exception->throw( qq/Fatal exception/ );
+
+See also L<Catalyst>.
+
+=head1 DESCRIPTION
+
+This is the Catalyst Exception class.
+
+=head1 METHODS
+
+=over 4
+
+=item throw($message)
+
+Throws a fatal exception.
+
+=cut
+
+sub throw {
+    my $class  = shift;
+    my %params = @_ == 1 ? ( error => $_[0] ) : @_;
+
+    my $message = $params{message} || $params{error} || $! || '';
+
+    local $Carp::CarpLevel = 1;
+
+    Carp::croak($message);
+}
+
+=back
+
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri@cpan.org>
+Christian Hansen, C<ch@ngmedia.com>
+
+=head1 COPYRIGHT
+
+This program is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Catalyst/Helper.pm b/lib/Catalyst/Helper.pm
index 21cb7e7..e4cd7f5 100644
--- a/lib/Catalyst/Helper.pm
+++ b/lib/Catalyst/Helper.pm
@@ -9,6 +9,7 @@ use IO::File;
 use FindBin;
 use Template;
 use Catalyst;
+use Catalyst::Exception;
 
 my %cache;
 
@@ -102,7 +103,13 @@ sub mk_component {
         my @args   = @_;
         my $class  = "Catalyst::Helper::$helper";
         eval "require $class";
-        die qq/Couldn't load helper "$class", "$@"/ if $@;
+        
+        if ( $@ ) {
+            Catalyst::Exception->throw( 
+                message => qq/Couldn't load helper "$class", "$@"/
+            );
+        }
+        
         if ( $class->can('mk_stuff') ) {
             return 1 unless $class->mk_stuff( $self, @args );
         }
@@ -145,7 +152,13 @@ sub mk_component {
             $comp = 'Controller' if $type eq 'C';
             my $class = "Catalyst::Helper::$comp\::$helper";
             eval "require $class";
-            die qq/Couldn't load helper "$class", "$@"/ if $@;
+            
+            if ( $@ ) {
+                Catalyst::Exception->throw( 
+                    message => qq/Couldn't load helper "$class", "$@"/
+                );
+            }            
+        
             if ( $class->can('mk_compclass') ) {
                 return 1 unless $class->mk_compclass( $self, @args );
             }
@@ -182,7 +195,10 @@ sub mk_dir {
         print qq/created "$dir"\n/;
         return 1;
     }
-    die qq/Couldn't create "$dir", "$!"/;
+    
+    Catalyst::Exception->throw( 
+        message => qq/Couldn't create "$dir", "$!"/
+    );    
 }
 
 =head3 mk_file
@@ -202,7 +218,10 @@ sub mk_file {
         print qq/created "$file"\n/;
         return 1;
     }
-    die qq/Couldn't create "$file", "$!"/;
+    
+    Catalyst::Exception->throw( 
+        message => qq/Couldn't create "$file", "$!"/
+    );       
 }
 
 =head3 next_test
diff --git a/lib/Catalyst/Log.pm b/lib/Catalyst/Log.pm
index 9792393..d9d03b8 100644
--- a/lib/Catalyst/Log.pm
+++ b/lib/Catalyst/Log.pm
@@ -169,9 +169,13 @@ Disable log levels
     $log->disable( 'warn', 'error' );
 
 =item is_debug
+
 =item is_error
+
 =item is_fatal
+
 =item is_info
+
 =item is_warn
 
 Is the log level active?
diff --git a/lib/Catalyst/Request/Upload.pm b/lib/Catalyst/Request/Upload.pm
index 783733b..ff0b5de 100644
--- a/lib/Catalyst/Request/Upload.pm
+++ b/lib/Catalyst/Request/Upload.pm
@@ -3,6 +3,7 @@ package Catalyst::Request::Upload;
 use strict;
 use base 'Class::Accessor::Fast';
 
+use Catalyst::Exception;
 use File::Copy ();
 use IO::File   ();
 
@@ -62,8 +63,16 @@ Opens tempname and returns a C<IO::File> handle.
 sub fh {
     my $self = shift;
 
-    my $fh = IO::File->new( $self->tempname, IO::File::O_RDONLY )
-      or die( "Can't open ", $self->tempname, ": ", $! );
+    my $fh = IO::File->new( $self->tempname, IO::File::O_RDONLY );
+    
+    unless ( defined $fh ) {
+        
+        my $filename = $self->tempname;
+        
+        Catalyst::Exception->throw(
+            message => qq/Can't open '$filename': '$!'/
+        );
+    }
 
     return $fh;
 }
diff --git a/lib/Catalyst/Test.pm b/lib/Catalyst/Test.pm
index a9f74e5..b7fdb6d 100644
--- a/lib/Catalyst/Test.pm
+++ b/lib/Catalyst/Test.pm
@@ -2,6 +2,7 @@ package Catalyst::Test;
 
 use strict;
 
+use Catalyst::Exception;
 use Catalyst::Utils;
 use UNIVERSAL::require;
 
@@ -78,8 +79,15 @@ sub import {
 
     else {
         $class->require;
-        my $error = $UNIVERSAL::require::ERROR;
-        die qq/Couldn't load "$class", "$error"/ if $@;
+        
+        if ( $@ ) {
+            
+            my $error = $UNIVERSAL::require::ERROR;
+            
+            Catalyst::Exception->throw(
+                message => qq/Couldn't load "$class", "$error"/
+            );
+        }
 
         $class->import;
 
diff --git a/lib/Catalyst/Utils.pm b/lib/Catalyst/Utils.pm
index 50fb0c3..c842231 100644
--- a/lib/Catalyst/Utils.pm
+++ b/lib/Catalyst/Utils.pm
@@ -2,6 +2,7 @@ package Catalyst::Utils;
 
 use strict;
 use attributes ();
+use Catalyst::Exception;
 use HTTP::Request;
 use Path::Class;
 use URI;
@@ -155,7 +156,13 @@ sub reflect_actions {
     my $class   = shift;
     my $actions = [];
     eval '$actions = $class->_action_cache';
-    die qq/Couldn't reflect actions of component "$class", "$@"/ if $@;
+    
+    if ( $@ ) {
+        Catalyst::Exception->throw(
+            message => qq/Couldn't reflect actions of component "$class", "$@"/
+        );
+    }
+    
     return $actions;
 }