view release on metacpan or  search on metacpan

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

package App::Adenosine;
$App::Adenosine::VERSION = '2.002000';
use strict;
use warnings;

# ABSTRACT: Handy CLI HTTP tool

use URI;
use Getopt::Long qw(:config pass_through no_ignore_case);
use File::Path 'mkpath';
use URI::Escape 'uri_escape';
use File::Spec::Functions 'splitpath';
use Path::Class;
use Text::ParseWords;
use Scalar::Util 'blessed';
use Module::Runtime 'use_module';

our $verb_regex = '(?:HEAD|OPTIONS|GET|DELETE|PUT|POST|TRACE|PATCH)';

sub verbose { $_[0]->{verbose} }
sub plugins { @{$_[0]->{plugins}} }
sub enable_xdg {
   return $_[0]->{enable_xdg} if exists $_[0]->{enable_xdg};
   return 1
}

sub _plugin_name {
   my ($self, $name) = @_;
   $name = "App::Adenosine::Plugin$name" if $name =~ /^::/;
   use_module($name)
}

sub new {
   my ($class, $args) = @_;

   if (my $p = $args->{plugins}) {
      die "plugins must be an arrayref" unless ref $p && ref $p eq 'ARRAY';
      $args->{plugins} = [
         map {;
            my $ret = $_;
            unless (blessed($ret)) {
               my @args;
               if (ref $ret eq 'HASH') {
                  ($ret, @args) = %$ret;
               }
               $ret = $class->_plugin_name($ret);
               $ret = $ret->new(@args)
            }
            $ret;
         } @{$args->{plugins}}];
   } else {
      $args->{plugins} = []
   }

   my $self = { %$args };

   bless $self, $class;

   local @ARGV = @{$self->argv};

   my $action = shift @ARGV;

   my $uri_base = $self->uri_base;

   $self->stdout("$uri_base\n"), return if !$action;

   if ($action =~ m/^$verb_regex$/) {
      my $quote = 1;
      my $interactive_edit = 0;
      my $query = '';
      $self->{verbose} = 0;

      my ($path, $data);
      $path   = shift @ARGV unless $ARGV[0] && $ARGV[0] =~ /^-/;
      $data   = shift @ARGV unless $ARGV[0] && $ARGV[0] =~ /^-/;

      $path ||= '';
      $data ||= '';

      GetOptions (
         Q     => sub { $quote = 0 },
         "q=s" => \$query,
         V     => \$interactive_edit,
         v     => sub { $self->{verbose} = 1 },
      );

      my @extra = (@ARGV, $self->_get_extra_options);
      my $wantdata;
      $wantdata = 1 if $action =~ m/^(?:PUT|POST|TRACE|PATCH)$/;
      if ($wantdata && $interactive_edit) {
         require File::Temp;
         my ($fh, $fn) = File::Temp::tempfile();

         system($ENV{EDITOR} || 'vi', $fn);

         $data = file($fn)->slurp;
         unlink $fn;
      }

      push @extra, '--data-binary' if $data;
      push @extra, '-I' if $action eq 'HEAD';

      my $_path = $uri_base;
      $_path =~ s/\*/$path/;

      $query = uri_escape($query) if $quote;

      push @extra, $self->host_method_config( $self->host($uri_base), $action );

      $query = "?$query" if $query;

      my @curl = @{$self->curl_command({
         method => $action,
         data   => $data,
         cookie_jar => $self->cookie_jar($uri_base),
         rest => \@extra,
         location => "$_path$query",
      })};

      $self->stderr(join(" ", map "'$_'", @curl) . "\n") if $self->verbose;

      my ($out, $err, $ret) = $self->capture_curl(@curl);
      return $self->handle_curl_output($out, $err, $ret);
   } elsif ($action eq 'exports') {
      print <<'SHELL';
function HEAD() { adenosine HEAD "$@"; };
function OPTIONS() { adenosine OPTIONS "$@"; };
function GET() { adenosine GET "$@"; };
function POST() { adenosine POST "$@"; };
function PUT() { adenosine PUT "$@"; };
function DELETE() { adenosine DELETE "$@"; };
function TRACE() { adenosine TRACE "$@"; };
function PATCH() { adenosine TRACE "$@"; };
SHELL
   } else {
      my $uri_base = $self->uri_base($action);
      $self->_set_extra_options(@ARGV);
      $self->stdout("$uri_base\n"), return
   }
}

sub config_location {
   my $loc;
   if ($_[0]->enable_xdg and $ENV{XDG_CONFIG_HOME}) {
      my $h = $ENV{XDG_CONFIG_HOME};
      $loc = "$h/resty"
   } else {
      $loc = "$ENV{HOME}/.resty"
   }
   my $ret = dir($loc);

   $ret->mkpath unless -d $ret->stringify;

   $ret
}

sub stdout { print STDOUT $_[1] }
sub stderr { print STDERR $_[1] }

sub capture_curl {
   my ($self, @rest) = @_;

   my @wrappers = grep { $_->does('App::Adenosine::Role::WrapsCurlCommand') }
      $self->plugins;
   my $wrapped = sub {
      my @rest = @_;