improvements to generate command

[scpubgit/App-SCS.git] / lib / App / SCS / Plugin / Generate.pm

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/^${only}/;
    @all_paths = grep /$re/, @all_paths;
  }
  my @fail;
  foreach my $path (@all_paths) {
    warn "Generating ${path}\n";
    my $res = $self->app->web->run_test_request(GET => "${prefix}${path}");

    unless ($res->is_success) {
      warn "ERROR on ${path}\n";
      push @fail, [ $path, $res ];
      next;
    }

    my $dir = $dir->catdir($path);
    $dir->mkpath;
    # 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);
  }
  warn "\nERRORS GENERATING PAGES:\n";
  foreach my $fail (@fail) {
    my ($path, $res) = @$fail;
    warn "\nFailed to generate ${path}:\n";
    my $error = $res->content||'';
    $error =~ s/^/  /mg;
    $error .= "\n" unless $error =~ /\n\Z/;
    warn $error;
  }
}

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;