MooseX::Declare::Context - Per-keyword declaration context

  Object->add_preamble_code_parts (CodeRef @parts)

  Object->add_scope_code_parts    (CodeRef @parts)

  Object->add_cleanup_code_parts  (CodeRef @parts)

  True Object->inject_code_parts_here (CodePart @parts)

  Str Object->peek_next_char ()

  Object->inject_code_parts (
      Bool    :$inject_cleanup_code_parts,
      CodeRef :$missing_block_handler
  )

  ['BEGIN', 'with q{ MyRole }']

package MooseX::Declare::Context;
BEGIN {
  $MooseX::Declare::Context::AUTHORITY = 'cpan:FLORA';
}
BEGIN {
  $MooseX::Declare::Context::VERSION = '0.34';
}
# ABSTRACT: Per-keyword declaration context

use Moose 0.90;
use Moose::Util::TypeConstraints;
use Carp qw/croak/;

use aliased 'Devel::Declare::Context::Simple', 'DDContext';

use namespace::clean -except => 'meta';


subtype 'MooseX::Declare::BlockCodePart',
    as 'ArrayRef',
    where { @$_ > 1 and sub { grep { $_[0] eq $_ } qw( BEGIN END ) } -> ($_->[0]) };


subtype 'MooseX::Declare::CodePart',
     as 'Str|MooseX::Declare::BlockCodePart';

has _dd_context => (
    is          => 'ro',
    isa         => DDContext,
    required    => 1,
    builder     => '_build_dd_context',
    lazy        => 1,
    handles     => qr/.*/,
);

has _dd_init_args => (
    is          => 'rw',
    isa         => 'HashRef',
    default     => sub { {} },
    required    => 1,
);


has provided_by => (
    is          => 'ro',
    isa         => 'ClassName',
    required    => 1,
);



has caller_file => (
    is          => 'rw',
    isa         => 'Str',
    required    => 1,
);


has preamble_code_parts => (
    traits    => ['Array'],
    is        => 'ro',
    isa       => 'ArrayRef[MooseX::Declare::CodePart]',
    required  => 1,
    default   => sub { [] },
    handles   => {
        add_preamble_code_parts => 'push',
    },
);


has scope_code_parts => (
    traits    => ['Array'],
    is        => 'ro',
    isa       => 'ArrayRef[MooseX::Declare::CodePart]',
    required  => 1,
    default   => sub { [] },
    handles   => {
        add_scope_code_parts => 'push',
    },
);


has cleanup_code_parts => (
    traits    => ['Array'],
    is        => 'ro',
    isa       => 'ArrayRef[MooseX::Declare::CodePart]',
    required  => 1,
    default   => sub { [] },
    handles   => {
        add_cleanup_code_parts       => 'push',
        add_early_cleanup_code_parts => 'unshift',
    },
);


has stack => (
    is          => 'rw',
    isa         => 'ArrayRef',
    default     => sub { [] },
    required    => 1,
);


sub inject_code_parts_here {
    my ($self, @parts) = @_;

    # get code to inject and rest of line
    my $inject  = $self->_joined_statements(\@parts);
    my $linestr = $self->get_linestr;

    # add code to inject to current line and inject it
    substr($linestr, $self->offset, 0, "$inject");
    $self->set_linestr($linestr);

    return 1;
}


sub peek_next_char {
    my ($self) = @_;

    # return next char in line
    my $linestr = $self->get_linestr;
    return substr $linestr, $self->offset, 1;
}

sub peek_next_word {
    my ($self) = @_;

    $self->skipspace;

    my $len = Devel::Declare::toke_scan_word($self->offset, 1);
    return unless $len;

    my $linestr = $self->get_linestr;
    return substr($linestr, $self->offset, $len);
}


sub inject_code_parts {
    my ($self, %args) = @_;

    # default to injecting cleanup code
    $args{inject_cleanup_code_parts} = 1
        unless exists $args{inject_cleanup_code_parts};

    # add preamble and scope statements to injected code
    my $inject;
    $inject .= $self->_joined_statements('preamble');
    $inject .= ';' . $self->_joined_statements('scope');

    # if we should also inject the cleanup code
    if ($args{inject_cleanup_code_parts}) {
        $inject .= ';' . $self->scope_injector_call($self->_joined_statements('cleanup'));
    }

    $inject .= ';';

    # we have a block
    if ($self->peek_next_char eq '{') {
        $self->inject_if_block("$inject");
    }

    # there was no block to inject into
    else {
        # require end of statement
        croak "block or semi-colon expected after " . $self->declarator . " statement"
            unless $self->peek_next_char eq ';';

        # if we can't handle non-blocks, we expect one
        croak "block expected after " . $self->declarator . " statement"
            unless exists $args{missing_block_handler};

        # delegate the processing of the missing block
        $args{missing_block_handler}->($self, $inject, %args);
    }

    return 1;
}

sub _joined_statements {
    my ($self, $section) = @_;

    # if the section was not an array reference, get the
    # section contents of that name
    $section = $self->${\"${section}_code_parts"}
        unless ref $section;

    # join statements via semicolon
    # array references are expected to be in the form [FOO => 1, 2, 3]
    # which would yield BEGIN { 1; 2; 3 }
    return join '; ', map {
        not( ref $_ ) ? $_ : do {
            my ($block, @parts) = @$_;
            sprintf '%s { %s }', $block, join '; ', @parts;
        };
    } @{ $section };
}

sub BUILD {
    my ($self, $attrs) = @_;

    # remember the constructor arguments for the delegated context
    $self->_dd_init_args($attrs);
}

sub _build_dd_context {
    my ($self) = @_;

    # create delegated context with remembered arguments
    return DDContext->new(%{ $self->_dd_init_args });
}

sub strip_word {
    my ($self) = @_;

    $self->skipspace;
    my $linestr = $self->get_linestr;
    return if substr($linestr, $self->offset, 1) =~ /[{;]/;

    # TODO:
    # - provide a reserved_words attribute
    # - allow keywords to consume reserved_words autodiscovery role
    my $word = $self->peek_next_word;
    return if !defined $word || $word =~ /^(?:extends|with|is)$/;

    return scalar $self->strip_name;
}


1;

__END__