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;
}