Devel::PerlySense::Document::Api - The methods (and their locations)

  sub

use strict;
use warnings;

package Devel::PerlySense::Document::Api;
our $VERSION = '0.01';





use Spiffy -Base;
use Carp;
use Data::Dumper;

use Devel::PerlySense::Document;
use Devel::PerlySense::Document::Location;

field "rhSub" => {};

sub new(@) {
    my $pkg = shift;
    my (%p) = @_;

    my $self = bless {}, $pkg;

    return($self);
}

sub aNameSubVisible {
    my ($oPerlySense, $fileCurrent) = Devel::PerlySense::Util::aNamedArg(["oPerlySense", "fileCurrent"], @_);

    my $rsSortSub = $self->rsSortSub($fileCurrent);
    my @aNameSubVisible =
            sort $rsSortSub
            grep { ! $self->isSubVisible($oPerlySense, $fileCurrent, $_) }
            keys %{$self->rhSub};

    return(@aNameSubVisible);
}

sub isSubVisible {
    my ($oPerlySense, $fileCurrent, $nameMethod) = @_;

    my $file = $self->rhSub->{$_}->file;
    my $isInvisible =
            #Is it a base class (file ne current file)?
            $file ne $fileCurrent
            #Is it a private method?   ###TODO: Extract to method, then class *::Method->isPrivate
            && $_ =~ /^_/
            #Is it outside the project?
            && ! $oPerlySense->isFileInProject(
                file => $file,
                fileProjectOf => $fileCurrent,
            );

    return $isInvisible;
}

sub rsSortSub {
    my ($fileCurrent) = @_;

    my $rhSub = $self->rhSub();
    return sub {
        (
            #If unknown location, display it first no matter what
            ( ! $rhSub->{$b}->row ) <=> ( ! $rhSub->{$a}->row)
                    or # Then alphabetically (case insensitive)
             uc($a) cmp uc($b)
         )
                || #Display the current file's methods first
         ($rhSub->{$a}->file eq $fileCurrent) <=> ($rhSub->{$b}->file eq $fileCurrent)
                 || #then alphabetically
         $rhSub->{$a}->file cmp $rhSub->{$b}->file   ###TODO: inheritance tree
                 || # Then the order in the file
         $rhSub->{$a}->row <=> $rhSub->{$b}->row
                 || # Then method name alphabetically (case insensitive) (if on the same row)
         uc($a) cmp uc($b)
     };
}

sub parsePackageSetSub {
    my ($raNodeSub, $source, $oDocument) = Devel::PerlySense::Util::aNamedArg(["raNodeSub", "source", "oDocument"], @_);

    #Temporal cohesion: let the sub declarations overwrite the called subs
      #TODO: The called subs shouldn't overwrite sub declarations of a base class
    $self->parseSourceSetSub(source => $source, oDocument => $oDocument);

    for my $oNodeSub (@$raNodeSub) {
        $self->oLocationSetSub(nameSub => $oNodeSub->name, oDocument => $oDocument, oNode => $oNodeSub);
    }

    return(1);
}

sub parseSourceSetSub {
    my ($source, $oDocument) = Devel::PerlySense::Util::aNamedArg(["source", "oDocument"], @_);

    ###TODO: ignore comments, POD

    #Look for $self->method calls
    my @aSelfMethod = $source =~ / \$self \s* -> \s* (\w+) /gsx;

    #Look for $self->{property_name}
    my @aSelfHash =
            #Remove quotes
            map { s/ ^ (["'])  ( [^\1]* )   \1 $ /$2/x; $_ }  ## no critic
            $source =~
            /
                          \$self \s* -> \s* {
                          (
                              (?:  " [^"\ ]+ "  )
                              |
                              (?:  ' [^'\ ]+ '  )
                              |
                              (?:    \w+      )
                          )
                          /gsx;

    my %hSeen;
    for my $method ( grep { ! $hSeen{$_} ++ }  @aSelfMethod, @aSelfHash ) {
        $self->oLocationSetSub(nameSub => $method, oDocument => $oDocument);
    }

    return(1);
}

sub oLocationSetSub {
    my ($nameSub, $oDocument) = Devel::PerlySense::Util::aNamedArg(["nameSub", "oDocument"], @_);
    my %p = @_;  my ($oNode) = ($p{oNode});

    my $oLocation;

    if($oNode) {
        $oLocation = $oDocument->oLocationOfNode($oNode);
    } else {
        $oLocation = Devel::PerlySense::Document::Location->new(
            file => $oDocument->file,
        );
    }

    $oLocation->rhProperty->{sub} = $nameSub;
    $self->rhSub->{$nameSub} = $oLocation;

    return($oLocation);
}

sub mergeWithBase {
    my ($oApiBase) = @_;

    my $rhSub = $self->rhSub;
    while(my ($method, $oLocationBase) = each %{$oApiBase->rhSub}) {

        if(my $oLocation = $rhSub->{$method}) {

            #If both are just seen as $self->X, go with the base one
            if($oLocation->row == 0 && $oLocationBase->row == 0) {   #TODO: refactor: ! hasPosition
                $rhSub->{$method} = $oLocationBase;
            }

            #If the base one is a real declaration and self is only seen as $self->X, go with the base one
            if($oLocationBase->row != 0 && $oLocation->row == 0) {
                $rhSub->{$method} = $oLocationBase;
            }

        } else {
            #Not present in self, copy from base
            $rhSub->{$method} = $oLocationBase;
        }
    }

    return(1);
}

sub isSubSupported {
    my ($nameSub) = @_;
    return( exists $self->rhSub->{$nameSub} );
}

sub percentSupportedOf {
    my ($raNameSub) = @_;

    my $countSupported = grep { $self->isSubSupported($_) } @$raNameSub;
    my $percent = $countSupported / (scalar(@$raNameSub) || 1);

    return($percent * 100);
}

sub percentConsistsOf {
    my ($raNameSub) = @_;

    my %hNameSub = map { $_ => 1 } @$raNameSub;
    my $countConsists = grep { $hNameSub{$_} } keys %{$self->rhSub};
    my $percent = $countConsists / (scalar(keys %{$self->rhSub}) || 1);

    return($percent * 100);
}





1;





__END__