New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Structured exceptions for Moose #38

Merged
merged 685 commits into from Oct 18, 2013
Commits
The table of contents is too big for display.
+23,186 −1,473
Diff settings

Always

Just for now

View
@@ -0,0 +1,274 @@
#!/usr/bin/env perl
use strict;
use warnings;
use Moose;
use Class::Load 0.07 qw(load_class);
my $dir;
my $path = 'lib/Moose/Exception/';
opendir( $dir, $path) or die $!;
my $number = 0;
print "package Moose::Manual::Exceptions::Manifest;\n";
my $exceptionsToMsgHashRef = getExceptionsToMessages();
while( my $file = readdir($dir) )
{
my %exceptions = %$exceptionsToMsgHashRef;
my ($exception, $description, $attributesText, $superclasses, $consumedRoles, $exceptionMessages);
my (@attributes, @roles, @superClasses, @rolesNames, @superClassNames);
if( !(-d 'lib/Moose/Exception/'.$file) )
{
$file =~ s/\.pm//i;
$exception = "Moose::Exception::".$file;
load_class( $exception );
my $metaClass = Class::MOP::class_of( $exception );
my @superClasses = $metaClass->superclasses;
my @roles = $metaClass->calculate_all_roles;
my @attributes = $metaClass->get_all_attributes;
my $fileHandle;
@rolesNames = map {
my $name = $_->name;
if( $name =~ /\|/ ) {
undef;
} else {
$name;
}
} @roles;
$superclasses = placeCommasAndAnd( @superClasses );
$consumedRoles = placeCommasAndAnd( @rolesNames );
foreach( @attributes )
{
my $attribute = $_;
my $name = $attribute->name;
my $traits;
if( $attribute->has_applied_traits ) {
my @traitsArray = @{$attribute->applied_traits};
$traits = "has traits of ";
my $traitsStr = placeCommasAndAnd( @traitsArray );
$traits .= $traitsStr;
}
my ( $tc, $type_constraint ) = ( $attribute->type_constraint->name, "isa " );
if( $tc =~ /::/ && !(defined $traits) ) {
$type_constraint .= "L<".$tc.">";
} else {
$type_constraint .= $tc;
}
my $readOrWrite = ( $attribute->has_writer ? 'is read-write' : 'is read-only' );
my $required = ( $attribute->is_required ? 'is required' : 'is optional' );
my $predicate = ( $attribute->has_predicate ? 'has a predicate C<'.$attribute->predicate.'>': undef );
my $default;
if( $attribute->has_default ) {
if( $tc eq "Str" ) {
$default = 'has a default value "'.$attribute->default.'"';
}
else {
$default = 'has a default value '.$attribute->default;
}
}
my $handlesText;
if( $attribute->has_handles ) {
my %handles = %{$attribute->handles};
my @keys = keys( %handles );
$handlesText = "This attribute has handles as follows:";
for( my $i = 0; $i <= $#keys; $i++ ) {
next
if( $keys[$i] =~ /^_/ );
my $strText = sprintf("\n %-25s=> %s", $keys[$i], $handles{$keys[$i]});
$handlesText .= $strText;
}
}
$exceptionMessages = "=back\n\n=head4 Sample Error Message";
my $msgOrMsgRef = $exceptions{$file};
if( ref $msgOrMsgRef eq "ARRAY" ) {
$exceptionMessages .= "s:\n\n";
my @array = @$msgOrMsgRef;
foreach( @array ) {
$exceptionMessages .= " $_";
}
} else {
$exceptionMessages .= ":\n\n";
if( $exceptions{$file} ) {
$exceptionMessages .= " ".$exceptions{$file};
}
}
$exceptionMessages .= "\n";
$attributesText .= "=item B<< \$exception->$name >>\n\n";
if( $attribute->has_documentation ) {
$attributesText .= $attribute->documentation."\n\n";
} else {
$attributesText .= "This attribute $readOrWrite, $type_constraint".
( defined $predicate ? ", $predicate" : '' ).
( defined $default ? ", $default" : '').
" and $required.".
( defined $handlesText && ( $handlesText ne "This attribute has handles as follows:\n" ) ? "\n\n$handlesText" : '' )."\n\n";
}
}
my $roleVerb = "consume".( $#roles == 0 ? 's role' : ' roles' );
my $text = "=head1 Moose::Exception::$file
This class is a subclass of $superclasses".
( defined $consumedRoles ? " and $roleVerb $consumedRoles.": '.' ).
"\n\n=over 4\n\n=back\n\n=head2 ATTRIBUTES\n\n=over 4\n\n".
( defined $attributesText ? "$attributesText" : '' );
$text = fixLineLength( $text );
$text .= $exceptionMessages;
$number++;
$text =~ s/\s+$//;
print "\n$text\n";
}
}
print "\n=cut\n";
sub fixLineLength {
my $doc = shift;
my @tokens = split /\n/, $doc;
my $str;
foreach( @tokens ) {
my $string = shortenToEighty($_);
$str .= ($string."\n");
}
return $str."\n";
}
sub shortenToEighty {
my ($str) = @_;
if( length $str > 80 && length $str != 81 ) {
my $s1 = substr($str, 0, 80);
my $s2 = substr($str, 80);
my $substr1 = substr($s1, length($s1) - 1 );
my $substr2 = substr($s2, 0, 1);
$s1 =~ s/[\s]+$//g;
$s2 =~ s/[\s]+$//g;
if( ( $substr1 =~ /[\(\)\[\w:,'"<>\]\$]/ ) && ( $substr2 =~ /[\$'"\(\)\[<>\w:,\]]/ ) ) {
if( $s1 =~ s/\s([\(\)\[<:\w+>,"'\]\$]+)$// ) {
$s1 =~ s/[\s]+$//g;
$s2 = $1.$s2;
$s2 =~ s/[\s]+$//g;
my $s3 = shortenToEighty( $s2 );
$s3 =~ s/[\s]+$//g;
$s2 =~ s/[\s]+$//g;
if( $s2 ne $s3 ) {
return "$s1\n$s3";
} else {
return "$s1\n$s2";
}
}
}
return "$s1\n$s2";
}
else
{
return $str;
}
}
sub placeCommasAndAnd {
my @array = @_;
my ($str, $lastUndef);
for( my $i = 0; $i <= $#array; $i++ ) {
my $element = $array[$i];
if( !(defined $element ) ) {
$lastUndef = 1;
next;
}
if ( $i == 0 || ( $lastUndef && $i == 1 ) ) {
$str .= "L<$element>";
} elsif( $i == $#array ) {
$str .= " and L<$element>";
} else {
$str .= ", L<$element>";
}
$lastUndef = 0;
}
return $str;
}
sub getExceptionsToMessages {
my $testDir;
my $testPath = 't/exceptions/';
my %hash;
opendir( $testDir, $testPath ) or die $!;
my $file;
while( $file = readdir( $testDir ) ) {
my $fileHandle;
open( $fileHandle, "t/exceptions/$file" ) or die $!;
my ($message, $exception);
while( <$fileHandle> ) {
if( /like\($/ ) {
my $exceptionVar = <$fileHandle>;
if( $exceptionVar =~ /\$exception,$/ ) {
$message = <$fileHandle>;
if( $message =~ q/\$\w+/ || ( $message =~ /\\\(\w+\\\)/) ) {
my $garbage = <$fileHandle>;
$message = <$fileHandle>;
$message =~ s/^\s+#//;
}
$message =~ s!^\s*qr(/|\!)(\^)?(\\Q)?!!;
$message =~ s!(/|\!),$!!;
}
} elsif( /isa_ok\($/ ) {
my $exceptionVar = <$fileHandle>;
if( $exceptionVar =~ /\$exception(->error)?,$/ ) {
$exception = <$fileHandle>;
if( $exception =~ /Moose::Exception::(\w+)/ ) {
$exception = $1;
}
}
}
if( ( defined $exception ) && ( defined $message ) ) {
if( exists $hash{$exception} &&
( ref $hash{$exception} eq "ARRAY" ) ) {
my @array = @{$hash{$exception}};
push @array, $message;
$hash{$exception} = \@array;
} elsif( exists $hash{$exception} &&
( $hash{$exception} ne $message ) ) {
my $msg = $hash{$exception};
my $arrayRef = [ $msg, $message ];
$hash{$exception} = $arrayRef;
} else {
$hash{$exception} = $message;
}
$exception = undef;
$message = undef;
}
}
close $fileHandle;
}
return \%hash;
}
View
@@ -8,7 +8,7 @@ use 5.008003;
use MRO::Compat;
use Carp 'confess';
use Class::Load 0.07 ();
use Scalar::Util 'weaken', 'isweak', 'reftype', 'blessed';
use Data::OptList;
use Try::Tiny;
View
@@ -12,6 +12,8 @@ use Try::Tiny;
use parent 'Class::MOP::Object', 'Class::MOP::Mixin::AttributeCore';
use Moose::Util 'throw_exception';
# NOTE: (meta-circularity)
# This method will be replaced in the
# boostrap section of Class::MOP, by
@@ -30,23 +32,34 @@ sub new {
my $name = $options{name};
(defined $name)
|| confess "You must provide a name for the attribute";
|| throw_exception( MOPAttributeNewNeedsAttributeName => class => $class,
params => \%options
);
$options{init_arg} = $name
if not exists $options{init_arg};
if(exists $options{builder}){
confess("builder must be a defined scalar value which is a method name")
throw_exception( BuilderMustBeAMethodName => class => $class,
params => \%options
)
if ref $options{builder} || !(defined $options{builder});
confess("Setting both default and builder is not allowed.")
throw_exception( BothBuilderAndDefaultAreNotAllowed => class => $class,
params => \%options
)
if exists $options{default};
} else {
($class->is_default_a_coderef(\%options))
|| confess("References are not allowed as default values, you must ".
"wrap the default of '$name' in a CODE reference (ex: sub { [] } and not [])")
|| throw_exception( ReferencesAreNotAllowedAsDefault => class => $class,
params => \%options,
attribute_name => $options{name}
)
if exists $options{default} && ref $options{default};
}
if( $options{required} and not( defined($options{builder}) || defined($options{init_arg}) || exists $options{default} ) ) {
confess("A required attribute must have either 'init_arg', 'builder', or 'default'");
throw_exception( RequiredAttributeLacksInitialization => class => $class,
params => \%options
);
}
$class->_new(\%options);
@@ -97,6 +110,11 @@ sub clone {
my %options = @_;
(blessed($self))
|| confess "Can only clone an instance";
# this implementation is overwritten by the bootstrap process,
# so this exception will never trigger. If it ever does occur,
# it indicates a gigantic problem with the most internal parts
# of Moose, so we wouldn't want a Moose-based exception object anyway
return bless { %{$self}, %options } => ref($self);
}
@@ -131,7 +149,9 @@ sub initialize_instance_slot {
);
}
else {
confess(ref($instance)." does not support builder method '". $self->{'builder'} ."' for attribute '" . $self->name . "'");
throw_exception( BuilderMethodNotSupportedForAttribute => attribute => $self,
instance => $instance
);
}
}
}
@@ -232,7 +252,9 @@ sub slots { (shift)->name }
sub attach_to_class {
my ($self, $class) = @_;
(blessed($class) && $class->isa('Class::MOP::Class'))
|| confess "You must pass a Class::MOP::Class instance (or a subclass)";
|| throw_exception( AttachToClassNeedsAClassMOPClassInstanceOrASubclass => attribute => $self,
class => $class
);
weaken($self->{'associated_class'} = $class);
}
@@ -358,7 +380,11 @@ sub _process_accessors {
if (ref($accessor)) {
(ref($accessor) eq 'HASH')
|| confess "bad accessor/reader/writer/predicate/clearer format, must be a HASH ref";
|| throw_exception( BadOptionFormat => attribute => $self,
option_value => $accessor,
option_name => $type
);
my ($name, $method) = %{$accessor};
$method_ctx->{description} = $self->_accessor_description($name, $type);
@@ -391,7 +417,11 @@ sub _process_accessors {
);
}
catch {
confess "Could not create the '$type' method for " . $self->name . " because : $_";
throw_exception( CouldNotCreateMethod => attribute => $self,
option_value => $accessor,
option_name => $type,
error => $_
);
};
$self->associate_method($method);
return ($accessor, $method);
Oops, something went wrong.
ProTip! Use n and p to navigate between commits in a pull request.