<commit_before>package t::OpenAPI;

use Test::Base -Base;

#use Smart::Comments;
my $client_module;
use lib 'inc';
use lib 'lib';
use OpenAPI::Config;
BEGIN {
    OpenAPI::Config->init;
    my $use_http = $OpenAPI::Config{'test_suite.use_http'};
    if ($use_http) {
        $client_module = 'WWW::OpenAPI';
        require WWW::OpenAPI;
    } else {
        $client_module = 'WWW::OpenAPI::Embedded';
        require WWW::OpenAPI::Embedded;
    }
}
use Test::LongString;
use Encode 'from_to';

our @EXPORT = qw(init do_request run_tests run_test);

use Benchmark::Timer;
my $timer = Benchmark::Timer->new();
my $SavedCapture;

our $server = $ENV{'OPENAPI_TEST_SERVER'} ||
    $OpenAPI::Config{'test_suite.server'} or
    die "No server specified.\n";
our ($user, $password, $host);
if ($server =~ /^(\w+):(\S+)\@(\S+)$/) {
    ($user, $password, $host) = ($1, $2, $3);
} else {
    die "test_suite.server syntax error in conf file: $server\n";
}

$host = "http://$host" if $host !~ m{^http://};

our $client = $client_module->new({ server => $host, timer => $timer });
our $debug = $OpenAPI::Config{'frontend.debug'};

#init();

sub run_tests () {
    for my $block (blocks()) {
        run_test($block);
    }
}

sub run_test ($) {
    my $block = shift;
    if (!$debug && $block->debug) {
        return;
    }
    if ($debug && defined $block->debug && $block->debug == 0) {
        return;
    }
    my $name = $block->name;
    my $request = $block->request;
    if (!$request) {
        warn "No request section found in $name\n";
        return;
    }
    my $charset = $block->charset || 'UTF-8';
    my $format = $block->format || 'JSON';
    my $res_type = $block->res_type;
    my $type = $block->request_type;
    if ($request) {
        $request =~ s/\$TestAccount\b/$user/g;
        $request =~ s/\$TestPass\b/$password/g;
    }
    if ($request =~ /^(GET|POST|HEAD|PUT|DELETE)\s+([^\n]+)\s*\n(.*)/s) {
        my ($method, $url, $body) = ($1, $2, $3);
        $url =~ s/\$SavedCapture\b/$SavedCapture/g;
        $body =~ s/\$SavedCapture\b/$SavedCapture/g;
        ### $method
        ### $url
        ### $body
        ### $host
        $url = $host.$url;
        from_to($url, 'UTF-8', $charset) unless $charset eq 'UTF-8';
        from_to($body, 'UTF-8', $charset) unless $charset eq 'UTF-8';
        $client->content_type($type);
        my $res = $client->request($body, $method, $url);
        ok $res->is_success, "request returns OK - $name";
        my $expected_res = $block->response || $block->response_like;
        if ($expected_res) {
            $expected_res =~ s/\$TestAccount\b/$user/g;
            $expected_res =~ s/\$TestPass\b/$password/g;
        }
        if ($format eq 'JSON' and $expected_res) {
            $expected_res =~ s/\n[ \t]*([^\n\s])/$1/sg;
        }
        if ($expected_res) {
            if ($block->response_like) {
                if ($res->content =~ qr/$expected_res/) {
                    $SavedCapture = $1 if defined $1;
                }
                like $res->content, qr/$expected_res/, "$name - response matched";
            } else {
                from_to($expected_res, 'UTF-8', $charset) unless $charset eq 'UTF-8';
                is $res->content, $expected_res, "response content OK - $name";
            }
        } else {
            is $res->content, $expected_res, "response content OK - $name";
        }
        if ($res_type) {
            is $res->header('Content-Type'), $res_type, "Content-Type in response ok - $name";
        } else {
            like $res->header('Content-Type'), qr/\Q; charset=$charset\E$/, "charset okay - $name";
        }
    } else {
        my ($firstline) = ($request =~ /^([^\n]*)/s);
        die "Invalid request head: \"$firstline\" in $name\n";
    }
}

END {
    use YAML::Syck;
    use Hash::Merge 'merge';
    #use Data::Dumper;
    #warn scalar $timer->reports;
    my $file = "t/cur-timer.dat";
    my $cur_data = $timer->data;
    if (!$cur_data) {
        return;
    }
    $cur_data = { @$cur_data };
    #warn Dumper($cur_data);
    if (-f $file) {
        my $last_data = LoadFile($file);
        $cur_data = merge($cur_data, $last_data);
    }
    DumpFile($file, $cur_data);
}

1;

<commit_msg> r7532@agentz-office (orig r1794):  agentzh | 2008-02-19 18:27:49 +0800  [openapi] fixed use lib in t/OpenAPI.pm<commit_after>package t::OpenAPI;

use lib 'inc';
use lib 'lib';

use Test::Base -Base;

#use Smart::Comments;
my $client_module;
use OpenAPI::Config;
BEGIN {
    OpenAPI::Config->init;
    my $use_http = $OpenAPI::Config{'test_suite.use_http'};
    if ($use_http) {
        $client_module = 'WWW::OpenAPI';
        require WWW::OpenAPI;
    } else {
        $client_module = 'WWW::OpenAPI::Embedded';
        require WWW::OpenAPI::Embedded;
    }
}
use Test::LongString;
use Encode 'from_to';

our @EXPORT = qw(init do_request run_tests run_test);

use Benchmark::Timer;
my $timer = Benchmark::Timer->new();
my $SavedCapture;

our $server = $ENV{'OPENAPI_TEST_SERVER'} ||
    $OpenAPI::Config{'test_suite.server'} or
    die "No server specified.\n";
our ($user, $password, $host);
if ($server =~ /^(\w+):(\S+)\@(\S+)$/) {
    ($user, $password, $host) = ($1, $2, $3);
} else {
    die "test_suite.server syntax error in conf file: $server\n";
}

$host = "http://$host" if $host !~ m{^http://};

our $client = $client_module->new({ server => $host, timer => $timer });
our $debug = $OpenAPI::Config{'frontend.debug'};

#init();

sub run_tests () {
    for my $block (blocks()) {
        run_test($block);
    }
}

sub run_test ($) {
    my $block = shift;
    if (!$debug && $block->debug) {
        return;
    }
    if ($debug && defined $block->debug && $block->debug == 0) {
        return;
    }
    my $name = $block->name;
    my $request = $block->request;
    if (!$request) {
        warn "No request section found in $name\n";
        return;
    }
    my $charset = $block->charset || 'UTF-8';
    my $format = $block->format || 'JSON';
    my $res_type = $block->res_type;
    my $type = $block->request_type;
    if ($request) {
        $request =~ s/\$TestAccount\b/$user/g;
        $request =~ s/\$TestPass\b/$password/g;
    }
    if ($request =~ /^(GET|POST|HEAD|PUT|DELETE)\s+([^\n]+)\s*\n(.*)/s) {
        my ($method, $url, $body) = ($1, $2, $3);
        $url =~ s/\$SavedCapture\b/$SavedCapture/g;
        $body =~ s/\$SavedCapture\b/$SavedCapture/g;
        ### $method
        ### $url
        ### $body
        ### $host
        $url = $host.$url;
        from_to($url, 'UTF-8', $charset) unless $charset eq 'UTF-8';
        from_to($body, 'UTF-8', $charset) unless $charset eq 'UTF-8';
        $client->content_type($type);
        my $res = $client->request($body, $method, $url);
        ok $res->is_success, "request returns OK - $name";
        my $expected_res = $block->response || $block->response_like;
        if ($expected_res) {
            $expected_res =~ s/\$TestAccount\b/$user/g;
            $expected_res =~ s/\$TestPass\b/$password/g;
        }
        if ($format eq 'JSON' and $expected_res) {
            $expected_res =~ s/\n[ \t]*([^\n\s])/$1/sg;
        }
        if ($expected_res) {
            if ($block->response_like) {
                if ($res->content =~ qr/$expected_res/) {
                    $SavedCapture = $1 if defined $1;
                }
                like $res->content, qr/$expected_res/, "$name - response matched";
            } else {
                from_to($expected_res, 'UTF-8', $charset) unless $charset eq 'UTF-8';
                is $res->content, $expected_res, "response content OK - $name";
            }
        } else {
            is $res->content, $expected_res, "response content OK - $name";
        }
        if ($res_type) {
            is $res->header('Content-Type'), $res_type, "Content-Type in response ok - $name";
        } else {
            like $res->header('Content-Type'), qr/\Q; charset=$charset\E$/, "charset okay - $name";
        }
    } else {
        my ($firstline) = ($request =~ /^([^\n]*)/s);
        die "Invalid request head: \"$firstline\" in $name\n";
    }
}

END {
    use YAML::Syck;
    use Hash::Merge 'merge';
    #use Data::Dumper;
    #warn scalar $timer->reports;
    my $file = "t/cur-timer.dat";
    my $cur_data = $timer->data;
    if (!$cur_data) {
        return;
    }
    $cur_data = { @$cur_data };
    #warn Dumper($cur_data);
    if (-f $file) {
        my $last_data = LoadFile($file);
        $cur_data = merge($cur_data, $last_data);
    }
    DumpFile($file, $cur_data);
}

1;


{'fraction_non_alphanumeric': 0.19395142456795889, 'fraction_numerical': 0.007239607659971976, 'mean_word_length': 2.318481208833785, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 59, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3771813', 'n_tokens_mistral': 3060, 'n_tokens_neox': 2993, 'n_words': 671}