#!/usr/bin/perl

use strict;
use warnings;

package ArgumentExtractor;

use Class::InsideOut qw/:std/;

use overload (
	q/""/ => \&stringify,
	q/./ => \&catenate,
	q/@{}/ => \&array_deref,
);

private content => my %content_of;
private args => my %args_of;

sub new {
	# create object...
	my $class = shift;
	my $self = \(my $dummy);
	bless $self, $class;
	register($self);

	# initialize it...
	$content_of{id $self} = shift;
	$args_of{id $self} = [];

	# return it...
	return $self;
}

sub string_const {
	# convert string to our object if it is interpolated ...
	my ($exact, $interpreted, $mode) = @_;
	return $interpreted unless $mode eq 'qq';
	print 'const [', $interpreted, "]\n";
	return ArgumentExtractor->new($interpreted);
}

sub stringify {
	# just return the string part ...
	my $self = shift;
	return $content_of{id $self};
}

sub catenate {
	my ($left, $right, $reversed) = @_;

	print 'catenate [', $left, '] (object) . [', $right, '] ',
		UNIVERSAL::isa($right, __PACKAGE__) ? '(object)' : '(plain)',
		' ',
		$reversed ? '(rev)' : '', "\n";
	# create a new blank object...
	my $result = __PACKAGE__->new(q//);

	if (UNIVERSAL::isa($right, __PACKAGE__)) {
		# if both args are objects, it's easy, just merge the
		# two string and args parts...
		($left, $right) = ($right, $left) if $reversed;
		$content_of{id $result}
			= $content_of{id $left}
			. $content_of{id $right};
		$args_of{id $result} = [
			@{$args_of{id $left}},
			@{$args_of{id $right}}
		];
	} else {
		# if the right arg is not an object then create a
		# placeholder in the string part and add it to args...
		if ($reversed) {
			# to the left...
			$content_of{id $result}
				= '%' . $content_of{id $left};
			$args_of{id $result} = [
				$right,
				@{$args_of{id $left}}
			];
		} else {
			# or to the right...
			$content_of{id $result}
				= $content_of{id $left} . '%';
			$args_of{id $result} = [
				@{$args_of{id $left}},
				$right
			];
		}
	}
	return $result;
}

sub import {
	overload::constant(q => \&string_const);
}

sub unimport {
	overload::remove_constant(q => \&string_const);
}

sub array_deref {
	# return an array with all the args...
	my $self = shift;
	return [@{$args_of{id $self}}];
}

1;