Acme-PlayCode

 view release on metacpan or  search on metacpan

lib/Acme/PlayCode.pm  view on Meta::CPAN

our $AUTHORITY = 'cpan:FAYLAND';

with 'MooseX::Object::Pluggable';

has 'tokens' => (
    is  => 'rw',
    isa => 'ArrayRef',
    auto_deref => 1,
    default    => sub { [] },
);
has 'token_flag' => ( is => 'rw', isa => 'Num', default => 0 );

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

sub play {
    my ( $self, $code, $opts ) = @_;
    
    my $file;
    if ( $code !~ /\s/ and -e $code ) {
        $file = Path::Class::File->new($code);
        $code = $file->slurp();
    }
    
    # clear to multi-run
    $self->output( [] );
    $self->token_flag( 0 );
    
    my $doc    = PPI::Document->new( \$code );
    $self->tokens( $doc->find('PPI::Token') );

    $self->do_with_tokens();
    
    my @output = @{ $self->output };
    # check Acme::PlayCode::Plugin::PrintComma
    @output = grep { $_ ne 'Acme::PlayCode::!@#$%^&*()_+' } @output;
    my $output = join('', @output);

lib/Acme/PlayCode.pm  view on Meta::CPAN

        print $fh $output;
        $fh->close();
        
    }
    return $output;
}

sub do_with_tokens {
    my ( $self ) = @_;
    
    while ( $self->token_flag < scalar @{$self->tokens}) {
        my $orginal_flag = $self->token_flag;
        my $content = $self->do_with_token_flag( $self->token_flag );
        push @{ $self->output }, $content if ( defined $content );
        # if we don't move token_flag, ++
        if ( $self->token_flag == $orginal_flag ) {
            $self->token_flag( $self->token_flag + 1 );
        }
    }
}

sub do_with_token_flag {
    my ( $self, $token_flag ) = @_;
    
    my @tokens = $self->tokens;
    my $token = $tokens[$token_flag];
    
    return $self->do_with_token( $token );
}

sub do_with_token {
    my ( $self, $token ) = @_;

    my $token_flag = $self->token_flag;
    my @tokens = $self->tokens;
    if ( $token->isa('PPI::Token::HereDoc') ) {
        my @output = @{ $self->output };
        
        my @next_tokens;
        my $old_flag = $token_flag;
        while ( $old_flag++ ) {
            push @next_tokens, $tokens[$old_flag];
            last if ( $tokens[$old_flag]->content eq ';' );
        }
        push @output, $token->content,
            join('', map { $_->content } @next_tokens ), "\n",
            join('', $token->heredoc),
            $token->terminator;
        
        # skip next itself and next ';'
        $self->token_flag( $token_flag + 1 + scalar @next_tokens );
        $self->output( \@output );
        return;
    } else {
        return $token->content;
    }
}

no Moose;
__PACKAGE__->meta->make_immutable;

lib/Acme/PlayCode/Plugin/ExchangeCondition.pm  view on Meta::CPAN

package Acme::PlayCode::Plugin::ExchangeCondition;

use Moose::Role;
use List::MoreUtils qw/firstidx/;

our $VERSION   = '0.10';
our $AUTHORITY = 'cpan:FAYLAND';

around 'do_with_token_flag' => sub {
    my $orig = shift;
    my $self = shift;
    my ( $token_flag ) = @_;
    
    my @tokens = $self->tokens;
    my $token  = $tokens[$token_flag];
    
    my $orginal_flag = $token_flag;
    if ( $token->isa('PPI::Token::Operator') ) {
        my $op = $token->content;
        # only 'ne' 'eq' '==' '!=' are exchange-able
        if ( $op eq 'ne' or $op eq 'eq' or $op eq '==' or $op eq '!=' ) {
            # get next tokens
            my (@next_tokens, @next_full_tokens);
            while ( $token_flag++ ) {
                if ($tokens[$token_flag]->isa('PPI::Token::Whitespace') ) {
                    push @next_full_tokens, $tokens[$token_flag];
                    next;
                }
                last if ( $tokens[$token_flag]->isa('PPI::Token::Structure') );
                if ( $tokens[$token_flag]->isa('PPI::Token::Operator') ) {
                    my $op2 = $tokens[$token_flag]->content;
                    if ( $op2 eq 'or' or $op2 eq 'and' or $op2 eq '||' or $op2 eq '&&') {
                        last;
                    }
                }
                last unless ( $tokens[$token_flag] );
                push @next_tokens, $tokens[$token_flag];
                push @next_full_tokens, $tokens[$token_flag];
            }
            $token_flag = $orginal_flag; # roll back
            # get previous tokens
            my (@previous_tokens, @previous_full_tokens);
            while ($token_flag--) {
                if ($tokens[$token_flag]->isa('PPI::Token::Whitespace') ) {
                    unshift @previous_full_tokens, $tokens[$token_flag];
                    next;
                }
                last if ($tokens[$token_flag]->isa('PPI::Token::Structure'));
                if ( $tokens[$token_flag]->isa('PPI::Token::Operator') ) {
                    my $op2 = $tokens[$token_flag]->content;
                    if ( $op2 eq 'or' or $op2 eq 'and' or $op2 eq '||' or $op2 eq '&&') {
                        last;
                    }
                }
                last unless ( $tokens[$token_flag] );
                unshift @previous_tokens, $tokens[$token_flag];
                unshift @previous_full_tokens, $tokens[$token_flag];
            }
            $token_flag = $orginal_flag; # roll back

            # the most simple situation ( $a eq 'a' )
            if (scalar @next_tokens == 1 and scalar @previous_tokens == 1) {
                # exchange-able flag
                my $exchange_able = 0;
                # single and literal are exchange-able
                if ( $next_tokens[0]->isa('PPI::Token::Quote::Single')
                  or $next_tokens[0]->isa('PPI::Token::Quote::Literal') ) {
                    $exchange_able = 1;
                }
                # double without interpolations is exchange-able
                if ( $next_tokens[0]->isa('PPI::Token::Quote::Double') and
                    not $next_tokens[0]->interpolations ) {
                    $exchange_able = 1;

lib/Acme/PlayCode/Plugin/ExchangeCondition.pm  view on Meta::CPAN

                    my $prev_place = firstidx { $_ eq $previous_tokens[0] } @tokens_to_exchange;
                    my $next_place = firstidx { $_ eq $next_tokens[0] } @tokens_to_exchange;
                    
                    $tokens_to_exchange[ $prev_place ] = $next_tokens[0];
                    $tokens_to_exchange[ $next_place ] = $previous_tokens[0];

                    foreach my $_token ( @tokens_to_exchange ) {
                        push @output, $self->do_with_token($_token);
                    }

                    # move 'token flag' i forward
                    $token_flag += $next_num + 1;
                    $self->token_flag( $token_flag );
                    $self->output( \@output );
                    return;
                }
            }
        }
    }
    
    $orig->($self, @_);
};

lib/Acme/PlayCode/Plugin/NumberPlus.pm  view on Meta::CPAN

package Acme::PlayCode::Plugin::NumberPlus;

use Moose::Role;
use List::MoreUtils qw/insert_after/;
use PPI::Token::Comment;

our $VERSION   = '0.11';
our $AUTHORITY = 'cpan:FAYLAND';

around 'do_with_token_flag' => sub {
    my $orig = shift;
    my $self = shift;
    my ( $token_flag ) = @_;
    
    my @tokens = $self->tokens;
    my $token  = $tokens[$token_flag];
    
    use Data::Dumper;
#    print STDERR Dumper(\$token);
    
    my $orginal_flag = $token_flag;
    if ( $token->isa('PPI::Token::Operator') ) {
        my $op = $token->content;
        # only '+' '-' '*' '/' are do-able
        if ( $op eq '+' or $op eq '-' or $op eq '*' or $op eq '/' ) {
            # get next tokens
            my (@next_full_tokens);
            while ( $token_flag++ ) {
                if ($tokens[$token_flag]->isa('PPI::Token::Whitespace') ) {
                    push @next_full_tokens, $tokens[$token_flag];
                    next;
                }
                last if ( $tokens[$token_flag]->isa('PPI::Token::Structure') );
                if ( $tokens[$token_flag]->isa('PPI::Token::Operator') ) {
                    my $op2 = $tokens[$token_flag]->content;
                    unless ( $op2 eq '+' or $op2 eq '-' or $op2 eq '*' or $op2 eq '/' ) {
                        last;
                    }
                }
                last unless ( $tokens[$token_flag] );
                push @next_full_tokens, $tokens[$token_flag];
            }
            # remove last space
            pop @next_full_tokens if ( $next_full_tokens[-1]->isa('PPI::Token::Whitespace'));
            $token_flag = $orginal_flag; # roll back
            # get prev tokens
            my (@prev_full_tokens);
            while ($token_flag--) {
                if ($tokens[$token_flag]->isa('PPI::Token::Whitespace') ) {
                    unshift @prev_full_tokens, $tokens[$token_flag];
                    next;
                }
                last if ($tokens[$token_flag]->isa('PPI::Token::Structure'));
                if ( $tokens[$token_flag]->isa('PPI::Token::Operator') ) {
                    my $op2 = $tokens[$token_flag]->content;
                    unless ( $op2 eq '+' or $op2 eq '-' or $op2 eq '*' or $op2 eq '/' ) {
                        last;
                    }
                }
                last unless ( $tokens[$token_flag] );
                unshift @prev_full_tokens, $tokens[$token_flag];
            }
            $token_flag = $orginal_flag; # roll back
            # remove first space
            shift @prev_full_tokens if ( $prev_full_tokens[0]->isa('PPI::Token::Whitespace'));

            # only do-able for number, space, operator
            my $do_able = 1;
            $do_able = 0 unless (scalar @prev_full_tokens and scalar @next_full_tokens);
            if ( $do_able ) {
				foreach ( @prev_full_tokens, @next_full_tokens ) {
					unless ( $_->isa('PPI::Token::Whitespace') or $_->isa('PPI::Token::Number') or
						( $_->isa('PPI::Token::Operator') and $_->content =~ /^[\+\-\*\/]$/ ) ) {

lib/Acme/PlayCode/Plugin/NumberPlus.pm  view on Meta::CPAN

                @output = splice( @output, 0, scalar @output - $prev_num );
                                
                my $str = join('', @prev_full_tokens, $token, @next_full_tokens);
                $str = eval($str);
                push @output, $str;
                my $comment = " # $str = ";
                foreach ( @prev_full_tokens, $token, @next_full_tokens ) {
                    $comment .= $_->content;
                }

                # move 'token flag' i forward
                $token_flag += $next_num + 1;
                my $to_be_set = $token_flag;
                
                # add comment like ' # 3 = 1 + 2'
                while ( $token_flag ) {
                    my $_token = $tokens[$token_flag];
                    unless ( $_token ) {
                        push @tokens, new PPI::Token::Comment($comment);
                        last;
                    }
                    push @output, $orig->($self, $token_flag);
                    $token_flag++;
                    if ( $_token->isa('PPI::Token::Structure') and
                         $_token->content ne ')' ) {
                        insert_after { $_ eq $_token } new PPI::Token::Comment($comment) => @tokens;
                        last;
                    }
                }

                $self->token_flag( $token_flag );
                $self->output( \@output );
                $self->tokens( \@tokens );
                return;
            }
        }
    }
    
    $orig->($self, @_);
};

lib/Acme/PlayCode/Plugin/PrintComma.pm  view on Meta::CPAN

our $VERSION   = '0.10';
our $AUTHORITY = 'cpan:FAYLAND';

use vars qw/$printcomma_start/;

around 'do_with_token' => sub {
    my $orig = shift;
    my $self = shift;
    my ( $token ) = @_;

    my $token_flag = $self->token_flag;
    my @tokens = $self->tokens;

    $printcomma_start = 0 unless ( defined $printcomma_start );

    if ( $token->isa('PPI::Token::Word') and $token->content eq 'print' ) {
        $printcomma_start = 1;
    } elsif ( $token->isa('PPI::Token::Structure') ) {
        $printcomma_start = 0;
    } elsif ( $printcomma_start and $token->isa('PPI::Token::Operator')
        and $token->content eq '.' ) {
        if ( $tokens[$token_flag - 1]->isa('PPI::Token::Whitespace') ) {
            $self->output->[-1] = 'Acme::PlayCode::!@#$%^&*()_+';
        }
        return ',';
    }
    
    $orig->($self, @_);
};

no Moose::Role;