view release on metacpan or  search on metacpan

Fathom.pm  view on Meta::CPAN

    if    ($score < 1) { $opinion = "trivial" }
    elsif ($score < 2) { $opinion = "easy" }
    elsif ($score < 3) { $opinion = "very readable" }
    elsif ($score < 4) { $opinion = "readable" }
    elsif ($score < 5) { $opinion = "easier than the norm" }
    elsif ($score < 6) { $opinion = "mature" }
    elsif ($score < 7) { $opinion = "complex" }
    elsif ($score < 8) { $opinion = "very difficult" }
    else               { $opinion = "obfuscated" }

    $output .= sprintf "%5d token%s\n",      $Tok,   ($Tok   == 1 ? "" : "s");
    $output .= sprintf "%5d expression%s\n", $Expr,  ($Expr  == 1 ? "" : "s");
    $output .= sprintf "%5d statement%s\n",  $State, ($State == 1 ? "" : "s");
    $output .= sprintf "%5d subroutine%s\n", $Sub,   ($Sub   == 1 ? "" : "s");

    $output .= sprintf "readability is %.2f (%s)\n", $score, $opinion;

    return $output;
}


# This method is called on each OP in the tree we're examining; see
# do_compile() above.  It examines the OP, and then increments the
# count of tokens, expressions, statements, and subroutines as
# appropriate.

my $linenum;
my (%TokPerLine, %ExprPerLine, %StatePerLine, %SubPerLine);

sub perline {
    if ($Verbose > 1 and defined $linenum) {
        my $output  = sprintf
            "%4d  %2d tokens %2d expressions %2d statements %2d subs %s\n",
            $linenum, $TokPerLine{$linenum}, $ExprPerLine{$linenum},
            $StatePerLine{$linenum}, $SubPerLine{$linenum},
            score($TokPerLine{$linenum}, $ExprPerLine{$linenum},
                $StatePerLine{$linenum}, $SubPerLine{$linenum})
        ;

        undef $linenum;

        return $output;
    }

    return "";
}


###
### The next three subs are all in package B::OBJECT; this is so
### that all OP's will inherit the subs as methods.
###


sub B::OBJECT::tally_op
{
    my ($self)  = @_;
    my $ppaddr  = $self->can('ppaddr') ? $self->ppaddr : undef;
    my $output  = "";

    # Normalize EMBED and non-EMBED ppaddr's:
    $ppaddr =~ s/^Perl_// or                                # Historic
    $ppaddr =~ s/^PL_ppaddr\[OP_(\w+)\]/'pp_' . lc $1/e;    # 5.6.0+

    if ($self->can('line')) {
       $output  = perline();
       $linenum = $self->line;
    }

    $output .= sprintf("%3d %-15s %s\n", $linenum, $ppaddr, ref($self))
        if $Verbose > 1;

    my ($TokOld, $ExprOld, $StateOld, $SubOld)  = ($Tok, $Expr, $State, $Sub);

    if      ($Boring{$ppaddr}) {
        # Do nothing; these OPs don't count
    } elsif ($ppaddr eq 'pp_nextstate' or $ppaddr eq 'pp_dbstate') {
        $Tok += 1;             $State += 1;
    } elsif ($ppaddr eq 'pp_leavesub') {    # sub name { <xxx> }
        $Tok += 4; $Expr += 1; $State += 1; $Sub += 1;
    } elsif ($ppaddr =~ /^pp_leave/) {
        # pp_leave* is already accounted for in its matching pp_enter*
    } elsif ($ppaddr eq 'pp_entertry') {    # eval { <xxx> }
        $Tok += 3; $Expr += 1;
    } elsif ($ppaddr eq 'pp_anoncode') {    # sub { <xxx> }
        $Tok += 3; $Expr += 1;
    } elsif ($ppaddr eq 'pp_scope') {       # do { <xxx> }
        $Tok += 3; $Expr += 1;
    } elsif ($ppaddr eq 'pp_entersub') {    # foo()
        $Tok += 3; $Expr += 1;
    } elsif ($self->isa('B::LOOP')) {       # for (<xxx>) { <yyy> }
        $Tok += 5; $Expr += 2;
    } elsif ($self->isa('B::LISTOP')) {     # OP(<xxx>)
        $Tok += 3; $Expr += 1;
    } elsif ($self->isa('B::BINOP')) {      # <xxx> OP <yyy>
        $Tok += 1; $Expr += 1;
    } elsif ($self->isa('B::LOGOP')) {      # <xxx> OP <yyy>
        $Tok += 1; $Expr += 1;
    } elsif ($self->isa('B::CONDOP')) {     # while (<xxx>) { <yyy> }
        $Tok += 5; $Expr += 2;
    } elsif ($self->isa('B::UNOP')) {       # OP <xxx>
        $Tok += 1; $Expr += 1;
    } else {                                # OP
        $Tok += 1;
    }

    if (defined $linenum) {
        $TokPerLine{$linenum}   += $Tok   - $TokOld;
        $ExprPerLine{$linenum}  += $Expr  - $ExprOld;
        $StatePerLine{$linenum} += $State - $StateOld;
        $SubPerLine{$linenum}   += $Sub   - $SubOld;
    }

    return $output;
}


# Keep track of the sub associated with each symbol.  If we find multiple
# symbol table entries pointing to one sub, then we'll guess (in
# do_compile()) that the sub is imported, and we'll ignore it.  Thanks
# to Mark-Jason Dominus for suggesting this strategy.