view release on metacpan or  search on metacpan

lib/App/HTTPThis.pm  view on Meta::CPAN

package App::HTTPThis;

# ABSTRACT: Export the current directory over HTTP

use strict;
use warnings;
use Plack::App::DirectoryIndex;
use Plack::Runner;
use Getopt::Long;
use Pod::Usage;
use Config::Tiny;
use IO::Socket::INET;

our $VERSION = '1.0.1';

=head1 NAME

App::HTTPThis - A simple local web server.

=head1 SYNOPSIS

    # Not to be used directly, see http_this command

=head1 DESCRIPTION

This class implements all the logic of the L<http_this> command.

Actually, this is just a very thin wrapper around
L<Plack::App::DirectoryIndex>, that is where the magic really is.

=head1 METHODS

=head2 new

Creates a new App::HTTPThis object, parsing the command line arguments
into object attribute values.

=cut

sub new {
  my $class = shift;
  my $self = bless {host => '127.0.0.1', port => 7007, root => '.'}, $class;

  my $default_config_file = '.http_thisrc';

  my $config_file = $self->{config} || $ENV{HTTP_THIS_CONFIG};
  {
    my %early;
    local @ARGV = @ARGV;
    Getopt::Long::Configure(qw(pass_through));
    GetOptions(\%early, "config=s") || pod2usage(2);
    Getopt::Long::Configure(qw(default));
    $config_file = $early{config} if defined $early{config};
  }

  # There are apparently OSes where $ENV{HOME} is undefined
  for my $dir ('.', $ENV{HOME}) {
    next unless defined $dir;
    if (!$config_file && -f "$dir/$default_config_file") {
      $config_file = "$dir/$default_config_file";
      last;
    }
  }

  if ($config_file) {
    my $config = Config::Tiny->read($config_file)
      or die "FATAL: failed to read config file '$config_file'\n";
    for my $key (qw(port host name autoindex pretty wsl)) {
      if (defined $config->{_}->{$key} && $config->{_}->{$key} ne '') {
        $self->{$key} = $config->{_}->{$key};
      }
    }
    if ($config->{_}->{all}) {
      $self->{host} = q{0.0.0.0};
    }
    delete $self->{config};
  }

  my %cli;
  GetOptions(
    \%cli, "help", "man", "config=s", "host=s", "port=i", "name=s", "autoindex!", "pretty!",
    "all|promiscuous", "wsl"
  ) || pod2usage(2);
  pod2usage(1) if $cli{help};
  pod2usage(-verbose => 2) if $cli{man};

  for my $key (keys %cli) {
    $self->{$key} = $cli{$key};
  }

  $self->{host} = q{0.0.0.0} if $self->{all};
  $self->{host} = $self->_wsl_host
    if $cli{wsl} || ($self->{wsl} && !exists $cli{host} && !exists $cli{all});

  if (@ARGV > 1) {
    pod2usage("$0: Too many roots, only single root supported");
  }
  elsif (@ARGV) {
    $self->{root} = shift @ARGV;
  }

  return $self;
}

=head2 run

Start the HTTP server.

=cut