mirror of
https://github.com/RooVetGit/Roo-Code.git
synced 2026-08-28 05:27:24 +00:00
feat: enhance Perl tree-sitter queries with comprehensive patterns
- Improved documentation with detailed comments explaining each query pattern - Added support for modern Perl OO constructs (class, method, role statements) - Enhanced variable declaration and assignment tracking - Better organization with clear section headers - Maintained backward compatibility with original implementation - Added comprehensive test suite for Perl language support
This commit is contained in:
Roo Code
parent
bf90f5ad72
commit
40333dbbe4
3 changed files with 426 additions and 17 deletions
271
src/services/tree-sitter/__tests__/fixtures/sample-perl.ts
Normal file
271
src/services/tree-sitter/__tests__/fixtures/sample-perl.ts
Normal file
|
|
@ -0,0 +1,271 @@
|
|||
export const samplePerlContent = `
|
||||
#!/usr/bin/perl
|
||||
# Comprehensive Perl sample demonstrating various language constructs
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use feature qw(say state signatures);
|
||||
use utf8;
|
||||
|
||||
# Package declaration with version
|
||||
package MyApp::Utils v1.2.3;
|
||||
|
||||
# Import statements
|
||||
use List::Util qw(sum max min);
|
||||
use Data::Dumper;
|
||||
use Moose;
|
||||
use Try::Tiny;
|
||||
|
||||
# Constant declarations
|
||||
use constant {
|
||||
MAX_RETRIES => 3,
|
||||
TIMEOUT => 30,
|
||||
DEBUG_MODE => 1,
|
||||
};
|
||||
|
||||
# Traditional subroutine
|
||||
sub calculate_total {
|
||||
my ($items, $tax_rate) = @_;
|
||||
my $subtotal = sum(@$items);
|
||||
my $tax = $subtotal * $tax_rate;
|
||||
return $subtotal + $tax;
|
||||
}
|
||||
|
||||
# Subroutine with prototype
|
||||
sub add_numbers ($$) {
|
||||
my ($x, $y) = @_;
|
||||
return $x + $y;
|
||||
}
|
||||
|
||||
# Subroutine with signatures (Perl 5.20+)
|
||||
sub modern_function ($name, $age = 18, @hobbies) {
|
||||
say "Name: $name";
|
||||
say "Age: $age";
|
||||
say "Hobbies: " . join(", ", @hobbies);
|
||||
return {
|
||||
name => $name,
|
||||
age => $age,
|
||||
hobbies => \\@hobbies
|
||||
};
|
||||
}
|
||||
|
||||
# Anonymous subroutine
|
||||
my $validator = sub {
|
||||
my ($input) = @_;
|
||||
return $input =~ /^[a-zA-Z0-9]+$/;
|
||||
};
|
||||
|
||||
# Method in OO Perl
|
||||
sub new {
|
||||
my ($class, %args) = @_;
|
||||
my $self = {
|
||||
name => $args{name} // 'Unknown',
|
||||
age => $args{age} // 0,
|
||||
};
|
||||
bless $self, $class;
|
||||
return $self;
|
||||
}
|
||||
|
||||
# Moose attribute
|
||||
has 'username' => (
|
||||
is => 'rw',
|
||||
isa => 'Str',
|
||||
required => 1,
|
||||
trigger => sub {
|
||||
my ($self, $new, $old) = @_;
|
||||
$self->log_change($old, $new);
|
||||
}
|
||||
);
|
||||
|
||||
# Method modifier
|
||||
before 'save' => sub {
|
||||
my $self = shift;
|
||||
$self->validate_data();
|
||||
$self->update_timestamp();
|
||||
};
|
||||
|
||||
# State variable (persistent lexical)
|
||||
sub counter {
|
||||
state $count = 0;
|
||||
return ++$count;
|
||||
}
|
||||
|
||||
# BEGIN block
|
||||
BEGIN {
|
||||
print "Initializing module...\\n";
|
||||
$ENV{APP_MODE} = 'development';
|
||||
}
|
||||
|
||||
# END block
|
||||
END {
|
||||
print "Cleanup operations...\\n";
|
||||
close_all_handles();
|
||||
}
|
||||
|
||||
# Regular expression patterns
|
||||
my $email_regex = qr/^[a-zA-Z0-9._%+-]+@[a-zA-Z0-9.-]+\\.[a-zA-Z]{2,}$/;
|
||||
my $phone_regex = qr/^\\+?[1-9]\\d{1,14}$/;
|
||||
|
||||
# Pattern matching
|
||||
sub parse_log_entry {
|
||||
my ($line) = @_;
|
||||
if ($line =~ /^(\\d{4}-\\d{2}-\\d{2}) (\\d{2}:\\d{2}:\\d{2}) \\[(.+?)\\] (.+)$/) {
|
||||
return {
|
||||
date => $1,
|
||||
time => $2,
|
||||
level => $3,
|
||||
message => $4,
|
||||
};
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
|
||||
# Substitution
|
||||
sub sanitize_input {
|
||||
my ($text) = @_;
|
||||
$text =~ s/<[^>]+>//g; # Remove HTML tags
|
||||
$text =~ s/^\\s+|\\s+$//g; # Trim whitespace
|
||||
$text =~ tr/A-Z/a-z/; # Convert to lowercase
|
||||
return $text;
|
||||
}
|
||||
|
||||
# Here document
|
||||
my $config = <<'END_CONFIG';
|
||||
[database]
|
||||
host = localhost
|
||||
port = 5432
|
||||
name = myapp_db
|
||||
|
||||
[cache]
|
||||
driver = redis
|
||||
ttl = 3600
|
||||
END_CONFIG
|
||||
|
||||
# Format declaration
|
||||
format REPORT =
|
||||
@<<<<<<<<<<< @||||||||| @>>>>>>>>>
|
||||
$name, $status, $score
|
||||
.
|
||||
|
||||
# Complex data structures
|
||||
my %user_permissions = (
|
||||
admin => {
|
||||
read => 1,
|
||||
write => 1,
|
||||
delete => 1,
|
||||
},
|
||||
user => {
|
||||
read => 1,
|
||||
write => 0,
|
||||
delete => 0,
|
||||
},
|
||||
);
|
||||
|
||||
# Typeglob manipulation
|
||||
*alias_function = \\&original_function;
|
||||
|
||||
# Exception handling with eval
|
||||
eval {
|
||||
dangerous_operation();
|
||||
another_risky_call();
|
||||
};
|
||||
if ($@) {
|
||||
warn "Error occurred: $@";
|
||||
handle_error($@);
|
||||
}
|
||||
|
||||
# Try::Tiny exception handling
|
||||
try {
|
||||
$result = risky_calculation();
|
||||
} catch {
|
||||
warn "Caught error: $_";
|
||||
$result = get_default_value();
|
||||
} finally {
|
||||
cleanup_resources();
|
||||
};
|
||||
|
||||
# Given/when (smart matching)
|
||||
given ($user_type) {
|
||||
when ('admin') {
|
||||
grant_full_access();
|
||||
}
|
||||
when ('moderator') {
|
||||
grant_moderate_access();
|
||||
}
|
||||
when ('user') {
|
||||
grant_basic_access();
|
||||
}
|
||||
default {
|
||||
deny_access();
|
||||
}
|
||||
}
|
||||
|
||||
# Package with namespace
|
||||
package MyApp::Model::User {
|
||||
use Moose;
|
||||
use namespace::autoclean;
|
||||
|
||||
has 'id' => (
|
||||
is => 'ro',
|
||||
isa => 'Int',
|
||||
);
|
||||
|
||||
has 'email' => (
|
||||
is => 'rw',
|
||||
isa => 'Str',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
sub authenticate {
|
||||
my ($self, $password) = @_;
|
||||
return $self->check_password($password);
|
||||
}
|
||||
|
||||
__PACKAGE__->meta->make_immutable;
|
||||
}
|
||||
|
||||
# Role definition
|
||||
package MyApp::Role::Timestamped {
|
||||
use Moose::Role;
|
||||
|
||||
has 'created_at' => (
|
||||
is => 'ro',
|
||||
isa => 'DateTime',
|
||||
default => sub { DateTime->now },
|
||||
);
|
||||
|
||||
has 'updated_at' => (
|
||||
is => 'rw',
|
||||
isa => 'DateTime',
|
||||
);
|
||||
|
||||
before 'save' => sub {
|
||||
my $self = shift;
|
||||
$self->updated_at(DateTime->now);
|
||||
};
|
||||
}
|
||||
|
||||
# Class using role
|
||||
package MyApp::Model::Post {
|
||||
use Moose;
|
||||
with 'MyApp::Role::Timestamped';
|
||||
|
||||
has 'title' => (
|
||||
is => 'rw',
|
||||
isa => 'Str',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'content' => (
|
||||
is => 'rw',
|
||||
isa => 'Str',
|
||||
);
|
||||
}
|
||||
|
||||
1; # End of module
|
||||
`
|
||||
|
||||
export default {
|
||||
path: "test.pl",
|
||||
content: samplePerlContent,
|
||||
}
|
||||
|
|
@ -0,0 +1,108 @@
|
|||
// npx vitest services/tree-sitter/__tests__/parseSourceCodeDefinitions.perl.spec.ts
|
||||
|
||||
import { testParseSourceCodeDefinitions, debugLog } from "./helpers"
|
||||
import { samplePerlContent } from "./fixtures/sample-perl"
|
||||
import { perlQuery } from "../queries"
|
||||
|
||||
// Perl test options
|
||||
const perlOptions = {
|
||||
language: "perl",
|
||||
wasmFile: "tree-sitter-perl.wasm",
|
||||
queryString: perlQuery,
|
||||
extKey: "pl",
|
||||
}
|
||||
|
||||
describe("parseSourceCodeDefinitionsForFile with Perl", () => {
|
||||
let parseResult: string | undefined
|
||||
|
||||
beforeAll(async () => {
|
||||
// Cache parse result for all tests
|
||||
parseResult = await testParseSourceCodeDefinitions("test.pl", samplePerlContent, perlOptions)
|
||||
debugLog("Perl Parse Result:", parseResult)
|
||||
})
|
||||
|
||||
it("should parse subroutine definitions", () => {
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| sub calculate_total \{/)
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| sub add_numbers \(\$\$\) \{/)
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| sub modern_function \(\$name, \$age = 18, @hobbies\) \{/)
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| my \$validator = sub \{/)
|
||||
debugLog("Subroutine definitions found:", parseResult)
|
||||
})
|
||||
|
||||
it("should parse package and module declarations", () => {
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| package MyApp::Utils v1\.2\.3;/)
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| package MyApp::Model::User \{/)
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| package MyApp::Model::Post \{/)
|
||||
debugLog("Package declarations found:", parseResult)
|
||||
})
|
||||
|
||||
it("should parse use and require statements", () => {
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| use strict;/)
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| use warnings;/)
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| use List::Util qw\(sum max min\);/)
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| use Moose;/)
|
||||
debugLog("Import statements found:", parseResult)
|
||||
})
|
||||
|
||||
it("should parse OO constructs and Moose attributes", () => {
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| sub new \{/)
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| has 'username' => \(/)
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| has 'email' => \(/)
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| before 'save' => sub \{/)
|
||||
debugLog("OO constructs found:", parseResult)
|
||||
})
|
||||
|
||||
it("should parse role definitions", () => {
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| package MyApp::Role::Timestamped \{/)
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| with 'MyApp::Role::Timestamped';/)
|
||||
debugLog("Role definitions found:", parseResult)
|
||||
})
|
||||
|
||||
it("should parse special blocks", () => {
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| BEGIN \{/)
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| END \{/)
|
||||
debugLog("Special blocks found:", parseResult)
|
||||
})
|
||||
|
||||
it("should parse variable declarations", () => {
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| my \$email_regex = qr/)
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| my \$config = <<'END_CONFIG';/)
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| state \$count = 0;/)
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| my %user_permissions = \(/)
|
||||
debugLog("Variable declarations found:", parseResult)
|
||||
})
|
||||
|
||||
it("should parse constants", () => {
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| use constant \{/)
|
||||
expect(parseResult).toMatch(/MAX_RETRIES => 3/)
|
||||
expect(parseResult).toMatch(/TIMEOUT\s+=> 30/)
|
||||
debugLog("Constants found:", parseResult)
|
||||
})
|
||||
|
||||
it("should parse regex patterns and operations", () => {
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| if \(\$line =~ /)
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| \$text =~ s\/<\[\^>\]\+>\/\/g;/)
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| \$text =~ tr\/A-Z\/a-z\/;/)
|
||||
debugLog("Regex patterns found:", parseResult)
|
||||
})
|
||||
|
||||
it("should parse exception handling", () => {
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| eval \{/)
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| try \{/)
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| } catch \{/)
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| } finally \{/)
|
||||
debugLog("Exception handling found:", parseResult)
|
||||
})
|
||||
|
||||
it("should parse given/when statements", () => {
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| given \(\$user_type\) \{/)
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| when \('admin'\) \{/)
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| default \{/)
|
||||
debugLog("Given/when statements found:", parseResult)
|
||||
})
|
||||
|
||||
it("should parse format declarations", () => {
|
||||
expect(parseResult).toMatch(/\d+--\d+ \| format REPORT =/)
|
||||
debugLog("Format declarations found:", parseResult)
|
||||
})
|
||||
})
|
||||
|
|
@ -1,40 +1,70 @@
|
|||
/*
|
||||
Perl Tree-sitter Query Patterns - Based on actual node-types.json structure
|
||||
Perl Tree-sitter Query Patterns
|
||||
Enhanced version with improved documentation and structure
|
||||
*/
|
||||
export default `
|
||||
; Subroutine declarations (main Perl construct)
|
||||
; ============================================================================
|
||||
; Core Subroutine/Function Definitions
|
||||
; ============================================================================
|
||||
|
||||
; Traditional subroutine declarations - the main Perl construct for functions
|
||||
(subroutine_declaration_statement
|
||||
name: (bareword) @name) @definition.function
|
||||
name: (bareword) @name.definition.function) @definition.function
|
||||
|
||||
; Package statements
|
||||
; ============================================================================
|
||||
; Package/Module/Class Structure
|
||||
; ============================================================================
|
||||
|
||||
; Package statements - fundamental Perl organizational unit
|
||||
; Captures both traditional packages and modern namespaces
|
||||
(package_statement
|
||||
name: (package) @name) @definition.package
|
||||
name: (package) @name.definition.package) @definition.package
|
||||
|
||||
; Use statements (imports)
|
||||
; Use statements - imports, pragmas, and module loading
|
||||
; Examples: use strict; use warnings; use List::Util qw(sum);
|
||||
(use_statement
|
||||
module: (package) @name) @definition.import
|
||||
module: (package) @name.definition.import) @definition.import
|
||||
|
||||
; Method declarations (modern Perl)
|
||||
; ============================================================================
|
||||
; Modern Perl OO Constructs
|
||||
; ============================================================================
|
||||
|
||||
; Method declarations (modern Perl with method keyword)
|
||||
; Used in frameworks like Moose, Moo, or with Function::Parameters
|
||||
(method_declaration_statement
|
||||
name: (bareword) @name) @definition.method
|
||||
name: (bareword) @name.definition.method) @definition.method
|
||||
|
||||
; Class statements (modern Perl)
|
||||
; Class statements (modern Perl OO with class keyword)
|
||||
; Available in Perl 5.38+ or with Object::Pad, Corinna
|
||||
(class_statement
|
||||
name: (package) @name) @definition.class
|
||||
name: (package) @name.definition.class) @definition.class
|
||||
|
||||
; Role statements (modern Perl)
|
||||
; Role statements (Moose/Moo roles for composition)
|
||||
; Used for role-based composition in modern Perl OO
|
||||
(role_statement
|
||||
name: (package) @name) @definition.role
|
||||
name: (package) @name.definition.role) @definition.role
|
||||
|
||||
; Variable declarations - capture any variable declaration
|
||||
; ============================================================================
|
||||
; Variable Declarations and Assignments
|
||||
; ============================================================================
|
||||
|
||||
; Variable declarations - captures my, our, local, state declarations
|
||||
; This is a catch-all for all variable declaration types
|
||||
(variable_declaration) @definition.variable
|
||||
|
||||
; Assignment expressions for capturing variable assignments
|
||||
; Assignment expressions - tracks variable assignments and initializations
|
||||
; Captures both simple and complex assignments
|
||||
(assignment_expression) @definition.assignment
|
||||
|
||||
; Function calls for reference tracking
|
||||
; ============================================================================
|
||||
; Function and Method Calls (for reference tracking)
|
||||
; ============================================================================
|
||||
|
||||
; Function calls - tracks usage of subroutines and built-in functions
|
||||
; Examples: print(), calculate_total($items), Data::Dumper::Dumper($ref)
|
||||
(function_call_expression) @reference.function
|
||||
|
||||
; Method calls for reference tracking
|
||||
; Method calls - tracks OO method invocations
|
||||
; Examples: $object->method(), $class->new(), $self->calculate()
|
||||
(method_call_expression) @reference.method
|
||||
`
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue