package Filter::Self;
use Filter::Simple;
use Text::Balanced qw(extract_quotelike);
use YAML;
use Tie::IxHash;

=head1 NAME

Filter::Self - more concise OO for perl

=head1 SYNOPSIS

  use Filter::Self;
  use Filter::Self qw(echo);

=head1 DESCRIPTION

Filter::Self provides some simpler syntax for perl OO and subs:

  this code:                   becomes:
  ----------                   --------

  print .name;                 print $self->{name};

  .recalc($alpha);             $self->recalc($alpha);

  sub say($str) {              sub say {
                                   my ($str) = @_;

  sub .recalc($alpha) {        sub recalc {
                                   my ($self, $alpha) = @_; shift;

  .foo.bar.baz = 1;            $self->{foo}->{bar}->{baz} = 1;

  $obj.name = "fred";          $obj->{name} = "fred";

=head1 BUGS

There's no simple way to interpolate .foo variables in strings.

=head1 HISTORY

Written by Sam Watkins, 2010.

=cut


our $echo;

sub import {
	my $pkg = shift;
	$echo = 1 if grep {$_ eq "echo"} @_;
}

FILTER_ONLY
	code_no_comments => \&code_filter;

sub code_filter {
	s{\bsub (\w+)\((.*?)\) \{}{sub $1 \{\n\tmy ($2) = \@_;}g;
	s{\bsub \.(\w+) \{}{sub .$1() \{}g;
	s{\bsub \.(\w+)\((.*?)\) \{}{sub $1 \{\n\tmy (\$self, $2) = \@_; shift;}g;
	s{(?<=\w)\.(\w+)\(}{->$1(}g;
	s{(?<=\w)\.(\w+)}{->{$1}}g;
	s{\.(\w+)\(}{\$self->$1(}g;
	s{\$\.(\w+)}{\${\$self->{$1}}}g;
	s{\@\.(\w+)}{\@{\$self->{$1}}}g;
	s{\%\.(\w+)}{\%{\$self->{$1}}}g;
	s{\.(\w+)}{\$self->{$1}}g;

	for (@Filter::Simple::components) { for my $quoted ($$_) {
		my ($all, $rest, $prefix, $op, $left1, $block1, $right1,
		    $left2, $block2, $right2, $suffix)
		  = extract_quotelike($quoted, '');
		next if $all eq "";
		warn Dump(ix(all=>$all, rest=>$rest, prefix=>$prefix, op=>$op, left1=>$left1, block1=>$block1, right1=>$right1, left2=>$left2, block2=>$block2, right2=>$right2, suffix=>$suffix)), "\n";
		warn "op: >$op< ", join(";", @list), "\n";
#		if ($string =~ m{^"|qq|<<[^']) {  # also s? s{}{...}?
#			$$_ =~ s{[\$\@%]\.(\w+)}{\$self->{$1}}g;
#		}
#		if ($name eq "<<") {
		my $reconstructed = "$prefix$op$left1$block1$right1$left2$block2$right2$suffix";
		if ($reconstructed ne $quoted) {
			warn "reconstructed string ne original:\n", Dump({original=>$quoted, reconstructed=>$reconstructed}), "\n";
		}
	} }
};

sub ix {
	my $hash = {};
	tie $hash, Tie::IxHash, @_;
	return $hash;
}

1 ;
