diff options
Diffstat (limited to 'author')
| -rw-r--r-- | author/docGenerator.pl | 279 | ||||
| -rwxr-xr-x | author/extract-inline-tests | 47 | ||||
| -rwxr-xr-x | author/find-dupe-test-numbers | 23 |
3 files changed, 349 insertions, 0 deletions
diff --git a/author/docGenerator.pl b/author/docGenerator.pl new file mode 100644 index 0000000..6e3eef0 --- /dev/null +++ b/author/docGenerator.pl @@ -0,0 +1,279 @@ +use blib; +use Moose; +use Class::Load 0.07 qw(load_class); + +my $text = generate_docs(); +print $text; + +sub generate_docs { + my $dir; + my $path = 'lib/Moose/Exception/'; + my $pod_file; + + opendir( $dir, $path) or die $!; + + my $version = $ARGV[0]; + + my $number = 0; + my $text = ''; + + my $exceptions_to_msg_hashref = get_exceptions_to_messages(); + + while( my $file = readdir($dir) ) + { + my %exceptions = %$exceptions_to_msg_hashref; + + my ($exception, $description, $attributes_text, $superclasses, $consumed_roles, $exception_messages); + my (@attributes, @roles, @super_classes, @roles_names, @super_class_names); + if( !(-d 'lib/Moose/Exception/'.$file) ) + { + $file =~ s/\.pm//i; + + $exception = "Moose::Exception::".$file; + + load_class( $exception ); + my $metaclass = Class::MOP::class_of( $exception ) + or die "No metaclass for $exception"; + + my @super_classes = sort { $a->name cmp $b->name } $metaclass->superclasses; + my @roles = sort { $a->name cmp $b->name } $metaclass->calculate_all_roles; + my @attributes = sort { $a->name cmp $b->name } $metaclass->get_all_attributes; + + my $file_handle; + + @roles_names = map { + my $name = $_->name; + if( $name =~ /\|/ ) { + undef; + } else { + $name; + } + } @roles; + + $superclasses = place_commas_and_and( @super_classes ); + $consumed_roles = place_commas_and_and( @roles_names ); + + foreach my $attribute ( @attributes ) + { + my $name = $attribute->name; + my $traits; + + if( $attribute->has_applied_traits ) { + my @traits_array = @{$attribute->applied_traits}; + + $traits = "has traits of "; + my $traits_str = place_commas_and_and( @traits_array ); + $traits .= $traits_str; + } + + my ( $tc, $type_constraint ) = ( $attribute->type_constraint->name, "isa " ); + if( $tc =~ /::/ && !(defined $traits) ) { + $type_constraint .= "L<".$tc.">"; + } else { + $type_constraint .= $tc; + } + my $read_or_write = ( $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 $handles_text; + if( $attribute->has_handles ) { + my %handles = %{$attribute->handles}; + my @keys = sort keys( %handles ); + my $first_element_inserted = 1; + foreach my $key ( @keys ) { + next + if( $key =~ /^_/ ); + my $str_text = sprintf("\n %-25s=> %s", $key, $handles{$key}); + if( $first_element_inserted == 1 ) { + $handles_text = "This attribute has handles as follows:"; + $first_element_inserted = 0; + } + $handles_text .= $str_text; + } + } + + $exception_messages = "=back\n\n=head4 Sample Error Message"; + + my $msg_or_msg_ref = $exceptions{$file}; + if( ref $msg_or_msg_ref eq "ARRAY" ) { + $exception_messages .= "s:\n\n"; + my @array = @$msg_or_msg_ref; + foreach( @array ) { + $exception_messages .= " $_"; + } + } else { + $exception_messages .= ":\n\n"; + if( $exceptions{$file} ) { + $exception_messages .= " ".$exceptions{$file}; + } + } + + $exception_messages .= "\n"; + + $attributes_text .= "=item B<< \$exception->$name >>\n\n"; + if( $attribute->has_documentation ) { + $attributes_text .= $attribute->documentation."\n\n"; + } else { + $attributes_text .= "This attribute $read_or_write, $type_constraint". + ( defined $predicate ? ", $predicate" : '' ). + ( defined $default ? ", $default" : ''). + " and $required.". + ( defined $handles_text && ( $handles_text ne "This attribute has handles as follows:\n" ) ? "\n\n$handles_text" : '' )."\n\n"; + } + } + my $role_verb = "consume".( $#roles == 0 ? 's role' : ' roles' ); + + $text .= "=head1 Moose::Exception::$file\n\nThis class is a subclass of $superclasses". +( defined $consumed_roles ? " and $role_verb $consumed_roles.": '.' ). +"\n\n=over 4\n\n=back\n\n=head2 ATTRIBUTES\n\n=over 4\n\n". +( defined $attributes_text ? "$attributes_text\n\n" : '' ); + + $text = fix_line_length( $text ); + $text .= $exception_messages; + $number++; + $text =~ s/\s+$//; + $text .= "\n\n"; + } + } + + return $text; +} + +sub fix_line_length { + my $doc = shift; + + my @tokens = split /\n/, $doc; + + my $str; + foreach( @tokens ) { + my $string = shorten_to_eighty($_); + $str .= ($string."\n"); + } + return $str."\n"; +} + +sub shorten_to_eighty { + 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 = shorten_to_eighty( $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 place_commas_and_and { + my @array = @_; + my ($str, $last_undef); + + for( my $i = 0; $i <= $#array; $i++ ) { + my $element = $array[$i]; + if( !(defined $element ) ) { + $last_undef = 1; + next; + } + if ( $i == 0 || ( $last_undef && $i == 1 ) ) { + $str .= "L<$element>"; + } elsif( $i == $#array ) { + $str .= " and L<$element>"; + } else { + $str .= ", L<$element>"; + } + $last_undef = 0; + } + return $str; +} + +sub get_exceptions_to_messages { + my $test_dir; + my $test_path = 't/exceptions/'; + + my %hash; + + opendir( $test_dir, $test_path ) or die $!; + + my $file; + while( $file = readdir( $test_dir ) ) { + my $file_handle; + + open( $file_handle, "t/exceptions/$file" ) or die $!; + my ($message, $exception); + while( <$file_handle> ) { + if( /like\($/ ) { + my $exception_var = <$file_handle>; + if( $exception_var =~ /\$exception,$/ ) { + $message = <$file_handle>; + if( $message =~ q/\$\w+/ || ( $message =~ /\\\(\w+\\\)/) ) { + my $garbage = <$file_handle>; + $message = <$file_handle>; + $message =~ s/^\s+#//; + } + $message =~ s!^\s*qr(/|\!)(\^)?(\\Q)?!!; + $message =~ s!(/|\!),$!!; + } + } elsif( /isa_ok\($/ ) { + my $exception_var = <$file_handle>; + if( $exception_var =~ /\$exception(->error)?,$/ ) { + $exception = <$file_handle>; + 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 $array_ref = [ $msg, $message ]; + $hash{$exception} = $array_ref; + } else { + $hash{$exception} = $message; + } + $exception = undef; + $message = undef; + } + } + close $file_handle; + } + + return \%hash; +} diff --git a/author/extract-inline-tests b/author/extract-inline-tests new file mode 100755 index 0000000..aa90787 --- /dev/null +++ b/author/extract-inline-tests @@ -0,0 +1,47 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use File::Find::Rule; +use Getopt::Long; +use Test::Inline; + +use lib 'inc'; +use MyInline; + +my $quiet; +GetOptions( 'quiet' => \$quiet ); + +my $inline = Test::Inline->new( + verbose => !$quiet, + ExtractHandler => 'My::Extract', + ContentHandler => 'My::Content', + OutputHandler => 'My::Output', +); + +for my $pod ( + File::Find::Rule->file->name(qr/\.pod$/)->in('lib/Moose/Cookbook') ) { + $inline->add($pod); +} + +$inline->save; + +{ + + package My::Output; + + use Path::Tiny; + + sub write { + my $class = shift; + my $name = shift; + my $content = shift; + + $name =~ s/^moose_cookbook_//; + + path( "t/recipes/$name" )->spew( $content ); + + return 1; + } +} diff --git a/author/find-dupe-test-numbers b/author/find-dupe-test-numbers new file mode 100755 index 0000000..ce975a0 --- /dev/null +++ b/author/find-dupe-test-numbers @@ -0,0 +1,23 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use File::Basename qw( basename ); + +for my $subdir ( glob 't/*' ) { + my %files; + + for my $file ( map { basename($_) } glob "$subdir/*.t" ) { + my ($number) = $file =~ /^(\d+)/; + next unless defined $number; + + push @{ $files{$number} }, $file; + } + + for my $number ( grep { @{ $files{$_} } > 1 } keys %files ) { + print $subdir, "\n"; + print ' - ', $_, "\n" for @{ $files{$number} }; + print "\n"; + } +} |