File Coverage

blib/lib/Testcontainers/Wait/Log.pm
Criterion Covered Total %
statement 32 32 100.0
branch 6 8 75.0
condition n/a
subroutine 6 6 100.0
pod 0 1 0.0
total 44 47 93.6


line stmt bran cond sub pod time code
1             package Testcontainers::Wait::Log;
2             # ABSTRACT: Wait strategy for container log messages
3              
4 4     4   30 use strict;
  4         8  
  4         155  
5 4     4   19 use warnings;
  4         8  
  4         249  
6 4     4   22 use Moo;
  4         6  
  4         52  
7 4     4   1598 use Carp qw( croak );
  4         8  
  4         355  
8 4     4   28 use Log::Any qw( $log );
  4         8  
  4         37  
9              
10             our $VERSION = '0.001';
11              
12             with 'Testcontainers::Wait::Base';
13              
14             =head1 SYNOPSIS
15              
16             use Testcontainers::Wait;
17              
18             # Wait for a specific log message
19             my $wait = Testcontainers::Wait::for_log('ready to accept connections');
20              
21             # Wait for a regex pattern
22             my $wait = Testcontainers::Wait::for_log(qr/listening on port \d+/);
23              
24             # Wait for multiple occurrences
25             my $wait = Testcontainers::Wait::for_log('connected', occurrences => 2);
26              
27             =head1 DESCRIPTION
28              
29             Waits for a specific string or regex pattern to appear in the container logs.
30             Equivalent to Go's C.
31              
32             =cut
33              
34             has pattern => (
35             is => 'ro',
36             required => 1,
37             );
38              
39             =attr pattern
40              
41             String or compiled regex (qr//) to match in container logs.
42              
43             =cut
44              
45             has occurrences => (
46             is => 'ro',
47             default => 1,
48             );
49              
50             =attr occurrences
51              
52             Number of times the pattern must appear. Default: 1.
53              
54             =cut
55              
56             sub check {
57 5     5 0 15317 my ($self, $container) = @_;
58              
59 5         11 my $logs = eval { $container->logs(stdout => 1, stderr => 1) };
  5         16  
60 5 50       49 return 0 unless defined $logs;
61              
62             # Ensure logs is a string
63 5 50       17 $logs = ref $logs ? "$logs" : $logs;
64              
65 5         16 my $pattern = $self->pattern;
66 5         7 my $count;
67              
68 5 100       16 if (ref $pattern eq 'Regexp') {
69 1         12 my @matches = ($logs =~ /$pattern/g);
70 1         4 $count = scalar @matches;
71             } else {
72             # Count occurrences of literal string
73 4         7 $count = 0;
74 4         7 my $pos = 0;
75 4         20 while (($pos = index($logs, $pattern, $pos)) != -1) {
76 4         8 $count++;
77 4         13 $pos += length($pattern);
78             }
79             }
80              
81 5         37 $log->tracef("Log pattern matched %d/%d times", $count, $self->occurrences);
82              
83 5 100       51 return $count >= $self->occurrences ? 1 : 0;
84             }
85              
86             =method check($container)
87              
88             Check container logs for the pattern. Returns true when the required
89             number of occurrences is found.
90              
91             =cut
92              
93             1;