view release on metacpan or  search on metacpan

ext/libwww-perl/lib/LWP/Simple.pm  view on Meta::CPAN

            ("X-LWP-HTTP-Status: $code", (split rx:P5/\x0D?\x0A/, $head)).map:{
                m:P5/^(.*?): (.*)/;
                ($0 => ~$1)
            }
        }
        default {
            ~$head
        }
    }
  };
};

# Unify with URI.pm
sub split_uri (Str $url) {
  $url ~~ rx:P5"^http://([^/:\@]+)(?::(\d+))?(/\S*)?$"; #/#--vim

  my ($host) = $0;
  my ($port) = $1 || 80;
  my ($path) = $2 || "/";

  return ($host,$port,$path);
};

sub _trivial_http_get (Str $url) returns Str {
  # TODO: Set a timeout of 60 seconds (however)
  # TODO: Send Connection: close, at least until we know better
  my ($h,$p,$u) = split_uri($url);

  my $req = _make_request( "GET", $url );
  my $hdl = _send_request( $h, $p, $req );

  # read response+headers:
  # $hdl.irs = /$CRLF$CRLF/; # <-- make this into a todo test

  my $buffer = slurp $hdl;
  # 1 while ( $buffer ~= $hdl.read() and $buffer !~~ rx:P5"$CRLF$CRLF" );
  # my ($status,@headers) = split /$CRLF/, $buffer;
  # worry later about large body

  # strip away status and headers
  # This should all be done better so the response doesn't live in
  # memory all at once

  # if ($buffer ~~ s:P5"^HTTP\/\d+\.\d+\s+(\d+)([^\012]*?\x0D?\x0A)+?\x0D?\x0A"") {
  if ($buffer ~~ s:P5"^HTTP\/\d+\.\d+\s+(\d+)([^\x0A]*?\x0D?\x0A)+?\x0D?\x0A"") {
    my $code = $0;

    # XXX: Add 30[1237] checking/recursion

    if ($code ~~ rx:P5/^[^2]../) {  # /#--vim
       return ();
    };

    # Later add Content-Size: handling here
  };
  return $buffer
}

sub _make_request (Str $method, Str $uri) {
  my ($h,$p,$u) = split_uri($uri);
  if (%*ENV<HTTP_PROXY>) {
    $u = $uri;
  };

  join "\n", # $CRLF,
    "$method $u HTTP/1.0",
    "Host: $h",
    "User-Agent: lwp-trivial-pugs/$VERSION",
    "Connection: close",
    $CRLF;
};

sub _send_request (Str $host, Int $port, Str $request) {
  # XXX clean up!

  my ($h,$p) = ($host,$port);
  my $http_proxy = %*ENV<HTTP_PROXY> // %*ENV<http_proxy>;
  if $http_proxy.chars {
    if $http_proxy ~~ rx:P5!http://()(:(\d+))?$! {
      $h = $0;
      $p = $1 || 80;
    } else {
      die "Unhandled/unknown proxy settings: \"$http_proxy\"";
    }
  }

  my $hdl = connect $h, $p;
  $hdl.print($request);
  $hdl.flush;
  $hdl;
};

=pod

=head1 NAME

LWP::Simple - simple procedural interface to LWP

=head1 SYNOPSIS

  pugs -MLWP::Simple -e 'getprint "http://www.sn.no"'

  require LWP::Simple;
  $content = get("http://www.sn.no/");
  die "Couldn't get it!" unless defined $content;

  if (mirror("http://www.sn.no/", "foo") == ???) {
     ...
  }

  if (getprint("http://www.sn.no/")) {
     ...
  }

=head1 DESCRIPTION

This module is meant for people who want a simplified view of the
libwww-perl library.  It should also be suitable for one-liners.  If
you need more control or access to the header fields in the requests
sent and responses received, then you should use the full object-oriented
interface provided by the C<LWP::UserAgent> module.

The following functions are provided (and exported) by this module:

=over 3

=item get($url)

The get() function will fetch the document identified by the given URL
and return it.  It returns C<undef> if it fails.  The $url argument can
be either a simple string or a reference to a URI object.

You will not be able to examine the response code or response headers
(like 'Content-Type') when you are accessing the web using this
function.  If you need that information you should use the full OO
interface (see L<LWP::UserAgent>).