view release on metacpan or  search on metacpan

t/lib/Test/Kubernetes/Mock.pm  view on Meta::CPAN

    $key =~ s{_+}{_}g;
    $key =~ s{^_}{};
    $self->responses->{$key} = $data;
}

sub call {
    my ($self, $req) = @_;

    # Generate key from method + uri
    my $method = $req->method // 'GET';
    my $path = $req->uri // $req->url // '';
    # Strip host from url if present
    $path =~ s{^https?://[^/]+}{};

    # Strip query parameters for path matching
    my $clean_path = $path;
    $clean_path =~ s{\?.*}{};

    # Check for log lines (one-shot mode, log paths end with /log)
    if (my $lines = $self->log_lines->{$clean_path}) {
        return Test::Kubernetes::Mock::Response->new(
            status => 200,
            content => join("\n", @$lines) . "\n",
        );
    }

    my $key = lc($method) . $path;
    $key =~ s{/}{_}g;
    $key =~ s{_+}{_}g;  # collapse multiple underscores
    $key =~ s{^_}{};

    warn "MOCK: Looking for key '$key' (method=$method, path=$path)\n" if $ENV{MOCK_DEBUG};

    # Check programmatic responses first, then file-based
    my $data = $self->responses->{$key} // Test::Kubernetes::Mock::load_response($key);

    if ($data) {
        return Test::Kubernetes::Mock::Response->new(
            status => 200,
            content => JSON::MaybeXS->new->encode($data),
        );
    }

    # Not found in mock
    return Test::Kubernetes::Mock::Response->new(
        status => 404,
        content => '{"kind":"Status","status":"Failure","message":"not found in mock"}',
    );
}

sub add_watch_events {
    my ($self, $path, $events) = @_;
    $self->watch_events->{$path} = $events;
}

sub add_log_lines {
    my ($self, $path, $lines) = @_;
    $self->log_lines->{$path} = $lines;
}

sub call_streaming {
    my ($self, $req, $callback) = @_;

    my $path = $req->url // '';
    $path =~ s{^https?://[^/]+}{};
    # Strip query parameters for key lookup
    $path =~ s{\?.*}{};

    # Check for log lines first (log paths end with /log)
    if (my $lines = $self->log_lines->{$path}) {
        for my $line (@$lines) {
            $callback->($line . "\n", undef);
        }
        return Test::Kubernetes::Mock::Response->new(
            status => 200,
        );
    }

    # Check for watch events
    my $events = $self->watch_events->{$path};

    unless ($events) {
        return Test::Kubernetes::Mock::Response->new(
            status => 404,
            content => '{"kind":"Status","status":"Failure","message":"no streaming data for path"}',
        );
    }

    my $json = JSON::MaybeXS->new;
    for my $event (@$events) {
        my $line = $json->encode($event) . "\n";
        $callback->($line, undef);
    }

    return Test::Kubernetes::Mock::Response->new(
        status => 200,
    );
}

package Test::Kubernetes::Mock::Response;
use Moo;

has status => (is => 'ro', required => 1);
has content => (is => 'ro', default => sub { '' });

1;

__END__

=head1 NAME

Test::Kubernetes::Mock - Mock HTTP layer for Kubernetes::REST tests

=head1 SYNOPSIS

    use Test::Kubernetes::Mock qw(mock_api live_api is_live);

    my $api;
    if (is_live()) {
        $api = live_api();
    } else {
        $api = mock_api();
    }

    my $pods = $api->list('Pod');

=head1 DESCRIPTION

Provides mock and live API instances for testing Kubernetes::REST.

=head1 ENVIRONMENT VARIABLES

=over 4

=item TEST_KUBERNETES_REST_KUBECONFIG

Path to kubeconfig file for live tests. B<Required> for live tests.
This is intentionally a long name to prevent accidentally running
tests against production clusters.

    TEST_KUBERNETES_REST_KUBECONFIG=~/.kube/test-config prove -l t/

=item TEST_KUBERNETES_REST_CONTEXT

Optional. Kubernetes context to use from the kubeconfig.