#!/usr/bin/perl

package servepm; # just to make PodWeaver happy

use 5.010;
use strict;
use warnings;
use Log::Any::App qw($log);
use Module::List qw(list_modules);
use Module::Load;
use Plack::Builder;
use Plack::Runner;
use Plack::Util::SubSpec qw(errpage);
use Sub::Spec::CmdLine ();
use Sub::Spec::Gen::ForModule qw(gen_spec_for_module);

our $VERSION = '0.09'; # VERSION

our %SPEC;

$SPEC{serve} = {
    summary => 'Serve Perl modules over HTTP(S) using '.
        'the Sub::Spec::HTTP protocol',
    description => <<'_',

This is a simple command-line front-end for making Perl modules accessible over
HTTP(S).

It uses Plack::Runner to run PSGI application with the Gepok PSGI server. It is
not as flexible as using the Plack::Middleware::SubSpec::* middlewares directly,
but it only requires a single command to get started.

You specify Perl modules to serve. They can be preloaded if you want. If a
module does not contain Sub::Spec specs, it will be generated automatically
using Sub::Spec::Gen::ForModule.

Modules can be accessed using URL:

 http://HOSTNAME:PORT/api/MODULE/FUNCTION?ARG1=VAL1&...

_
    args => {
        modules => ['array*' => {
            of => 'str*',
            arg_pos => 0,
            arg_greedy => 1,
            summary => 'List of modules to serve',
            description => <<'_',

Either specify exact module name or one using wildcard (e.g. 'Foo::Bar::*', in
which Module::List will be used to list all modules under 'Foo::Bar::').

Request to modules not in this list will be rejected.

_
        }],
        preload => ['bool' => {
            default => 0,
            summary => 'Whether to preload Perl modules',
        }],
        ss_access_log_path => ['str' => {
            summary => 'Path for request access log file',
            description => <<'_',
Default is ~/servepm-ss_access.log
_
        }],
        http_ports => ['str' => {
            summary => 'Will be passed to Gepok',
        }],
        https_ports => ['str' => {
            summary => 'Will be passed to Gepok',
        }],
        unix_sockets => ['str' => {
            summary => 'Will be passed to Gepok',
        }],
        ssl_key_file => ['str' => {
            summary => 'Will be passed to Gepok',
        }],
        ssl_cert_file => ['str' => {
            summary => 'Will be passed to Gepok',
        }],
        daemonize => ['bool' => {
            default => 0,
            #arg_aliases => {
            #    D => {},
            #},
            summary => 'If true, will daemonize into background',
        }],
    },
};
sub serve {
    my %args = @_;

    $log->infof("Initializing ...");

    my $ss_access_log_path = $args{ss_access_log_path} //
        "$ENV{HOME}/servepm-ss_access.log";

    my @modules;
    for my $m (@{$args{modules}}) {
        if ($m =~ /(.+::)\*$/) {
            my $res = list_modules($1, {list_modules=>1});
            push @modules, keys %$res;
        } else {
            push @modules, $m;
        }
    }
    $log->debugf("Modules to serve: %s", \@modules);

    if ($args{preload}) {
        $log->infof("Preloading modules ...");
        for my $m (@modules) {
            $log->infof("Loading module %s ...", $m);
            eval { load $m };
            return [500, "Failed to load module $m: $@"] if $@;
        }
    }

    my $app =
        builder {
            enable "SubSpec::LogAccess",
                log_path => $ss_access_log_path;

            enable "SubSpec::ParseRequest",
                uri_pattern => qr!^/api
                                  (?:/(?<module>[^?/]+)
                                      (?:/(?<sub>[^?/]+))?
                                  )?!x,
                allowed_modules => \@modules,
                after_parse => sub {
                    my $env = shift;
                    my $m = $env->{"ss.uri_pattern_matches"};
                    my $mod = $m->{module};
                    if ($mod) {
                        my $uri = "pm:$mod" .
                            ($m->{sub} ? "/$m->{sub}" : "");
                        $env->{"ss.request"}{uri} = Sub::Spec::URI->new($uri);
                    }
                };

            # automatically generate spec for modules
            enable sub {
                my $app = shift;
                sub {
                    my $env     = shift;
                    my $ssreq   = $env->{"ss.request"};
                    my $command = $ssreq->{command};
                    my $uri     = $ssreq->{uri};
                    if ($uri->proto eq 'pm' && $command =~ /^(call|spec)$/) {
                        my $mod = $uri->module;
                        no strict 'refs';
                        my $spec = \%{"$mod\::SPEC"};
                        my $spec_autogen = ${"$mod\::autogen"};
                        if (!keys(%$spec) && !$spec_autogen) {
                            $spec_autogen = 1;
                            $log->tracef(
                                "Generating spec for module %s ...", $mod);
                            gen_spec_for_module(module=>$mod);
                        }
                    }
                    my $res = $app->($env);
                    return $res;
                };
            };

            enable "SubSpec::HandleCommand";
        };

    my @argv;
    push @argv, "-s", "Gepok";
    if (!$args{http_ports} && !$args{https_ports} && !$args{unix_sockets}) {
        $args{http_ports} = "*:5000";
    }
    for (qw/http_port https_ports unix_sockets ssl_key_file ssl_cert_file/) {
        push @argv, "--$_", $args{$_} if $args{$_};
    }
    push @argv, "-D" if $args{daemonize};
    my $runner = Plack::Runner->new;
    $runner->parse_options(@argv);
    $runner->run($app);

    # never reached though
    [200, "OK"];
}

Sub::Spec::CmdLine::run(module=>'servepm', sub=>'serve', load=>0);
1;
#ABSTRACT: Serve Perl modules over HTTP(S) using the Sub::Spec::HTTP protocol


__END__
=pod

=head1 NAME

servepm - Serve Perl modules over HTTP(S) using the Sub::Spec::HTTP protocol

=head1 VERSION

version 0.09

=head1 SYNOPSIS

 # serve modules over HTTP, using default options (HTTP port 5000)
 $ servepm Foo::Bar Baz::*

 # you can now do
 $ curl 'http://localhost:5000/api/Baz::Sub/func1?arg1=1&arg2=2'
 [200,"OK",{"The":"result","...":"..."}]

 # or use the Perl client
 $ perl -MSub::Spec::URI -e'
     my $r = Sub::Spec::URI->new("http://localhost:5000/api/Foo::Bar/func2");
     $r->call(arg1 => 1, arg2 => 2);'


 ### some other servepm options:

 # preload modules
 $ servepm --preload Foo::Bar ...

 # change ports/etc (see http_ports, https_ports, and unix_sockets in Gepok doc)
 $ servepm --http-ports "localhost:5000,*:80" ...

 # see all available options
 $ servepm --help

=head1 DESCRIPTION

For now, please see source code for more details (or --help).

=head1 QUICK TIPS

=head2 Complex argument

In raw HTTP, you can send complex argument by encoding it in JSON, e.g.:

 $ curl 'http://localhost:5000/api/Foo::Bar/func?array:j=[1,2,3]'

Notice the ":j" suffix after parameter name.

=head1 TODO

* Pass more plackup options.

* Pass more Gepok options.

* Allow other servers than Gepok?

=head1 SEE ALSO

L<Gepok>

L<Plack::Runner>, L<plackup>

L<Sub::Spec::Gen::ForModule>

L<Sub::Spec::HTTP>

L<Sub::Spec::HTTP::Server>

L<Sub::Spec::URI>, L<Sub::Spec::URI::http>

=head1 AUTHOR

Steven Haryanto <stevenharyanto@gmail.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2011 by Steven Haryanto.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut

