view release on metacpan or  search on metacpan

lib/Pod/Elemental/Transformer/Splint.pm  view on Meta::CPAN

);
has attribute_renderer => (
    is => 'rw',
    isa => ArrayRef[HashRef[Str]],
    traits => [qw/Array/],
    default => sub {
        [
            { for => 'HTML', class => 'HtmlDefault' },
            { for => 'markdown', class => 'HtmlDefault' },
        ],
    },
    handles => {
        all_attribute_renderers => 'elements',
    }
);
has method_renderer => (
    is => 'rw',
    isa => ArrayRef[HashRef[Str]],
    traits => [qw/Array/],
    default => sub {
        [
            { for => 'HTML', class => 'HtmlDefault' },
            { for => 'markdown', class => 'HtmlDefault' },
        ],
    },
    handles => {
        all_method_renderers => 'elements',
    }
);

around BUILDARGS => sub {
    my $orig = shift;
    my $class = shift;
    my $args = shift;

    my $type_libraries = {};

    if(exists $args->{'type_libraries'}) {
        my $lib = $args->{'type_libraries'};
        $lib =~ s{([^\h]+=)}{---$1}g;
        $lib =~ s{^---}{};
        $lib =~ s{\h}{}g;
        my @libraries = split /---/ => $lib;

        foreach my $librarydata (@libraries) {
            my($library, $typesdata) = split /=/ => $librarydata;
            my @types = split /,/ => $typesdata;

            foreach my $type (@types) {
                $type_libraries->{ $type } = $library;
            }
        }
    }
    $args->{'type_libraries'} = $type_libraries;

    my $attribute_renderers = [];
    my $method_renderers = [];


    if(exists $args->{'attribute_renderer'}) {
        my @renderers = split m{,\s+}, $args->{'attribute_renderer'};

        for my $renderer (@renderers) {
            my($format, $class) = split m/=/, $renderer;
            push @{ $attribute_renderers } => { for => $format, class => $class };
        }
        $args->{'attribute_renderer'} = $attribute_renderers;
    }
    if(exists $args->{'method_renderer'}) {
        my @renderers = split m{,\s+}, $args->{'method_renderer'};

        for my $renderer (@renderers) {
            my($format, $class) = split m/=/, $renderer;
            $renderer = { for => $format, class => $class };
            push @{ $method_renderers } => { for => $format, class => $class };
        }
        $args->{'method_renderer'} = $method_renderers;
    }
    $class->$orig($args);
};

sub BUILD {
    my $self = shift;

    my $base = 'Pod::Elemental::Transformer::Splint';

    TYPE:
    foreach my $type (qw/attribute method/) {
        my $all_method = sprintf 'all_%s_renderers', $type;

        RENDERER:
        foreach my $renderer ($self->$all_method) {
            my $role = sprintf '%s::%sRenderer', $base, ucfirst $type;
            my $classname = sprintf '%s::%s', $role, $renderer->{'class'};

            try {
                load $classname;
            }
            catch {
                die "Can't use $classname as renderer: $_";
            };

            if(!$classname->does($role)) {
                die "$classname doesn't do the $role role";
            }

            $renderer->{'renderer'} = $classname->new(for => $renderer->{'for'});
        }
    }
}

sub transform_node {
    my $self = shift;
    my $node = shift;

    CHILD:
    foreach my $child (@{ $node->children }) {

        my $line_start = substr($child->content, 0 => length ($self->command_name) + 1);
        next CHILD if $line_start ne sprintf '%s ', $self->command_name;

        my($prefix, $action, $param, $data) = split m/\h+/, $child->content, 4;

        if($action eq 'classname' && defined $param) {
            eval "use $param";
            die "Can't use $param: $@" if $@;

            $self->classmeta($param->meta);
            $child->content('');

            next CHILD;
        }
        next CHILD if !$self->has_classmeta;

        if($action eq 'attributes' && scalar $self->classmeta->get_attribute_list) {

            my @attributes = map { $self->classmeta->get_attribute($_) } $self->classmeta->get_attribute_list;

            my @unwanted = extract_by { $_->does('Documented') && !$_->documentation_order } @attributes;

            my @custom_sort_order_attrs   = sort { $a->documentation_order <=> $b->documentation_order || $a->name cmp $b->name } extract_by { $_->does('Documented') && $_->documentation_order < 1000 }  @attributes;
            my @docced_not_in_constr_attr = sort { $a->name cmp $b->name } extract_by { !defined $_->init_arg && $_->does('Documented') } @attributes;
            my @not_in_constructor_attrs  = sort { $a->name cmp $b->name } extract_by { !defined $_->init_arg }  @attributes;
            my @required_attrs            = sort { $a->name cmp $b->name } extract_by { $_->is_required }        @attributes;
            my @documented_attrs          = sort { $a->name cmp $b->name } extract_by { $_->does('Documented') } @attributes;
            my @the_rest                  = sort { $a->name cmp $b->name } @attributes;

            my @wanted_attributes = (@custom_sort_order_attrs, @required_attrs, @documented_attrs, @the_rest, @docced_not_in_constr_attr, @not_in_constructor_attrs);
            #* First attributes with documentation
            #* then attributes available in constructor
            #* then required attributes
            #* and then alphabetical
            #my @attribute_names = sort {
            #                             ($a->does('Documented') && $a->has_documentation_order ? $a->documentation_order : 1000) <=> ($b->does('Documented') && $b->has_documentation_order ? $b->documentation_order : 1000)
            #                          || ($b->init_arg // 0) <=> ($a->init_arg // 0)
            #                          || ($b->is_required || 0) <=> ($a->is_required || 0)
            #                          ||  $a->name cmp $b->name
            #                      }
            #                      map { $self->classmeta->get_attribute($_) }
            #                      $self->classmeta->get_attribute_list;
            my $content = '';

            ATTR:
            foreach my $attr (@wanted_attributes) {
                next ATTR if $attr->does('Documented') && $attr->has_documentation_order && $attr->documentation_order == 0;

                $content .= sprintf "\n=head2 %s\n", $attr->name;
                my $prepared_attr = $self->prepare_attr($attr);
                foreach my $attribute_renderer ($self->all_attribute_renderers) {
                    $content .= $attribute_renderer->{'renderer'}->render_attribute($prepared_attr);
                }

            }
            $child->content($content);
        }

        if($action eq 'method') {
            if(!$self->classmeta->has_method($param)) {
                $child->content('');
                return;
            }