Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

generate metrics for rpc sub, generate sarif format #1

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open

generate metrics for rpc sub, generate sarif format #1

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions .gitignore
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,7 @@
/blib
/Makefile
/pm_to_blib
/.vscode/

/carton.lock
/.carton/
Expand Down
2 changes: 1 addition & 1 deletion cpanfile
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
requires 'perl', '5.008001';
requires 'perl', '5.36';

requires 'Carp';
requires 'File::Basename';
Expand Down
34 changes: 33 additions & 1 deletion lib/Perl/Metrics/Lite/Analysis/File.pm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -51,7 +51,14 @@ sub _init {
= Perl::Metrics::Lite::Analysis::Util::get_packages($document);

my @sub_analysis = ();
my $sub_elements = $document->find('PPI::Statement::Sub');
#my $sub_elements = $document->find('PPI::Statement::Sub');
Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Can we remove it? bcoz we can check this history if it is needed.

Copy link
Owner Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

yes, we obviously can remove iut

my $sub_elements = $document->find(sub {
return '' unless $_[1]->parent == $_[0]
and
($_[1]->isa('PPI::Statement::Sub')
or ($_[1]->isa('PPI::Statement') and $_[1]{children}[0]{content} eq 'rpc')
);
});
@sub_analysis = @{ $self->analyze_subs($sub_elements) };

$_MAIN_STATS{$self} = $self->analyze_file($document);
Expand Down Expand Up @@ -155,6 +162,7 @@ sub analyze_subs {
!Perl::Metrics::Lite::Analysis::Util::is_ref( $found_subs, 'ARRAY' )
);

$found_subs = $self->replace_rpc_with_sub($found_subs);
my @subs = ();
foreach my $sub ( @{$found_subs} ) {
my $metrics = $self->measure_sub_metrics($sub);
Expand All @@ -164,6 +172,30 @@ sub analyze_subs {
return \@subs;
}

sub replace_rpc_with_sub {
my ( $self, $found_subs ) = @_;

my @modified_subs = ();
foreach my $sub ( @{$found_subs} ) {
if (not $sub->isa('PPI::Statement::Sub')) {
my $new_sub = PPI::Statement::Sub->new();
my @indices = grep {$sub->{children}[$_] && defined $sub->{children}[$_]{content} && $sub->{children}[$_]{content} eq 'sub'} 0..$#{$sub->{children}};

if (defined $indices[0]) {
push @{$new_sub->{children}}, @{$sub->{children}}[($indices[0])..$#{$sub->{children}}];
my $new_name = $sub->{children}[2]{content};
$new_sub->{children}[0]->set_content($new_name);
push @modified_subs, $new_sub;
}
}
else {
push @modified_subs, $sub;
}
}

return \@modified_subs;
}

sub measure_sub_metrics {
my ( $self, $sub ) = @_;
my $metrics = {};
Expand Down
100 changes: 89 additions & 11 deletions lib/Perl/Metrics/Lite/Report/Text.pm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@ package Perl::Metrics::Lite::Report::Text;
use strict;
use warnings;
use Text::ASCIITable;
use JSON::XS;

my $DEFAULT_MAX_SUB_LINES = 60;
my $DEFAULT_MAX_MCCABE_COMPLEXITY = 10;
Expand All @@ -26,6 +27,9 @@ sub new {
$self->{max_sub_lines} = $max_sub_lines;
$self->{max_sub_mccabe_complexity} = $max_sub_mccabe_complexity;
$self->{show_only_error} = $show_only_error;
$self->{only_json} = $args{only_json};

$self->{sarif} = {};

return $self;
}
Expand All @@ -38,11 +42,12 @@ sub report {

my $sub_stats = $analysis->sub_stats;
$self->report_sub_stats($sub_stats);
$self->_print_sarif_file();
}

sub report_file_stats {
my ( $self, $file_stats ) = @_;
_print_file_stats_report_header();
$self->_print_file_stats_report_header();

my @rows = ();
foreach my $file_stat ( @{$file_stats} ) {
Expand All @@ -57,14 +62,19 @@ sub report_file_stats {
if (@rows) {
my $keys = [ "path", "loc", "subs", "packages" ];
my $table = $self->_create_table( $keys, \@rows );
print $table;
if ( !($self->{only_json}) ) {
print $table;
}
}
}

sub _print_file_stats_report_header {
print "#======================================#\n";
print "# File Metrics #\n";
print "#======================================#\n";
my ( $self ) = @_;
if ( !($self->{only_json}) ) {
print "#======================================#\n";
print "# File Metrics #\n";
print "#======================================#\n";
}
}

sub report_sub_stats {
Expand All @@ -77,9 +87,13 @@ sub report_sub_stats {
}

sub _print_sub_stats_report_header {
print "#======================================#\n";
print "# Subroutine Metrics #\n";
print "#======================================#\n";
my ($self) = @_;
if ( !($self->{only_json}) ) {
print "#======================================#\n";
print "# Subroutine Metrics #\n";
print "#======================================#\n";
}
$self->_create_sarif_placeholder();
}

sub _report_sub_metrics {
Expand All @@ -93,8 +107,10 @@ sub _report_sub_metrics {
sub _print_table {
my ( $self, $path, $table ) = @_;

print "\nPath: ${path}\n";
print $table;
if ( !($self->{only_json}) ) {
print "\nPath: ${path}\n";
print $table;
}
}

sub _create_ascii_table_for_submetrics {
Expand All @@ -105,11 +121,12 @@ sub _create_ascii_table_for_submetrics {
if $self->{show_only_error}
&& $self->is_sub_metric_ok($sub_metric);
push @rows, $self->_create_row($sub_metric);
$self->_create_sarif_details($sub_metric);
}

my $table;
if (@rows) {
my $keys = [ "method", "loc", "mccabe_complexity" ];
my $keys = [ "method", "loc", "line_number", "mccabe_complexity" ];
$table = $self->_create_table( $keys, \@rows );
}
return $table;
Expand All @@ -129,6 +146,7 @@ sub _create_row {
return {
method => $sub_metric->{name},
loc => $sub_metric->{lines},
line_number => $sub_metric->{line_number},
mccabe_complexity => $sub_metric->{mccabe_complexity}
};
}
Expand All @@ -141,6 +159,66 @@ sub _create_table {
$t;
}

sub _print_sarif_file {
my ($self) = @_;

my $json_sarif = JSON::XS->new->encode($self->{sarif});
print $json_sarif;
}

sub _create_sarif_details {
my ($self, $sub_metrics) = @_;
push @{$self->{sarif}->{runs}->[0]->{results}}, {
level => 'error',
ruleIndex => 0,
message => {
text => 'cyclomatic complexity \'{0}\' for method \'{1}\' is too high',
arguments => [("$sub_metrics->{mccabe_complexity}"), ("$sub_metrics->{name}")]
},
ruleId => 'cyclomatic-complexity',
locations =>
[
{
physicalLocation => {
artifactLocation => {
uri => "file://" . $sub_metrics->{path}
},
region => {
startLine => $sub_metrics->{line_number}
}
}
}
]
}
};

sub _create_sarif_placeholder {
my ( $self) = @_;

$self->{sarif} =
{
version => '2.1.0',
'$schema' => 'http://json.schemastore.org/sarif-2.1.0-rtm.5',
runs => [
{
tool => {
driver => {
name => 'cyclocamtic-complexity',
version => '0.1',
rules => [{
id => 'cyclomatic-complexity',
defaultConfiguration => {
level => 'error'
}
}]
}
},
results => []
}
]
};
}

1;

__END__
11 changes: 8 additions & 3 deletions script/measureperl
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,20 +1,24 @@
#!/usr/bin/perl
#!/opt/homebrew/opt/perl/bin/perl
use strict;
use warnings;
use lib 'blib/lib';
use Getopt::Long ();
use Perl::Metrics::Lite;
use Perl::Metrics::Lite;
use Pod::Usage;
use Perl::Metrics::Lite::Report::Text;

our $VERSION = "0.092";

my $show_only_error = 0;
my $only_json = 0;

Getopt::Long::GetOptions(
'h|help' => \my $help,
'verbose' => \my $verbose,
'l|max_sub_lines=i' => \my $max_sub_lines,
'c|max_sub_mccabe_complexity=i' => \my $max_sub_mccabe_complexity,
'e|show_only_error' => \$show_only_error,
'j|only_json' => \$only_json
) or pod2usage();

pod2usage() if $help;
Expand All @@ -31,7 +35,8 @@ sub report {
my $reporter = Perl::Metrics::Lite::Report::Text->new(
max_sub_lines => $max_sub_lines || 60,
max_sub_mccabe_complexity => $max_sub_mccabe_complexity || 10,
show_only_error => $show_only_error
show_only_error => $show_only_error,
only_json => $only_json || 0,
);
my $analzyer = Perl::Metrics::Lite->new( report_module => $reporter );
my $analysis = $analzyer->analyze_files(@$files);
Expand Down