File Coverage

blib/lib/Test/Pcuke/Gherkin/Node.pm

Criterion	Covered	Total	%
statement	49	49	100.0
branch	15	16	93.7
condition	2	2	100.0
subroutine	11	11	100.0
pod	1	1	100.0
total	78	79	98.7

package Test::Pcuke::Gherkin::Node;

use warnings;
use strict;

use Scalar::Util qw(refaddr);
use Carp;

=head1 NAME

Test::Pcuke::Gherkin::Node - Base class for Gherkin nodes

=head1 SYNOPSIS

	package MyClass;
    use base 'Test::Pcuke::Gherkin::Node';

    sub new {
		my ($class, %args) = @_;

		my @properties = qw{property1 property2};
		my @immutable_properties = qw{immutable1 immutable2};

		return $class->SUPER::new(
			immutable_properties	=> [ @immutable_properties ],
			properties				=> [ @properties ],
			args					=> {%args}
		);
    }

    sub set_property1 {
    	my ($self, $value) = @_;
    	$self->_set_property('property1', $value);
    }

    sub property1 { $_[0]->_get_property('property1'); }

    #... etc.

=head1 METHODS

=cut

{

	my %properties = ();
	my %immutables  = ();

=head2 new

=cut

	sub new {
		my ($class, %conf) = @_;

		my $self = bless \do { my $anonymous_scalar }, $class;

		return $self
			unless %conf;

		my $args = $conf{args};
		return $self
			unless $args;

		if ( ref $conf{properties} eq 'ARRAY' ) {
			foreach my $name ( @{ $conf{properties} } ) {
				$self->_set_property( $name, $args->{$name} )
					if defined $args->{$name};
			}
		}

		if ( ref $conf{immutables} eq 'ARRAY' ) {
			foreach my $name ( @{ $conf{immutables} } ) {
				$self->_set_immutable($name, $args->{$name})
					if defined $args->{$name};
			}
		}

		return $self;
	}

	sub DESTROY {
		my $key = refaddr shift;
		delete $properties{$key};
		delete $immutables{$key};
	}

	sub _set_property {
		my ($self, $name, $value) = @_;
		my $key = refaddr $self;
		$properties{$key}->{$name} = $value;
	}

	sub _set_immutable {
		my ($self, $name, $value) = @_;

		my $key = refaddr $self;

		if ( defined $immutables{$key}->{$name} ) {
			confess ref($self) . "::$name is an immutable property and can not be changed";
		}
		else {
			$immutables{$key}->{$name} = $value || q{};
		}
	}

	sub _get_property {
		my ($self, $name) = @_;
		my $key = refaddr $self;
		$properties{$key}->{$name};
	}

	sub _get_immutable {
		my ($self, $name) = @_;
		my $key = refaddr  $self;
		$immutables{$key}->{$name};
	}

}

sub _add_property {
	my ($self, $name, $value) = @_;

	confess "scenario must be defined"
		unless $value;

	my $values = $self->_get_property($name);
	push @$values, $value;
	$self->_set_property($name, $values);

}

1; # End of Test::Pcuke::Gherkin::Node
__END__