File Coverage

blib/lib/File/PackageIndexer/PPI/ClassXSAccessor.pm

Criterion	Covered	Total	%
statement	52	52	100.0
branch	32	42	76.1
condition	6	9	66.6
subroutine	4	4	100.0
pod	0	1	0.0
total	94	108	87.0

package File::PackageIndexer::PPI::ClassXSAccessor;

use 5.008001;
use strict;
use warnings;

our $VERSION = '0.01';


# The Class::XSAccessor special case
sub handle_class_xsaccessor {
  my $indexer = shift;
  my $statement = shift;
  my $curpkg = shift;
  my $pkgs = shift;

  my @subs;
  my $class = defined($curpkg) ? $curpkg->{name} : $indexer->default_package;
  my $started = 0;
  my $state = "key";
  my $key;
  my @tokens = $statement->schildren();
  pop @tokens; # remove ;

  while (@tokens) {
    my $token = shift @tokens;
    next if $token->class eq 'PPI::Token::Whitespace';
    $started = 1, next if not $started and $token->content =~ /^Class::XSAccessor(?:::Array)?$/;
    next if not $started;

    # handle embedded ()'s
    if ($token->isa("PPI::Structure::List")) {
      my @t = $token->schildren;
      foreach my $t (@t) {
        unshift @tokens, ($t->isa("PPI::Statement::Expression") ? $t->schildren() : $t);
      }
      next;
    }

    if ($state eq 'key') {
      my $keyname = File::PackageIndexer::PPI::Util::get_keyname($token);
      return() if not defined $keyname; # broken usage?
      $key = $keyname;
      $state = 'comma';
    }
    elsif ($state eq 'comma') {
      return() unless $token->isa("PPI::Token::Operator");
      last if $token->content eq ';';
      return() unless $token->content =~ /^(?:,|=>)$/; # are there other valid comma-likes?
      $state = defined($key) ? 'value' : 'key';
    }
    elsif ($state eq 'value') {
      if ($key eq 'class') {
        $class = $token->isa("PPI::Token::Quote") ? $token->string : $token->content;
      }
      elsif ($key =~ /^(?:chained|replace)$/) {
        # option, do nothing
      }
      elsif ($token->isa("PPI::Structure::Constructor")) {
        my $struct = File::PackageIndexer::PPI::Util::constructor_to_structure($token);
        if ($struct and ref($struct) eq 'ARRAY') {
          push @subs, @$struct;
        }
        elsif ($struct and ref($struct) eq 'HASH') {
          push @subs, keys %$struct;
        }
      }
      elsif ($token->isa("PPI::Token::Quote")) {
        push @subs, $token->string;
      }
      $key = undef;
      $state = 'comma';
    } # end if value

  } # end while tokens

  my $pkg = $indexer->lazy_create_pkg($class, $pkgs);
  my $subs = $pkg->{subs};
  $pkg->{subs}{$_} = 1 for @subs;
  return();
}



1;

__END__