From: Matt S Trout <mst@shadowcat.co.uk>
Date: Wed, 5 Sep 2012 13:55:28 +0000 (+0000)
Subject: first cut at generation to file code
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FApp-SCS.git;a=commitdiff_plain;h=2f1cc1974346f3d510cf13da9ccdc2353aaaf973

first cut at generation to file code
---

diff --git a/lib/App/SCS/Plugin/Core.pm b/lib/App/SCS/Plugin/Core.pm
index e6a943b..dba9001 100644
--- a/lib/App/SCS/Plugin/Core.pm
+++ b/lib/App/SCS/Plugin/Core.pm
@@ -68,4 +68,9 @@ sub page_dispatchers {
   },
 }
 
+sub provides_pages {
+  my ($self) = @_;
+  "/", map "$_/", $self->pages->all_paths;
+}
+
 1;
diff --git a/lib/App/SCS/Plugin/Generate.pm b/lib/App/SCS/Plugin/Generate.pm
new file mode 100644
index 0000000..f765f76
--- /dev/null
+++ b/lib/App/SCS/Plugin/Generate.pm
@@ -0,0 +1,56 @@
+package App::SCS::Plugin::Generate;
+
+use IO::All;
+use Moo;
+use Module::Runtime qw(use_module);
+no warnings::illegalproto;
+
+with 'App::SCS::Role::Plugin';
+
+has dir => (
+  is => 'ro',
+  default => sub { $_[0]->config->{dir} || 'out' }
+);
+
+has host => (
+  is => 'ro',
+  default => sub { $_[0]->config->{host} || 'www.example.com' }
+);
+
+sub run_command_generate (dir=s;host=s;only=s) {
+  my ($self, $env) = @_;
+  my $opt = $env->{options};
+  my @all_paths = map $_->provides_pages, @{$self->app->plugins};
+  my $dir = io->dir($opt->{dir} || $self->dir);
+  $dir->mkpath;
+  my $prefix = 'http://'.($opt->{host} || $self->host);
+  if (my $only = $opt->{only}) {
+    my $re = qr/^\Q${only}/;
+    @all_paths = grep /$re/, @all_paths;
+  }
+  foreach my $path (@all_paths) {
+    warn "Generating ${path}\n";
+    my $dir = $dir->catdir($path);
+    $dir->mkpath;
+    my $res = $self->app->web->run_test_request(GET => "${prefix}${path}");
+    # text/html -> html
+    # application/atom+xml -> atom
+    my ($ext) = $res->content_type =~ m{\/(\w+)}
+      or die "Couldn't parse extension"
+            ." from content type ${\$res->content_type}"
+            ." for path ${path}";
+    $dir->catfile("index.${ext}")->print($res->content);
+  }
+}
+
+sub run_command_staticserver {
+  my ($self, $env) = @_;
+  my @args = @{$env->{argv}};
+  my $opt = $env->{options};
+  my $dir = io->dir($opt->{dir} || $self->dir);
+  my $s = use_module('App::SCS::Plugin::Generate::StaticServer')->new(
+    dir => $dir, app => $self->app,
+  )->run_server($env);
+}
+
+1;
diff --git a/lib/App/SCS/Plugin/Generate/StaticServer.pm b/lib/App/SCS/Plugin/Generate/StaticServer.pm
new file mode 100644
index 0000000..4090423
--- /dev/null
+++ b/lib/App/SCS/Plugin/Generate/StaticServer.pm
@@ -0,0 +1,52 @@
+package App::SCS::Plugin::Generate::StaticServer;
+
+use Module::Runtime qw(use_module);
+use Web::Simple;
+
+has dir => (is => 'ro', required => 1);
+
+has app => (is => 'ro', required => 1);
+
+has _dir_handler => (is => 'lazy');
+
+sub _build__dir_handler {
+  my ($self) = @_;
+  use_module('Plack::App::File')->new(
+    root => $self->dir
+  );
+}
+
+has _static_handler => (is => 'lazy');
+
+sub _build__static_handler {
+  my ($self) = @_;
+  use_module('Plack::App::File')->new(
+    root => $self->app->share_dir->catdir('static')
+  );
+}
+
+sub dispatch_request {
+  my ($self) = @_;
+  sub (/**.*) {
+    my $path = $_[1];
+    return unless $path =~ s/\/-/\//;
+    App::SCS::Web::redispatch_to("/static/${path}");
+  },
+  sub (/static/...) { $self->_static_handler },
+  sub (/favicon + .ico) { $self->_static_handler },
+  $self->_dir_handler
+}
+
+sub run_server {
+  my ($self, $env) = @_;
+  my @args = @{$env->{argv}};
+  my $r = use_module('Plack::Runner')->new(
+    server => 'Starman',
+    app => $self->app->web->to_psgi_app
+  );
+  $r->parse_options(@args);
+  $r->set_options(argv => \@args);
+  $r->run;
+}
+
+1;
diff --git a/lib/App/SCS/Role/Plugin.pm b/lib/App/SCS/Role/Plugin.pm
index c842e12..7569dcd 100644
--- a/lib/App/SCS/Role/Plugin.pm
+++ b/lib/App/SCS/Role/Plugin.pm
@@ -1,5 +1,6 @@
 package App::SCS::Role::Plugin;
 
+use Getopt::Long qw(GetOptionsFromArray);
 use Moo::Role;
 
 with 'App::SCS::Role::WithConfig';
@@ -23,8 +24,16 @@ sub run_cli {
   my ($self, $env) = @_;
   my ($command, @argv) = @{$env->{argv}};
   return unless $command;
-  return unless $self->can(my $meth = "run_command_${command}");
-  $self->$meth({ argv => \@argv, %$env });
+  return unless my $code = $self->can(my $meth = "run_command_${command}");
+  my $run_env = { %$env };
+  if (my $proto = prototype $code) {
+    my @spec = split ';', $proto;
+    my %opt;
+    GetOptionsFromArray(\@argv, \%opt, @spec);
+    $run_env->{options} = \%opt;
+  }
+  $run_env->{argv} = \@argv;
+  $self->$meth($run_env);
   return 1;
 }