Added runfiles implementation

MODULE.bazel

@@ -7,10 +7,10 @@ module(
     version = "0.0.0",
 )
 
-bazel_dep(name = "platforms", version = "0.0.10")
-bazel_dep(name = "bazel_skylib", version = "1.7.1")
-bazel_dep(name = "rules_cc", version = "0.0.17")
-bazel_dep(name = "rules_shell", version = "0.4.0")
+bazel_dep(name = "platforms", version = "1.0.0")
+bazel_dep(name = "bazel_skylib", version = "1.8.2")
+bazel_dep(name = "rules_cc", version = "0.2.4")
+bazel_dep(name = "rules_shell", version = "0.6.1")
 
 repos = use_extension("@rules_perl//perl:extensions.bzl", "perl_repositories")
 use_repo(

README.md

@@ -45,7 +45,7 @@ Modules that require compiling are not yet supported.
 
 ## Windows Support
 
-This repository provides a hermetic [Strawberry Perl](https://strawberryperl.com/) bazel toolchain for Windows. Usage of the toolchain in `perl_` rules is not yet supported.
+This repository provides a hermetic [Strawberry Perl](https://strawberryperl.com/) bazel toolchain for Windows. Usage of the toolchain in `perl_xs` rules is not yet supported.
 
 ## Using Perl Modules
 

perl/runfiles/BUILD.bazel

@@ -0,0 +1,7 @@
+load("//perl:perl_library.bzl", "perl_library")
+
+perl_library(
+    name = "runfiles",
+    srcs = ["Runfiles.pm"],
+    visibility = ["//visibility:public"],
+)

perl/runfiles/Runfiles.pm

@@ -0,0 +1,211 @@
+package Runfiles;
+
+use strict;
+use warnings;
+use File::Spec;
+use File::Basename qw/dirname/;
+use Cwd qw/abs_path/;
+
+=head1 NAME
+
+Runfiles - Runfiles lookup library for Bazel-built Perl binaries and tests
+
+=head1 SYNOPSIS
+
+  # BUILD rule
+  #
+  # perl_binary(
+  #     name = "my_binary",
+  #     srcs = ["main.pl"],
+  #     data = ["//path/to/my/data.txt"],
+  #     deps = ["@rules_perl//perl/runfiles"],
+  # )
+
+  # Perl
+  use Runfiles;
+  my $r = Runfiles->create();
+  my $path = $r->rlocation('my_workspace/path/to/my/data.txt')
+      // die 'Failed to locate runfile';
+  open my $fh, '<', $path or die $!;
+  print do { local $/; <$fh> };
+
+=head1 DESCRIPTION
+
+Provides a minimal, portable API for locating Bazel runfiles.
+Resolution order:
+
+  1. C<RUNFILES_DIR> (directory-based mode, with optional C<_repo_mapping>)
+  2. C<RUNFILES_MANIFEST_FILE> (manifest-based mode; C<_repo_mapping> may be
+     listed in the manifest)
+  3. Adjacent C<{binary}.runfiles> directory next to C<$0>
+
+=head1 METHODS
+
+=over 4
+
+=item create
+
+  my $r = Runfiles->create();
+
+Construct a new runfiles resolver using the current environment.
+
+=item rlocation
+
+  my $path = $r->rlocation('workspace/path/to/file.txt');
+
+Resolve a runfile path to an absolute filesystem path. Returns undef if the
+file cannot be located.
+
+=back
+
+=head1 ENVIRONMENT
+
+  RUNFILES_DIR              Directory containing runfiles tree
+  RUNFILES_MANIFEST_FILE    Path to MANIFEST file mapping keys to real paths
+
+=cut
+
+sub create {
+    my $package = shift;
+    my $class = ref($package) || $package;
+
+    my $self = {
+        runfiles_dir     => undef,
+        manifest_file    => undef,
+        manifest_map     => undef,  # lazy
+        repo_mapping     => undef,  # lazy
+        repo_mapping_src => undef,  # path to mapping file, if known
+    };
+
+    if (defined $ENV{RUNFILES_DIR} && length $ENV{RUNFILES_DIR}) {
+        my $dir = $ENV{RUNFILES_DIR};
+        $dir = File::Spec->rel2abs($dir) unless File::Spec->file_name_is_absolute($dir);
+        $self->{runfiles_dir} = $dir;
+        my $mapping = File::Spec->catfile($dir, '_repo_mapping');
+        $self->{repo_mapping_src} = -f $mapping ? $mapping : undef;
+        return bless $self, $class;
+    }
+
+    if (defined $ENV{RUNFILES_MANIFEST_FILE} && length $ENV{RUNFILES_MANIFEST_FILE}) {
+        my $mf = $ENV{RUNFILES_MANIFEST_FILE};
+        $mf = File::Spec->rel2abs($mf) unless File::Spec->file_name_is_absolute($mf);
+        $self->{manifest_file} = $mf;
+        # mapping source will be discovered from manifest
+        return bless $self, $class;
+    }
+
+    # Fallback: adjacent {binary}.runfiles directory
+    my $self_path = abs_path($0);
+    if (defined $self_path) {
+        my $base = (File::Spec->splitpath($self_path))[2];
+        my $dir  = dirname($self_path);
+        my $adj  = File::Spec->catdir($dir, $base . '.runfiles');
+        if (-d $adj) {
+            $self->{runfiles_dir} = $adj;
+            my $mapping = File::Spec->catfile($adj, '_repo_mapping');
+            $self->{repo_mapping_src} = -f $mapping ? $mapping : undef;
+            return bless $self, $class;
+        }
+    }
+
+    # No runfiles found. Still return an object; lookups will fail with undef.
+    return bless $self, $class;
+}
+
+sub rlocation {
+    my ($self, $rlocationpath, $source_repo) = @_;
+    return undef unless defined $rlocationpath && length $rlocationpath;
+
+    # Apply repo mapping if any
+    $rlocationpath = _apply_repo_mapping($self, $rlocationpath, $source_repo);
+
+    if (defined $self->{runfiles_dir}) {
+        my $candidate = File::Spec->catfile($self->{runfiles_dir}, $rlocationpath);
+        return $candidate if -e $candidate;
+        return undef;
+    }
+
+    if (defined $self->{manifest_file}) {
+        my $map = _load_manifest($self);
+        return $map->{$rlocationpath} if exists $map->{$rlocationpath};
+        return undef;
+    }
+
+    return undef;
+}
+
+# Internal helpers
+
+sub _load_manifest {
+    my ($self) = @_;
+    return $self->{manifest_map} if defined $self->{manifest_map};
+
+    my %map;
+    my $mapping_src;
+    my $mf = $self->{manifest_file};
+    return $self->{manifest_map} = {} unless defined $mf && -f $mf;
+
+    open my $fh, '<', $mf or die "Failed to open manifest: $mf: $!\n";
+    while (my $line = <$fh>) {
+        chomp $line;
+        next if $line =~ /^\s*$/;
+        my ($key, $val) = split /\s+/, $line, 2;
+        next unless defined $val;
+        $map{$key} = $val;
+        if ($key eq '_repo_mapping') {
+            $mapping_src = $val;
+        }
+    }
+    close $fh;
+
+    $self->{manifest_map} = \%map;
+    $self->{repo_mapping_src} //= $mapping_src if defined $mapping_src;
+    return $self->{manifest_map};
+}
+
+sub _load_repo_mapping {
+    my ($self) = @_;
+    return $self->{repo_mapping} if defined $self->{repo_mapping};
+
+    my %mapping;
+    my $path = $self->{repo_mapping_src};
+
+    # In directory mode, discover mapping if not already set
+    if (!defined $path && defined $self->{runfiles_dir}) {
+        my $candidate = File::Spec->catfile($self->{runfiles_dir}, '_repo_mapping');
+        $path = $candidate if -f $candidate;
+    }
+
+    return $self->{repo_mapping} = {} unless defined $path && -f $path;
+
+    open my $fh, '<', $path or die "Failed to open repo mapping: $path: $!\n";
+    while (my $line = <$fh>) {
+        chomp $line;
+        next if $line =~ /^\s*$/;
+        my @parts = split /,/, $line;
+        next unless @parts >= 3;
+        # Format: <source_repo>,<alias>,<target_repo>
+        my $alias  = $parts[1];
+        my $target = $parts[2];
+        $mapping{$alias} = $target;
+    }
+    close $fh;
+
+    $self->{repo_mapping} = \%mapping;
+    return $self->{repo_mapping};
+}
+
+sub _apply_repo_mapping {
+    my ($self, $rlocationpath, $source_repo) = @_;
+    my $map = _load_repo_mapping($self);
+    return $rlocationpath unless $rlocationpath =~ m{^([^/]+)/(.+)$};
+    my ($repo, $rest) = ($1, $2);
+    if (exists $map->{$repo}) {
+        return $map->{$repo} . '/' . $rest;
+    }
+    return $rlocationpath;
+}
+
+1;
+
+

perl/runfiles/test/BUILD.bazel

@@ -0,0 +1,9 @@
+load("//perl:perl_test.bzl", "perl_test")
+
+perl_test(
+    name = "runfiles_test",
+    srcs = ["runfiles_test.t"],
+    data = ["data.txt"],
+    env = {"DATA_FILE": "$(rlocationpath data.txt)"},
+    deps = ["//perl/runfiles"],
+)

perl/runfiles/test/data.txt

@@ -0,0 +1 @@
+Hello, Perl

perl/runfiles/test/runfiles_test.t

@@ -0,0 +1,62 @@
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+use File::Spec;
+
+# Ensure the module is importable via nominal means
+use Runfiles;
+
+subtest 'data file access via runfiles' => sub {
+    plan tests => 2;
+
+    my $path = $ENV{DATA_FILE} // $ENV{DATA_PATH};
+    ok(defined $path && length $path, 'DATA_FILE is set');
+
+    if (!File::Spec->file_name_is_absolute($path)) {
+        my $r = Runfiles->create();
+        my $resolved = $r->rlocation($path);
+        $path = $resolved if defined $resolved;
+    }
+
+    open my $fh, '<', $path or die "open $path: $!\n";
+    my $content = do { local $/; <$fh> };
+    close $fh;
+
+    is($content, "Hello, Perl\n", 'data file content matches');
+};
+
+subtest 'Runfiles->create() as class method' => sub {
+    plan tests => 1;
+
+    my $r = Runfiles->create();
+    ok(defined $r, 'create() returns a defined object');
+};
+
+subtest 'create() called on instance (regression test)' => sub {
+    plan tests => 2;
+
+    my $r1 = Runfiles->create();
+    my $r2 = $r1->create();
+
+    ok(defined $r2, 'create() works when called on an instance');
+    ok(ref($r2) eq 'Runfiles', 'instance method returns correct class');
+};
+
+subtest 'rlocation returns undef for non-existent file' => sub {
+    plan tests => 1;
+
+    my $r = Runfiles->create();
+    my $path = $r->rlocation('non/existent/file.txt');
+
+    ok(!defined $path, 'rlocation returns undef for non-existent file');
+};
+
+subtest 'rlocation returns undef for empty path' => sub {
+    plan tests => 1;
+
+    my $r = Runfiles->create();
+    my $path = $r->rlocation('');
+
+    ok(!defined $path, 'rlocation returns undef for empty path');
+};

perl/toolchain.bzl

@@ -32,6 +32,11 @@ def _is_xs_header(src):
 
     return False
 
+def _rlocationpath(file, workspace_name):
+    if file.short_path.startswith("../"):
+        return file.short_path[len("../"):]
+    return "{}/{}".format(workspace_name, file.short_path)
+
 def _perl_toolchain_impl(ctx):
     # Find important files and paths.
     interpreter_cmd = None
@@ -72,6 +77,7 @@ def _perl_toolchain_impl(ctx):
             ),
             make_variables = platform_common.TemplateVariableInfo({
                 "PERL": interpreter_cmd_path,
+                "PERL_RLOCATIONPATH": _rlocationpath(interpreter_cmd, ctx.workspace_name),
             }),
         ),
     ]