File Coverage

blib/lib/PPI/Statement/Variable.pm

Criterion	Covered	Total	%
statement	38	39	97.4
branch	14	22	63.6
condition	8	15	53.3
subroutine	7	7	100.0
pod	3	3	100.0
total	70	86	81.4

package PPI::Statement::Variable;

=pod

=head1 NAME

PPI::Statement::Variable - Variable declaration statements

=head1 SYNOPSIS

  # All of the following are variable declarations
  my $foo = 1;
  my ($foo, $bar) = (1, 2);
  our $foo = 1;
  local $foo;
  local $foo = 1;
  LABEL: my $foo = 1;

=head1 INHERITANCE

  PPI::Statement::Variable
  isa PPI::Statement::Expression
      isa PPI::Statement
          isa PPI::Node
              isa PPI::Element

=head1 DESCRIPTION

The main intent of the C class is to describe
simple statements that explicitly declare new local or global variables.

Note that this does not make it exclusively the only place where variables
are defined, and later on you should expect that the C method
will migrate deeper down the tree to either L or
L to recognise this fact, but for now it stays here.

=head1 METHODS

=cut

use strict;
use Params::Util               qw{_INSTANCE};
use PPI::Statement::Expression ();

our $VERSION = '1.277';

our @ISA = "PPI::Statement::Expression";

=pod

=head2 type

The C method checks and returns the declaration type of the statement,
which will be one of 'my', 'local', 'our', or 'state'.

Returns a string of the type, or C if the type cannot be detected
(which is probably a bug).

=cut

sub type {
	my $self = shift;

	# Get the first significant child
	my @schild = grep { $_->significant } $self->children;

	# Ignore labels
	shift @schild if _INSTANCE($schild[0], 'PPI::Token::Label');

	# Get the type
	(_INSTANCE($schild[0], 'PPI::Token::Word') and $schild[0]->content =~ /^(my|local|our|state)$/)
		? $schild[0]->content
		: undef;
}

=pod

=head2 variables

As for several other PDOM Element types that can declare variables, the
C method returns a list of the canonical forms of the variables
defined by the statement.

Returns a list of the canonical string forms of variables, or the null list
if it is unable to find any variables.

=cut

sub variables {
	map { $_->canonical } $_[0]->symbols;
}

=pod

=head2 symbols

Returns a list of the variables defined by the statement, as
Ls.

=cut

sub symbols {
	my $self = shift;

	# Get the children we care about
	my @schild = grep { $_->significant } $self->children;
	shift @schild if _INSTANCE($schild[0], 'PPI::Token::Label');

	# If the second child is a symbol, return its name
	if ( _INSTANCE($schild[1], 'PPI::Token::Symbol') ) {
		return $schild[1];
	}

	# If it's a list, return as a list
	if ( _INSTANCE($schild[1], 'PPI::Structure::List') ) {
		my $Expression = $schild[1]->schild(0);
		$Expression and
		$Expression->isa('PPI::Statement::Expression') or return ();

		# my and our are simpler than local
		if (
			$self->type eq 'my'
			or
			$self->type eq 'our'
			or
			$self->type eq 'state'
		) {
			return grep {
				$_->isa('PPI::Token::Symbol')
			} $Expression->schildren;
		}

		# Local is much more icky (potentially).
		# Not that we are actually going to deal with it now,
		# but having this separate is likely going to be needed
		# for future bug reports about local() things.

		# This is a slightly better way to check.
		return grep {
			$self->_local_variable($_)
		} grep {
			$_->isa('PPI::Token::Symbol')
		} $Expression->schildren;
	}

	# erm... this is unexpected
	();
}

sub _local_variable {
	my ($self, $el) = @_;

	# The last symbol should be a variable
	my $n = $el->snext_sibling or return 1;
	my $p = $el->sprevious_sibling;
	if ( ! $p or $p eq ',' ) {
		# In the middle of a list
		return 1 if $n eq ',';

		# The first half of an assignment
		return 1 if $n eq '=';
	}

	# Lets say no for know... additional work
	# should go here.
	return '';
}

1;

=pod

=head1 TO DO

- Write unit tests for this

=head1 SUPPORT

See the L in the main module.

=head1 AUTHOR

Adam Kennedy [e-mail]

=head1 COPYRIGHT

Copyright 2001 - 2011 Adam Kennedy.

This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the
LICENSE file included with this module.

=cut