From 36b235874d8e508c2fcd4040459310eab7e56d6b Mon Sep 17 00:00:00 2001 From: Roo Code Date: Mon, 1 Sep 2025 20:55:38 +0000 Subject: [PATCH] feat: add Perl support for codebase indexing - Add Perl file extensions (.pl, .pm, .pod, .t) to supported extensions - Create Perl query patterns for tree-sitter parsing - Add Perl language parser configuration - Add comprehensive test suite for Perl parsing - Add sample Perl fixture for testing Note: tree-sitter-perl.wasm file needs to be added to complete the implementation --- .../__tests__/fixtures/sample-perl.ts | 139 +++++++++++++++++ .../parseSourceCodeDefinitions.perl.spec.ts | 141 ++++++++++++++++++ src/services/tree-sitter/index.ts | 5 + src/services/tree-sitter/languageParser.ts | 8 + src/services/tree-sitter/queries/index.ts | 1 + src/services/tree-sitter/queries/perl.ts | 108 ++++++++++++++ 6 files changed, 402 insertions(+) create mode 100644 src/services/tree-sitter/__tests__/fixtures/sample-perl.ts create mode 100644 src/services/tree-sitter/__tests__/parseSourceCodeDefinitions.perl.spec.ts create mode 100644 src/services/tree-sitter/queries/perl.ts diff --git a/src/services/tree-sitter/__tests__/fixtures/sample-perl.ts b/src/services/tree-sitter/__tests__/fixtures/sample-perl.ts new file mode 100644 index 0000000000..e1e418edac --- /dev/null +++ b/src/services/tree-sitter/__tests__/fixtures/sample-perl.ts @@ -0,0 +1,139 @@ +export const samplePerl = `#!/usr/bin/perl +use strict; +use warnings; +use Data::Dumper; +use File::Path qw(make_path); + +# Package declaration +package MyModule; + +# Constants +use constant PI => 3.14159; +use constant DEBUG => 1; + +# Our variables +our $VERSION = '1.0.0'; +our @EXPORT = qw(process_data calculate_sum); + +# State variable (Perl 5.10+) +state $counter = 0; + +# Subroutine with prototype +sub calculate_sum($$) { + my ($a, $b) = @_; + return $a + $b; +} + +# Method with attributes +sub new :method { + my $class = shift; + my $self = { + name => shift, + age => shift, + }; + bless $self, $class; + return $self; +} + +# Anonymous subroutine +my $validator = sub { + my $value = shift; + return $value =~ /^\\d+$/; +}; + +# BEGIN block +BEGIN { + print "Initializing module\\n"; +} + +# END block +END { + print "Cleanup\\n"; +} + +# AUTOLOAD special subroutine +sub AUTOLOAD { + our $AUTOLOAD; + print "Called undefined method: $AUTOLOAD\\n"; +} + +# Regular expression operations +sub process_data { + my $text = shift; + + # Match regex + if ($text =~ /pattern(\\d+)/) { + my $number = $1; + } + + # Substitution regex + $text =~ s/old/new/g; + + # Transliteration + $text =~ tr/a-z/A-Z/; + + return $text; +} + +# Format declaration +format REPORT = +@<<<<<<<<<< @||||| @>>>>>>>>> +$name, $age, $salary +. + +# Label and loop +MAIN_LOOP: +for my $i (1..10) { + next MAIN_LOOP if $i == 5; + print "$i\\n"; +} + +# Try-catch equivalent with eval +eval { + die "Error occurred"; +}; +if ($@) { + print "Caught error: $@\\n"; +} + +# Moose-style attribute (comment for context) +# has 'attribute_name' => ( +# is => 'rw', +# isa => 'Str', +# ); + +# POD documentation +=head1 NAME + +MyModule - A sample Perl module + +=head1 SYNOPSIS + + use MyModule; + my $sum = calculate_sum(5, 10); + +=head1 DESCRIPTION + +This module provides basic mathematical operations. + +=cut + +# Package with version +package MyModule::Utils 1.5.0; + +# Require statement +require Exporter; + +# Local variable modification +sub modify_global { + local $/ = undef; + my $content = ; + return $content; +} + +# File handle +__DATA__ +Sample data content +Multiple lines +End of data +` diff --git a/src/services/tree-sitter/__tests__/parseSourceCodeDefinitions.perl.spec.ts b/src/services/tree-sitter/__tests__/parseSourceCodeDefinitions.perl.spec.ts new file mode 100644 index 0000000000..5a88ce56fb --- /dev/null +++ b/src/services/tree-sitter/__tests__/parseSourceCodeDefinitions.perl.spec.ts @@ -0,0 +1,141 @@ +import { describe, it, expect, beforeAll } from "vitest" +import * as path from "path" +import * as fs from "fs/promises" +import { parseSourceCodeDefinitionsForFile } from "../index" +import { samplePerl } from "./fixtures/sample-perl" + +describe("parseSourceCodeDefinitions - Perl", () => { + const testFilePath = path.join(__dirname, "test-perl-file.pl") + + beforeAll(async () => { + await fs.writeFile(testFilePath, samplePerl, "utf8") + }) + + it("should parse Perl package declarations", async () => { + const result = await parseSourceCodeDefinitionsForFile(testFilePath) + expect(result).toBeDefined() + expect(result).toContain("package MyModule") + expect(result).toContain("package MyModule::Utils") + }) + + it("should parse Perl subroutine definitions", async () => { + const result = await parseSourceCodeDefinitionsForFile(testFilePath) + expect(result).toBeDefined() + expect(result).toContain("sub calculate_sum") + expect(result).toContain("sub new") + expect(result).toContain("sub process_data") + expect(result).toContain("sub modify_global") + }) + + it("should parse Perl special blocks", async () => { + const result = await parseSourceCodeDefinitionsForFile(testFilePath) + expect(result).toBeDefined() + expect(result).toContain("BEGIN") + expect(result).toContain("END") + expect(result).toContain("AUTOLOAD") + }) + + it("should parse Perl constants", async () => { + const result = await parseSourceCodeDefinitionsForFile(testFilePath) + expect(result).toBeDefined() + expect(result).toContain("use constant PI") + expect(result).toContain("use constant DEBUG") + }) + + it("should parse Perl use statements", async () => { + const result = await parseSourceCodeDefinitionsForFile(testFilePath) + expect(result).toBeDefined() + expect(result).toContain("use strict") + expect(result).toContain("use warnings") + expect(result).toContain("use Data::Dumper") + }) + + it("should parse Perl variable declarations", async () => { + const result = await parseSourceCodeDefinitionsForFile(testFilePath) + expect(result).toBeDefined() + expect(result).toContain("our $VERSION") + expect(result).toContain("our @EXPORT") + expect(result).toContain("state $counter") + expect(result).toContain("my $validator") + }) + + it("should parse Perl format declarations", async () => { + const result = await parseSourceCodeDefinitionsForFile(testFilePath) + expect(result).toBeDefined() + expect(result).toContain("format REPORT") + }) + + it("should parse Perl labels", async () => { + const result = await parseSourceCodeDefinitionsForFile(testFilePath) + expect(result).toBeDefined() + expect(result).toContain("MAIN_LOOP:") + }) + + it("should parse Perl require statements", async () => { + const result = await parseSourceCodeDefinitionsForFile(testFilePath) + expect(result).toBeDefined() + expect(result).toContain("require Exporter") + }) + + it("should handle .pm files", async () => { + const pmFilePath = path.join(__dirname, "test-perl-module.pm") + await fs.writeFile(pmFilePath, samplePerl, "utf8") + const result = await parseSourceCodeDefinitionsForFile(pmFilePath) + expect(result).toBeDefined() + expect(result).toContain("package MyModule") + }) + + it("should handle .pod files", async () => { + const podFilePath = path.join(__dirname, "test-perl-doc.pod") + const podContent = ` +=head1 NAME + +Test::Module - A test module + +=head1 DESCRIPTION + +This is a test POD file. + +=cut +` + await fs.writeFile(podFilePath, podContent, "utf8") + const result = await parseSourceCodeDefinitionsForFile(podFilePath) + // POD files might not have code definitions, but should be parseable + expect(result).toBeDefined() + }) + + it("should handle .t test files", async () => { + const testFilePath = path.join(__dirname, "test-perl-test.t") + const testContent = `#!/usr/bin/perl +use Test::More tests => 2; + +sub test_function { + return 42; +} + +ok(1, "Test passes"); +is(test_function(), 42, "Function returns 42"); +` + await fs.writeFile(testFilePath, testContent, "utf8") + const result = await parseSourceCodeDefinitionsForFile(testFilePath) + expect(result).toBeDefined() + expect(result).toContain("sub test_function") + }) + + // Clean up test files + afterAll(async () => { + const filesToClean = [ + testFilePath, + path.join(__dirname, "test-perl-module.pm"), + path.join(__dirname, "test-perl-doc.pod"), + path.join(__dirname, "test-perl-test.t"), + ] + for (const file of filesToClean) { + try { + await fs.unlink(file) + } catch { + // File might not exist, ignore + } + } + }) +}) diff --git a/src/services/tree-sitter/index.ts b/src/services/tree-sitter/index.ts index 145ba84730..de9dc62598 100644 --- a/src/services/tree-sitter/index.ts +++ b/src/services/tree-sitter/index.ts @@ -91,6 +91,11 @@ const extensions = [ "erb", // Visual Basic .NET "vb", + // Perl + "pl", + "pm", + "pod", + "t", ].map((e) => `.${e}`) export { extensions } diff --git a/src/services/tree-sitter/languageParser.ts b/src/services/tree-sitter/languageParser.ts index a8ac0a9ead..4153f91afa 100644 --- a/src/services/tree-sitter/languageParser.ts +++ b/src/services/tree-sitter/languageParser.ts @@ -28,6 +28,7 @@ import { embeddedTemplateQuery, elispQuery, elixirQuery, + perlQuery, } from "./queries" export interface LanguageParser { @@ -218,6 +219,13 @@ export async function loadRequiredLanguageParsers(filesToParse: string[], source language = await loadLanguage("elixir", sourceDirectory) query = new Query(language, elixirQuery) break + case "pl": + case "pm": + case "pod": + case "t": + language = await loadLanguage("perl", sourceDirectory) + query = new Query(language, perlQuery) + break default: throw new Error(`Unsupported language: ${ext}`) } diff --git a/src/services/tree-sitter/queries/index.ts b/src/services/tree-sitter/queries/index.ts index de9b9cafa3..268ca592be 100644 --- a/src/services/tree-sitter/queries/index.ts +++ b/src/services/tree-sitter/queries/index.ts @@ -26,3 +26,4 @@ export { zigQuery } from "./zig" export { default as embeddedTemplateQuery } from "./embedded_template" export { elispQuery } from "./elisp" export { scalaQuery } from "./scala" +export { default as perlQuery } from "./perl" diff --git a/src/services/tree-sitter/queries/perl.ts b/src/services/tree-sitter/queries/perl.ts new file mode 100644 index 0000000000..c92ad60203 --- /dev/null +++ b/src/services/tree-sitter/queries/perl.ts @@ -0,0 +1,108 @@ +/* +Perl Tree-sitter Query Patterns +*/ +const perlQuery = ` +; Package declarations +(package_statement + name: (package) @name.definition.module) @definition.module + +; Subroutine definitions +(subroutine_declaration_statement + name: (bareword) @name.definition.function) @definition.function + +(subroutine_declaration_statement + name: (special_bareword) @name.definition.function) @definition.function + +; Method definitions (sub with attributes) +(subroutine_declaration_statement + attribute: (subroutine_attribute) @definition.method.attribute + name: (bareword) @name.definition.method) @definition.method + +; Anonymous subroutines +(anonymous_subroutine) @definition.anonymous_function + +; Variable declarations (my, our, local, state) +(variable_declaration + (my) @definition.variable.scope + variable: (_) @name.definition.variable) @definition.variable + +(variable_declaration + (our) @definition.variable.scope + variable: (_) @name.definition.variable) @definition.variable + +(variable_declaration + (local) @definition.variable.scope + variable: (_) @name.definition.variable) @definition.variable + +(variable_declaration + (state) @definition.variable.scope + variable: (_) @name.definition.variable) @definition.variable + +; Use statements (modules) +(use_statement + module: (bareword) @name.definition.import) @definition.import + +(use_statement + module: (package) @name.definition.import) @definition.import + +; Require statements +(require_statement + module: (_) @name.definition.require) @definition.require + +; BEGIN, END, CHECK, INIT, UNITCHECK blocks +(phaser_statement + phase: (begin) @name.definition.phaser) @definition.phaser + +(phaser_statement + phase: (end) @name.definition.phaser) @definition.phaser + +(phaser_statement + phase: (check) @name.definition.phaser) @definition.phaser + +(phaser_statement + phase: (init) @name.definition.phaser) @definition.phaser + +(phaser_statement + phase: (unitcheck) @name.definition.phaser) @definition.phaser + +; Regex definitions +(match_regex) @definition.regex +(substitution_regex) @definition.regex +(transliteration_regex) @definition.regex + +; Format declarations +(format_statement + name: (bareword) @name.definition.format) @definition.format + +; POD documentation blocks +(pod) @definition.documentation + +; Constant declarations +(use_constant_statement + name: (bareword) @name.definition.constant) @definition.constant + +; Class definitions (for Moose/Moo/Object::Pad style) +(statement_containing_expression + (function_call + function: (bareword) @_has + arguments: (argument_list + (string_literal) @name.definition.attribute)) + (#eq? @_has "has")) @definition.attribute + +; Label definitions +(labeled_statement + label: (label) @name.definition.label) @definition.label + +; Prototypes +(subroutine_declaration_statement + prototype: (prototype) @definition.prototype + name: (bareword) @name.definition.function_with_prototype) @definition.function_with_prototype + +; Special blocks (AUTOLOAD) +(subroutine_declaration_statement + name: (special_bareword) @name.definition.special_function + (#match? @name.definition.special_function "^(AUTOLOAD|DESTROY)$")) @definition.special_function +` + +export default perlQuery +export { perlQuery }