view release on metacpan or  search on metacpan

integration/browser/run-bookmark-browser-smoke.pl  view on Meta::CPAN

    push @{ $opts->{expect_dom_fragment} }, q{<span class="display">123</span>};
    $opts->{expect_ajax_path} = '/ajax/foobar?type=text';
    $opts->{expect_ajax_body} = '123';
}

# _bookmark_source(\%opts)
# Loads the bookmark content from an explicit file or from the built-in sample text.
# Input: option hash reference.
# Output: raw bookmark source text string.
sub _bookmark_source {
    my ($opts) = @_;
    return $opts->{bookmark_text} if defined $opts->{bookmark_text};

    my $path = $opts->{bookmark_file} or die "Missing --bookmark-file\n";
    open my $fh, '<', $path or die "Unable to read bookmark file $path: $!";
    my $text = do { local $/; <$fh> };
    close $fh;
    return $text;
}

# _extract_bookmark_id($bookmark_text)
# Reads the saved bookmark id from the raw bookmark document when present.
# Input: raw bookmark source text.
# Output: bookmark id string or undef when the source does not declare one.
sub _extract_bookmark_id {
    my ($bookmark) = @_;
    return undef if !defined $bookmark;
    return $1 if $bookmark =~ /^BOOKMARK:\s*(.+?)\s*$/m;
    return undef;
}

# _repo_root()
# Resolves the checkout root relative to this script location.
# Input: none.
# Output: absolute repository root path string.
sub _repo_root {
    my $script = abs_path($0);
    my $root = File::Spec->catdir( dirname($script), '..', '..' );
    return abs_path($root);
}

# _wait_for_http($url)
# Polls one URL until the dashboard listener responds successfully.
# Input: URL string.
# Output: none.
sub _wait_for_http {
    my ($url) = @_;
    my $ua = LWP::UserAgent->new( timeout => 2 );
    my $deadline = time() + 20;
    while ( time() < $deadline ) {
        my $response = $ua->get($url);
        return if $response->is_success;
        sleep 0.25;
    }
    die "Timed out waiting for HTTP success at $url\n";
}

# _fetch_text($url)
# Fetches one browser or ajax URL over HTTP.
# Input: URL string.
# Output: decoded response body string.
sub _fetch_text {
    my ($url) = @_;
    my $ua = LWP::UserAgent->new( timeout => 5 );
    my $response = $ua->get($url);
    die "HTTP fetch failed for $url: " . $response->status_line . "\n"
      if !$response->is_success;
    return $response->decoded_content( charset => 'none' );
}

# _run_browser_dom(%args)
# Dumps the browser DOM for one URL through headless Chromium.
# Input: named args with url, user_data_dir, and optional browser_binary override.
# Output: dumped DOM string.
sub _run_browser_dom {
    my (%args) = @_;
    my $browser = $args{browser_binary} || _browser_binary();
    my @command = (
        $browser,
        '--headless',
        '--disable-gpu',
        '--no-first-run',
        '--virtual-time-budget=3000',
        '--user-data-dir=' . $args{user_data_dir},
        '--dump-dom',
        $args{url},
    );
    my ( $stdout, $stderr, $exit ) = capture {
        system @command;
        return $? >> 8;
    };
    if ( $exit != 0 ) {
        die "Headless browser command failed ($exit)\nstdout:\n$stdout\nstderr:\n$stderr\n";
    }
    return $stdout;
}

# _browser_binary()
# Resolves one available headless Chromium-style browser binary.
# Input: none.
# Output: absolute browser executable path string.
sub _browser_binary {
    return $BROWSER_BINARY if defined $BROWSER_BINARY;
    for my $candidate ( qw(google-chrome-stable google-chrome chromium-browser chromium) ) {
        my ( $stdout, $stderr, $exit ) = capture {
            system 'sh', '-lc', "command -v $candidate";
            return $? >> 8;
        };
        next if $exit != 0;
        my $path = $stdout;
        $path =~ s/\s+\z//;
        next if $path eq '';
        next if $path eq '/snap/bin/chromium';
        $BROWSER_BINARY = $path;
        return $BROWSER_BINARY;
    }
    die "Unable to find a headless browser binary. Install chromium or pass --browser-binary.\n";
}

# _run_command(%args)
# Executes one external command with explicit logging and captured stdout/stderr.
# Input: named args for label, command arrayref, optional cwd, env, and allow_fail.
# Output: hashref containing stdout, stderr, and exit_code.
sub _run_command {
    my (%args) = @_;
    my $label   = $args{label}   || 'command';
    my $command = $args{command} || die "Missing command arrayref for $label\n";
    my $cwd     = $args{cwd};