view release on metacpan or  search on metacpan

lib/Giblog.pm  view on Meta::CPAN

package Giblog;

use strict;
use warnings;

use Getopt::Long 'GetOptions';
use Giblog::API;
use Carp 'confess';
use Pod::Usage 'pod2usage';
use List::Util 'min';
use File::Spec;

our $VERSION = '3.00';

sub new {
  my $class = shift;

  my $self = {
    @_
  };

  return bless $self, $class;
}

sub _extract_usage {
  my $file = @_ ? "$_[0]" : (caller 1)[1];

  open my $handle, '>', \my $output;
  pod2usage -exitval => 'noexit', -input => $file, -output => $handle;
  $output =~ s/^.*\n|\n$//;
  $output =~ s/\n$//;

  return _unindent($output);
}

sub _unindent {
  my $str = shift;
  my $min = min map { m/^([ \t]*)/; length $1 || () } split "\n", $str;
  $str =~ s/^[ \t]{0,$min}//gm if $min;
  return $str;
}

sub run_command {
  my ($class, @argv) = @_;

  # Command line option
  local @ARGV = @argv;
  my $getopt_option_save = Getopt::Long::Configure(qw(default no_auto_abbrev no_ignore_case pass_through));
  GetOptions(
    "h|help" => \my $help,
    "H|C|home=s" => \my $home_dir,
  );
  Getopt::Long::Configure($getopt_option_save);

  # Command name
  my $command_name = shift @ARGV;

  # Show help
  die _extract_usage if $help || !$command_name;

  # Giblog
  my $giblog = Giblog->new(home_dir => $home_dir);

  # API
  my $api = Giblog::API->new(giblog => $giblog);

  # Add "lib" in home directory to include path
  local @INC = @INC;
  if (defined $home_dir) {
    unshift @INC, "$home_dir/lib";
  }
  else {
    unshift @INC, "lib";
  }

  # Command is implemented in command
  my $command_class = "Giblog::Command::$command_name";
  eval "use $command_class;";
  if ($@) {
    confess "Can't load command $command_class:\n$!\n$@";
  }
  my $command = $command_class->new(api => $api);

  @argv = @ARGV;
  $command->run(@argv);
}

sub home_dir { shift->{'home_dir'} }
sub config { shift->{config} }

sub build {
  my ($class) = @_;

  # Build
  my $cmd = 'giblog build';
  system($cmd) == 0
    or die "Can't execute $cmd: $!";
}

sub serve {
  my ($class, $app) = @_;

  # Read config file
  my $config_file = "$FindBin::Bin/giblog.conf";
  my $config;
  $config = do $config_file
    or die "Can't read config file $config_file";