File Coverage

blib/lib/Mojolicious/Command/get.pm
Criterion Covered Total %
statement 76 86 88.3
branch 29 50 58.0
condition 10 27 37.0
subroutine 17 22 77.2
pod 1 1 100.0
total 133 186 71.5


line stmt bran cond sub pod time code
1             package Mojolicious::Command::get;
2 1     1   8 use Mojo::Base 'Mojolicious::Command';
  1         2  
  1         9  
3              
4 1     1   8 use Mojo::Collection qw(c);
  1         2  
  1         50  
5 1     1   5 use Mojo::DOM;
  1         2  
  1         22  
6 1     1   4 use Mojo::IOLoop;
  1         2  
  1         5  
7 1     1   5 use Mojo::JSON qw(to_json j);
  1         2  
  1         74  
8 1     1   6 use Mojo::JSON::Pointer;
  1         3  
  1         8  
9 1     1   7 use Mojo::URL;
  1         2  
  1         7  
10 1     1   5 use Mojo::UserAgent;
  1         2  
  1         6  
11 1     1   6 use Mojo::Util qw(decode encode getopt);
  1         3  
  1         64  
12 1     1   7 use Scalar::Util qw(weaken);
  1         1  
  1         1681  
13              
14             has description => 'Perform HTTP request';
15             has usage => sub { shift->extract_usage };
16              
17             sub run {
18 4     4 1 898 my ($self, @args) = @_;
19              
20             # Data from STDIN
21 4         23 vec(my $r = '', fileno(STDIN), 1) = 1;
22 4 50 33     131 my $in = !-t STDIN && select($r, undef, undef, 0) ? join '', : undef;
23              
24 4         44 my $ua = Mojo::UserAgent->new(ioloop => Mojo::IOLoop->singleton);
25 4         10 my %form;
26             die $self->usage
27             unless getopt \@args,
28             'C|charset=s' => \my $charset,
29             'c|content=s' => \$in,
30 1 50   1   1163 'f|form=s' => sub { _form(\%form) if $_[1] =~ /^(.+)=(\@?)(.+)$/ },
31             'H|header=s' => \my @headers,
32 0     0   0 'i|inactivity-timeout=i' => sub { $ua->inactivity_timeout($_[1]) },
33 0     0   0 'k|insecure' => sub { $ua->insecure(1) },
34             'M|method=s' => \(my $method = 'GET'),
35 0     0   0 'o|connect-timeout=i' => sub { $ua->connect_timeout($_[1]) },
36             'r|redirect' => \my $redirect,
37 0     0   0 'S|response-size=i' => sub { $ua->max_response_size($_[1]) },
38 4 100       66 'u|user=s' => \my $user,
39             'v|verbose' => \my $verbose;
40              
41 3         41 @args = map { decode 'UTF-8', $_ } @args;
  7         24  
42 3 50       13 die $self->usage unless my $url = shift @args;
43 3         6 my $selector = shift @args;
44              
45             # Parse header pairs
46 3 50       10 my %headers = map { /^\s*([^:]+)\s*:\s*(.*+)$/ ? ($1, $2) : () } @headers;
  1         12  
47              
48             # Detect proxy for absolute URLs
49 3 50       27 $url !~ m!^/! ? $ua->proxy->detect : $ua->server->app($self->app);
50 3 50       12 $url = Mojo::URL->new($url)->userinfo($user) if $user;
51 3 50       9 $ua->max_redirects(10) if $redirect;
52              
53 3         6 my $buffer = '';
54             $ua->on(
55             start => sub {
56 3     3   8 my ($ua, $tx) = @_;
57              
58             # Verbose
59 3         28 weaken $tx;
60 3 50       11 $tx->res->content->on(body => sub { warn _header($tx->req), _header($tx->res) }) if $verbose;
  0         0  
61              
62             # Stream content (ignore redirects)
63             $tx->res->content->unsubscribe('read')->on(
64             read => sub {
65 3 50 33     15 return if $redirect && $tx->res->is_redirect;
66 3 100       47 defined $selector ? ($buffer .= pop) : print pop;
67             }
68 3         29 );
69             }
70 3         32 );
71              
72             # Switch to verbose for HEAD requests
73 3 50       14 $verbose = 1 if $method eq 'HEAD';
74 3         31 STDOUT->autoflush(1);
75 3 50       172 my @content = %form ? (form => \%form) : defined $in ? ($in) : ();
    100          
76 3         20 my $tx = $ua->start($ua->build_tx($method, $url, \%headers, @content));
77 3         25 my $res = $tx->result;
78              
79             # JSON Pointer
80 3 100       18 return undef unless defined $selector;
81 2 100 66     30 return _json($buffer, $selector) if !length $selector || $selector =~ m!^/!;
82              
83             # Selector
84 1   33     9 $charset //= $res->content->charset || $res->default_charset;
      33        
85 1         11 _select($buffer, $selector, $charset, @args);
86             }
87              
88 1 50   1   3 sub _form { push @{$_[0]{$1}}, $2 ? {file => $3} : $3 }
  1         16  
89              
90 0     0   0 sub _header { $_[0]->build_start_line, $_[0]->headers->to_string, "\n\n" }
91              
92             sub _json {
93 1 50   1   8 return unless my $data = j(shift);
94 1 50       18 return unless defined($data = Mojo::JSON::Pointer->new($data)->get(shift));
95 1 50 33     13 _say(ref $data eq 'HASH' || ref $data eq 'ARRAY' ? to_json($data) : $data);
96             }
97              
98 2   50 2   30 sub _say { length && say encode('UTF-8', $_) for @_ }
99              
100             sub _select {
101 1     1   5 my ($buffer, $selector, $charset, @args) = @_;
102              
103             # Keep a strong reference to the root
104 1 50 33     7 $buffer = decode($charset, $buffer) // $buffer if $charset;
105 1         15 my $dom = Mojo::DOM->new($buffer);
106 1         8 my $results = $dom->find($selector);
107              
108 1         12 while (defined(my $command = shift @args)) {
109              
110             # Number
111 2 100 50     20 ($results = c($results->[$command])) and next if $command =~ /^\d+$/;
112              
113             # Text
114 1 50       8 return _say($results->map('text')->each) if $command eq 'text';
115              
116             # All text
117 0 0         return _say($results->map('all_text')->each) if $command eq 'all';
118              
119             # Attribute
120 0 0 0       return _say($results->map(attr => $args[0] // '')->each) if $command eq 'attr';
121              
122             # Unknown
123 0           die qq{Unknown command "$command".\n};
124             }
125              
126 0           _say($results->each);
127             }
128              
129             1;
130              
131             =encoding utf8
132              
133             =head1 NAME
134              
135             Mojolicious::Command::get - Get command
136              
137             =head1 SYNOPSIS
138              
139             Usage: APPLICATION get [OPTIONS] URL [SELECTOR|JSON-POINTER] [COMMANDS]
140              
141             ./myapp.pl get /
142             ./myapp.pl get -H 'Accept: text/html' /hello.html 'head > title' text
143             ./myapp.pl get //sri:secr3t@/secrets.json /1/content
144             mojo get mojolicious.org
145             mojo get -v -r -o 25 -i 50 google.com
146             mojo get -v -H 'Host: mojolicious.org' -H 'Accept: */*' mojolicious.org
147             mojo get -u 'sri:s3cret' https://mojolicious.org
148             mojo get mojolicious.org > example.html
149             mojo get -M PUT mojolicious.org < example.html
150             mojo get -f 'q=Mojolicious' -f 'size=5' https://metacpan.org/search
151             mojo get -M POST -f 'upload=@example.html' mojolicious.org
152             mojo get mojolicious.org 'head > title' text
153             mojo get mojolicious.org .footer all
154             mojo get mojolicious.org a attr href
155             mojo get mojolicious.org '*' attr id
156             mojo get mojolicious.org 'h1, h2, h3' 3 text
157             mojo get https://fastapi.metacpan.org/v1/author/SRI /name
158             mojo get -H 'Host: example.com' http+unix://%2Ftmp%2Fmyapp.sock/index.html
159              
160             Options:
161             -C, --charset Charset of HTML/XML content, defaults
162             to auto-detection
163             -c, --content Content to send with request
164             -f, --form One or more form values and file
165             uploads
166             -H, --header One or more additional HTTP headers
167             -h, --help Show this summary of available options
168             --home Path to home directory of your
169             application, defaults to the value of
170             MOJO_HOME or auto-detection
171             -i, --inactivity-timeout Inactivity timeout, defaults to the
172             value of MOJO_INACTIVITY_TIMEOUT or 40
173             -k, --insecure Do not require a valid TLS certificate
174             to access HTTPS sites
175             -M, --method HTTP method to use, defaults to "GET"
176             -m, --mode Operating mode for your application,
177             defaults to the value of
178             MOJO_MODE/PLACK_ENV or "development"
179             -o, --connect-timeout Connect timeout, defaults to the value
180             of MOJO_CONNECT_TIMEOUT or 10
181             -r, --redirect Follow up to 10 redirects
182             -S, --response-size Maximum response size in bytes,
183             defaults to 2147483648 (2GiB)
184             -u, --user Alternate mechanism for specifying
185             colon-separated username and password
186             -v, --verbose Print request and response headers to
187             STDERR
188              
189             =head1 DESCRIPTION
190              
191             L performs requests to remote hosts or local applications.
192              
193             This is a core command, that means it is always enabled and its code a good example for learning to build new commands,
194             you're welcome to fork it.
195              
196             See L for a list of commands that are available by default.
197              
198             =head1 ATTRIBUTES
199              
200             L inherits all attributes from L and implements the following new
201             ones.
202              
203             =head2 description
204              
205             my $description = $get->description;
206             $get = $get->description('Foo');
207              
208             Short description of this command, used for the command list.
209              
210             =head2 usage
211              
212             my $usage = $get->usage;
213             $get = $get->usage('Foo');
214              
215             Usage information for this command, used for the help screen.
216              
217             =head1 METHODS
218              
219             L inherits all methods from L and implements the following new ones.
220              
221             =head2 run
222              
223             $get->run(@ARGV);
224              
225             Run this command.
226              
227             =head1 SEE ALSO
228              
229             L, L, L.
230              
231             =cut