view release on metacpan or  search on metacpan

lib/Plack/Middleware/PeriAHS/Respond.pm  view on Meta::CPAN

    my $ct = $formatter->[1];

    my $fres = Perinci::Result::Format::format($rres, $fmt);

    if ($fmt =~ /^json/ && defined($env->{"periahs.jsonp_callback"})) {
        $fres = $env->{"periahs.jsonp_callback"}."($fres)";
    }

    if ($self->{add_text_tips} && $fmt =~ /^text/ && !ref($fres)) {
        my @tips;
        my $pf = $midpr->{parse_form};
        if ($rreq->{action} eq 'list') {
            my (@f, @p);
            if ($rreq->{detail}) {
                @f = grep {$_->{type} eq 'function'} @{$rres->[2]};
                @p = grep {$_->{type} eq 'package' } @{$rres->[2]};
            }
            if (@f) {
                local $rreq->{uri} = "pl:$midpr->{riap_uri_prefix}".$f[rand(@f)]{uri};
                push @tips, "* To call a function, try:\n    ".
                    $midpr->{get_http_request_url}->($midpr, $env, $rreq);
                if ($pf) {
                    push @tips, "* Function arguments can be given via GET/POST params or JSON hash in req body";
                } else {
                    push @tips, "* Function arguments can be given via JSON hash in request body";
                }
                $rreq->{uri} = "pl:$midpr->{riap_uri_prefix}".$f[rand(@f)]{uri};
                my $url = $midpr->{get_http_request_url}->($midpr, $env, $rreq);
                push @tips, "* To find out which arguments a function supports, try:\n    ".
                    ($pf ? "$url?-riap-action=meta" : "curl -H 'x-riap-action: meta' $url");
            }
            if (@p) {
                local $rreq->{uri} = "pl:$midpr->{riap_uri_prefix}".$p[rand(@p)]{uri};
                push @tips, "* To list the content of a (sub)package, try:\n    ".
                    $midpr->{get_http_request_url}->($midpr, $env, $rreq);
            }
            if ($rreq->{detail} && @{$rres->[2]}) {
                local $rreq->{uri} = "pl:$midpr->{riap_uri_prefix}".$rres->[2][rand(@{ $rres->[2] })]{uri};
                my $url = $midpr->{get_http_request_url}->($midpr, $env, $rreq);
                push @tips, "* To find out all available actions on an entity, try:\n    ".
                    ($pf ? "$url?-riap-action=actions" : "curl -H 'x-riap-action: actions' $url");
            }
            push @tips,"* This server uses Riap protocol for great autodiscoverability, for more info:\n".
                "    https://metacpan.org/module/Riap";
        }
        if (@tips) {
            $fres .= "\nTips:\n".join("\n", @tips)."\n";
        }
    }

    ($fres, $ct);
}
my %str_levels = qw(1 critical 2 error 3 warning 4 info 5 debug 6 trace);

sub call {
    log_trace("=> PeriAHS::Respond middleware");

    my ($self, $env) = @_;

    die "This middleware needs psgi.streaming support"
        unless $env->{'psgi.streaming'};

    my $rreq = $env->{"riap.request"};
    my $pa   = $env->{"periahs.riap_client"}
        or die "\$env->{'periahs.riap_client'} not defined, ".
            "perhaps ParseRequest middleware has not run?";

    return sub {
        my $respond = shift;

        my $writer;
        my $loglvl  = $self->{enable_logging} ? ($rreq->{'loglevel'} // 0) : 0;
        my $rres; #  short for riap response
        $env->{'periahs.start_action_time'} = [gettimeofday];
        if ($loglvl > 0) {
            $writer = $respond->([
                200, ["Content-Type" => "text/plain",
                      "X-Riap-V" => "1.1.22",
                      "X-Riap-Logging" => 1]]);
            my $saved = Log::ger::Util::save_hooks('create_logml_routine');
            Log::ger::Output->set(
                "Callback",
                logging_cb => sub {
                    my ($ctx, $numlvl, $msg) = @_;
                    my $strlevel = Log::ger::Util::string_level($numlvl);
                    my $fmsg0 = join(
                        "",
                        "[$strlevel][", scalar(localtime), "] $msg\n",
                    );
                    my $fmsg = join(
                        "",
                        "l", length($fmsg0), " ",
                        $fmsg0);
                    $writer->write($fmsg);
                },
            );
            {
                local $rreq->{args}{-env} = $env if $self->{pass_psgi_env};
                $rres = $pa->request($rreq->{action} => $rreq->{uri}, $rreq);
            }
            Log::ger::Util::restore_hooks('create_logml_routine', $saved);
        } else {
            {
                local $rreq->{args}{-env} = $env if $self->{pass_psgi_env};
                $rres = $pa->request($rreq->{action} => $rreq->{uri}, $rreq);
            }
        }
        $rres = $cleanser->clone_and_clean($rres);
        $env->{'periahs.finish_action_time'} = [gettimeofday];

        $env->{'riap.response'} = $rres;
        my ($fres, $ct) = $self->format_result($rres, $env);

        if ($writer) {
            $writer->write("r" . length($fres) . " " . $fres);
            $writer->close;
        } else {
            $respond->([
                200, ["Content-Type" => $ct,
                      "X-Riap-V" => "1.1.22",
                  ], [$fres]]);