Newer Older
205 lines | 5.505kb
add files
Yuki Kimoto authored on 2014-03-26
1
package Mojolicious::Command::get;
2
use Mojo::Base 'Mojolicious::Command';
3

            
4
use Getopt::Long qw(GetOptionsFromArray :config no_auto_abbrev no_ignore_case);
5
use Mojo::DOM;
6
use Mojo::IOLoop;
7
use Mojo::JSON;
8
use Mojo::JSON::Pointer;
9
use Mojo::UserAgent;
10
use Mojo::Util qw(decode encode);
11
use Scalar::Util 'weaken';
12

            
13
has description => "Perform HTTP request.\n";
14
has usage       => <<EOF;
15
usage: $0 get [OPTIONS] URL [SELECTOR|JSON-POINTER] [COMMANDS]
16

            
17
  mojo get /
18
  mojo get mojolicio.us
19
  mojo get -v -r google.com
20
  mojo get -M POST -c 'trololo' mojolicio.us
21
  mojo get -H 'X-Bender: Bite my shiny metal ass!' mojolicio.us
22
  mojo get mojolicio.us 'head > title' text
23
  mojo get mojolicio.us .footer all
24
  mojo get mojolicio.us a attr href
25
  mojo get mojolicio.us '*' attr id
26
  mojo get mojolicio.us 'h1, h2, h3' 3 text
27
  mojo get https://api.metacpan.org/v0/author/SRI /name
28

            
29
These options are available:
30
  -C, --charset <charset>     Charset of HTML/XML content, defaults to auto
31
                              detection.
32
  -c, --content <content>     Content to send with request.
33
  -H, --header <name:value>   Additional HTTP header.
34
  -M, --method <method>       HTTP method to use, defaults to "GET".
35
  -r, --redirect              Follow up to 10 redirects.
36
  -v, --verbose               Print request and response headers to STDERR.
37
EOF
38

            
39
sub run {
40
  my ($self, @args) = @_;
41

            
42
  GetOptionsFromArray \@args,
43
    'C|charset=s' => \my $charset,
44
    'c|content=s' => \(my $content = ''),
45
    'H|header=s'  => \my @headers,
46
    'M|method=s'  => \(my $method = 'GET'),
47
    'r|redirect'  => \my $redirect,
48
    'v|verbose'   => \my $verbose;
49

            
50
  @args = map { decode 'UTF-8', $_ } @args;
51
  die $self->usage unless my $url = shift @args;
52
  my $selector = shift @args;
53

            
54
  # Parse header pairs
55
  my %headers;
56
  /^\s*([^:]+)\s*:\s*(.+)$/ and $headers{$1} = $2 for @headers;
57

            
58
  # Detect proxy for absolute URLs
59
  my $ua = Mojo::UserAgent->new(ioloop => Mojo::IOLoop->singleton);
60
  $url !~ m!^/! ? $ua->proxy->detect : $ua->server->app($self->app);
61
  $ua->max_redirects(10) if $redirect;
62

            
63
  my $buffer = '';
64
  $ua->on(
65
    start => sub {
66
      my ($ua, $tx) = @_;
67

            
68
      # Verbose
69
      weaken $tx;
70
      $tx->res->content->on(
71
        body => sub {
72
          warn $tx->req->$_ for qw(build_start_line build_headers);
73
          warn $tx->res->$_ for qw(build_start_line build_headers);
74
        }
75
      ) if $verbose;
76

            
77
      # Stream content (ignore redirects)
78
      $tx->res->content->unsubscribe('read')->on(
79
        read => sub {
80
          return if $redirect && $tx->res->is_status_class(300);
81
          defined $selector ? ($buffer .= pop) : print pop;
82
        }
83
      );
84
    }
85
  );
86

            
87
  # Switch to verbose for HEAD requests
88
  $verbose = 1 if $method eq 'HEAD';
89
  STDOUT->autoflush(1);
90
  my $tx = $ua->start($ua->build_tx($method, $url, \%headers, $content));
91
  my ($err, $code) = $tx->error;
92
  $url = encode 'UTF-8', $url;
93
  warn qq{Problem loading URL "$url". ($err)\n} if $err && !$code;
94

            
95
  # JSON Pointer
96
  return unless defined $selector;
97
  my $type = $tx->res->headers->content_type // '';
98
  return _json($buffer, $selector) if $type =~ /json/i;
99

            
100
  # Selector
101
  _select($buffer, $selector, $charset // $tx->res->content->charset, @args);
102
}
103

            
104
sub _json {
105
  my $json = Mojo::JSON->new;
106
  return unless my $data = $json->decode(shift);
107
  return unless defined($data = Mojo::JSON::Pointer->new->get($data, shift));
108
  return _say($data) unless ref $data eq 'HASH' || ref $data eq 'ARRAY';
109
  say $json->encode($data);
110
}
111

            
112
sub _say { say encode('UTF-8', $_[0]) if length $_[0] }
113

            
114
sub _select {
115
  my ($buffer, $selector, $charset, @args) = @_;
116

            
117
  $buffer = decode($charset, $buffer) // $buffer if $charset;
118
  my $results = Mojo::DOM->new($buffer)->find($selector);
119

            
120
  my $finished;
121
  while (defined(my $command = shift @args)) {
122

            
123
    # Number
124
    if ($command =~ /^\d+$/) {
125
      return unless ($results = [$results->[$command]])->[0];
126
      next;
127
    }
128

            
129
    # Text
130
    elsif ($command eq 'text') { _say($_->text) for @$results }
131

            
132
    # All text
133
    elsif ($command eq 'all') { _say($_->all_text) for @$results }
134

            
135
    # Attribute
136
    elsif ($command eq 'attr') {
137
      next unless my $name = shift @args;
138
      _say($_->attr->{$name}) for @$results;
139
    }
140

            
141
    # Unknown
142
    else { die qq{Unknown command "$command".\n} }
143
    $finished++;
144
  }
145

            
146
  unless ($finished) { _say($_) for @$results }
147
}
148

            
149
1;
150

            
151
=encoding utf8
152

            
153
=head1 NAME
154

            
155
Mojolicious::Command::get - Get command
156

            
157
=head1 SYNOPSIS
158

            
159
  use Mojolicious::Command::get;
160

            
161
  my $get = Mojolicious::Command::get->new;
162
  $get->run(@ARGV);
163

            
164
=head1 DESCRIPTION
165

            
166
L<Mojolicious::Command::get> is a command interface to L<Mojo::UserAgent>.
167

            
168
This is a core command, that means it is always enabled and its code a good
169
example for learning to build new commands, you're welcome to fork it.
170

            
171
=head1 ATTRIBUTES
172

            
173
L<Mojolicious::Command::get> performs requests to remote hosts or local
174
applications.
175

            
176
=head2 description
177

            
178
  my $description = $get->description;
179
  $get            = $get->description('Foo!');
180

            
181
Short description of this command, used for the command list.
182

            
183
=head2 usage
184

            
185
  my $usage = $get->usage;
186
  $get      = $get->usage('Foo!');
187

            
188
Usage information for this command, used for the help screen.
189

            
190
=head1 METHODS
191

            
192
L<Mojolicious::Command::get> inherits all methods from L<Mojolicious::Command>
193
and implements the following new ones.
194

            
195
=head2 run
196

            
197
  $get->run(@ARGV);
198

            
199
Run this command.
200

            
201
=head1 SEE ALSO
202

            
203
L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
204

            
205
=cut