finish port to URI, add post request method and update tests so they …

…access working files

README

@@ -4,13 +4,16 @@ Perl6 LWP::Simple
 http://github.com/cosimo/perl6-lwp-simple/
 
 This is a quick & dirty  implementation
-of a LWP::Simple clone for Rakudo Perl 6
+of a LWP::Simple clone for Rakudo Perl 6.
+
+Since Perl 6 is a bit new, this LWP::Simple does both
+get and post requests.
 
 Dependencies
 ============
 
-LWP::Simple depends on MIME::Base64, which
-you can find at http://modules.perl6.org/
+LWP::Simple depends on the modules MIME::Base64 and URI,
+which you can find at http://modules.perl6.org/
 
 
 Current status

lib/LWP/Simple.pm

@@ -9,6 +9,8 @@ class LWP::Simple:auth<cosimo>:ver<0.07>;
 
 our $VERSION = '0.08';
 
+enum RequestType <GET POST>;
+
 method base64encode ($user, $pass) {
     my $mime = MIME::Base64.new();
     my $encoded = $mime.encode_base64($user ~ ':' ~ $pass);
@@ -18,6 +20,7 @@ method base64encode ($user, $pass) {
 method has_basic_auth (Str $host) {
 
     # ^ <username> : <password> @ <hostname> $
+    warn "has_basic_auth deprecated - not in p5 LWP simple and now returned by pares_url";
     if $host ~~ /^ (\w+) \: (\w+) \@ (\N+) $/ {
         my $host = $0.Str;
         my $user = $1.Str;
@@ -28,26 +31,34 @@ method has_basic_auth (Str $host) {
     return;
 }
 
-method get (Str $url, %headers = {}, Any $content?) {
+method get (Str $url) {
+    self.request_shell(RequestType::GET, $url)
+}
+
+method post (Str $url, %headers = {}, Any $content?) {
+    self.request_shell(RequestType::POST, $url, %headers, $content)
+}
+
+method request_shell (RequestType $rt, Str $url, %headers = {}, Any $content?) {
 
     return unless $url;
 
-    my ($scheme, $hostname, $port, $path) = self.parse_url($url);
+    my ($scheme, $hostname, $port, $path, $auth) = self.parse_url($url);
 
     %headers{'Connection'} = 'close';
     %headers{'User-Agent'} //= "Perl6-LWP-Simple/$VERSION";
 
-    if my @auth = self.has_basic_auth($hostname) {
-        $hostname = @auth[2];
-        my $user = @auth[0];
-        my $pass = @auth[1];
+    if $auth {
+        $hostname = $auth<host>;
+        my $user = $auth<user>;
+        my $pass = $auth<password>;
         my $base64enc = self.base64encode($user, $pass);
         %headers<Authorization> = "Basic $base64enc";
     }
 
     %headers<Host> = $hostname;
 
-    if ($content.defined) {
+    if ($rt ~~ RequestType::POST && $content.defined) {
         # Attach Content-Length header
         # as recommended in RFC2616 section 14.3.
         # Note: Empty content is also a content,
@@ -56,7 +67,7 @@ method get (Str $url, %headers = {}, Any $content?) {
     }
 
     my ($status, $resp_headers, $resp_content) =
-        self.make_request($hostname, $port, $path, %headers, $content);
+        self.make_request($rt, $hostname, $port, $path, %headers, $content);
 
     # Follow redirects. Shall we?
     if $status ~~ m/ 30 <[12]> / {
@@ -75,7 +86,7 @@ method get (Str $url, %headers = {}, Any $content?) {
         #    return;
         #}
 
-        return self.get($new_url);
+        return self.request_shell($rt, $new_url, %headers, $content);
     }
 
     # Response successful. Return the content as a scalar
@@ -125,12 +136,14 @@ method decode_chunked (@content) {
     return @content;
 }
 
-method make_request ($host, $port as Int, $path, %headers, $content?) {
+method make_request (
+    RequestType $rt, $host, $port as Int, $path, %headers, $content?
+) {
 
     my $headers = self.stringify_headers(%headers);
 
     my $sock = IO::Socket::INET.new(:$host, :$port);
-    my $req_str = "GET {$path} HTTP/1.1\r\n"
+    my $req_str = $rt.Stringy ~ " {$path} HTTP/1.1\r\n"
         ~ $headers
         ~ "\r\n";
 
@@ -191,8 +204,20 @@ method getstore (Str $url, Str $filename) {
 method parse_url (Str $url) {
     my $u = URI.new($url);
     my $path = $u.path_query;
-
-    return ($u.scheme, $u.host, $u.port, $path eq '' ?? '/' !! $path);	
+
+    my $user_info = $u.grammar.parse_result<URI_reference><URI><hier_part><authority><userinfo>;
+
+    return (
+        $u.scheme, 
+        $user_info ?? "{$user_info}@{$u.host}" !! $u.host, 
+        $u.port, 
+        $path eq '' ?? '/' !! $path,
+        $user_info ?? {
+            host => $u.host,
+            user => ~ $user_info[0]<likely_userinfo_component>[0],
+            password => ~ $user_info[0]<likely_userinfo_component>[1]
+        } !! Nil
+    );    
 }
 
 method stringify_headers (%headers) {

t/basic-auth.t

@@ -7,19 +7,17 @@ use Test;
 
 use LWP::Simple;
 
-my $basic-auth-url = 'https://cosimo:eelst@faveclub.eelst.com/elio/mp3s/';
+my $basic-auth-url = 'https://ron:Camelia@www.software-path.com/p6-lwp-simple/basic-auth/';
 my @url = LWP::Simple.parse_url($basic-auth-url);
 
 is(@url[0], 'https', 'Scheme parsed correctly');
-is(@url[1], 'cosimo:eelst@faveclub.eelst.com', 'Hostname contains basic auth info');
+is(@url[1], 'ron:Camelia@www.software-path.com', 'Hostname contains basic auth info');
 is(@url[2], 443, 'HTTPS demands port 443');
-is(@url[3], '/elio/mp3s/', 'Path extracted correctly');
+is(@url[3], '/p6-lwp-simple/basic-auth/', 'Path extracted correctly');
 
-my ($user, $pass, $host) = LWP::Simple.has_basic_auth(@url[1]);
-
-is($user, 'cosimo', 'Basic auth info extracted correctly: user');
-is($pass, 'eelst',  'Basic auth info extracted correctly: pass');
-is($host, 'faveclub.eelst.com',  'Basic auth info extracted correctly: hostname');
+is(@url[4]<user>, 'ron', 'Basic auth info extracted correctly: user');
+is(@url[4]<password>, 'Camelia',  'Basic auth info extracted correctly: pass');
+is(@url[4]<host>, 'www.software-path.com',  'Basic auth info extracted correctly: hostname');
 
 # Encode test
 is(
@@ -28,5 +26,10 @@ is(
     'Base64 encoding works'
 );
 
+$basic-auth-url ~~ s/^https/http/;
+my $html = LWP::Simple.get($basic-auth-url);
+ok($html.match('protected'), 'Got protected url');
+
+
 done;
 

t/custom-headers-and-content.t

@@ -3,17 +3,11 @@ use Test;
 
 use LWP::Simple;
 
-# This test uses live JSON-RPC demo service located at:
-# http://jsolait.net/services/test.jsonrpc
-
-my $host= 'http://jsolait.net/services/test.jsonrpc';
+my $host = 'http://www.software-path.com/was-cgi/json_rpc_server_test.cgi';
 my %headers = ( 'Content-Type' => 'application/json' );
 my $content = '{"method":"echo","params":["Hello from Perl6"],"id":1}';
 
-my $html = LWP::Simple.get($host, %headers, $content);
-
-# return line should looks like
-# {"id": 1, "result": "Hello from Perl6", "error": null}
+my $html = LWP::Simple.post($host, %headers, $content);
 
 ok(
     $html.match('Hello from Perl6'),