Leaked source code of windows server 2003
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

164 lines
4.0 KiB

  1. #
  2. # $Id: Request.pm,v 1.27 1999/11/17 20:38:14 gisle Exp $
  3. package HTTP::Request;
  4. =head1 NAME
  5. HTTP::Request - Class encapsulating HTTP Requests
  6. =head1 SYNOPSIS
  7. require HTTP::Request;
  8. $request = HTTP::Request->new(GET => 'http://www.oslonett.no/');
  9. =head1 DESCRIPTION
  10. C<HTTP::Request> is a class encapsulating HTTP style requests,
  11. consisting of a request line, some headers, and some (potentially empty)
  12. content. Note that the LWP library also uses this HTTP style requests
  13. for non-HTTP protocols.
  14. Instances of this class are usually passed to the C<request()> method
  15. of an C<LWP::UserAgent> object:
  16. $ua = LWP::UserAgent->new;
  17. $request = HTTP::Request->new(GET => 'http://www.oslonett.no/');
  18. $response = $ua->request($request);
  19. C<HTTP::Request> is a subclass of C<HTTP::Message> and therefore
  20. inherits its methods. The inherited methods most often used are header(),
  21. push_header(), remove_header(), headers_as_string() and content().
  22. See L<HTTP::Message> for details.
  23. The following additional methods are available:
  24. =over 4
  25. =cut
  26. require HTTP::Message;
  27. @ISA = qw(HTTP::Message);
  28. $VERSION = sprintf("%d.%02d", q$Revision: 1.27 $ =~ /(\d+)\.(\d+)/);
  29. use strict;
  30. =item $r = HTTP::Request->new($method, $uri, [$header, [$content]])
  31. Constructs a new C<HTTP::Request> object describing a request on the
  32. object C<$uri> using method C<$method>. The C<$uri> argument can be
  33. either a string, or a reference to a C<URI> object. The $header
  34. argument should be a reference to an C<HTTP::Headers> object.
  35. =cut
  36. sub new
  37. {
  38. my($class, $method, $uri, $header, $content) = @_;
  39. my $self = $class->SUPER::new($header, $content);
  40. $self->method($method);
  41. $self->uri($uri);
  42. $self;
  43. }
  44. sub clone
  45. {
  46. my $self = shift;
  47. my $clone = bless $self->SUPER::clone, ref($self);
  48. $clone->method($self->method);
  49. $clone->uri($self->uri);
  50. $clone;
  51. }
  52. =item $r->method([$val])
  53. =item $r->uri([$val])
  54. These methods provide public access to the attributes containing
  55. respectively the method of the request and the URI object of the
  56. request.
  57. If an argument is given the attribute is given that as its new
  58. value. If no argument is given the value is not touched. In either
  59. case the previous value is returned.
  60. The uri() method accept both a reference to a URI object and a
  61. string as its argument. If a string is given, then it should be
  62. parseable as an absolute URI.
  63. =cut
  64. sub method { shift->_elem('_method', @_); }
  65. sub uri
  66. {
  67. my $self = shift;
  68. my $old = $self->{'_uri'};
  69. if (@_) {
  70. my $uri = shift;
  71. if (!defined $uri) {
  72. # that's ok
  73. } elsif (ref $uri) {
  74. $uri = $uri->clone;
  75. unless ($HTTP::URI_CLASS eq "URI") {
  76. # Argh!! Hate this... old LWP legacy!
  77. eval { $uri = $uri->abs; };
  78. die $@ if $@ && $@ !~ /Missing base argument/;
  79. }
  80. } else {
  81. $uri = $HTTP::URI_CLASS->new($uri);
  82. }
  83. $self->{'_uri'} = $uri;
  84. }
  85. $old;
  86. }
  87. *url = \&uri; # this is the same for now
  88. =item $r->as_string()
  89. Method returning a textual representation of the request.
  90. Mainly useful for debugging purposes. It takes no arguments.
  91. =cut
  92. sub as_string
  93. {
  94. my $self = shift;
  95. my @result;
  96. #push(@result, "---- $self -----");
  97. my $req_line = $self->method || "[NO METHOD]";
  98. my $uri = $self->uri;
  99. $uri = (defined $uri) ? $uri->as_string : "[NO URI]";
  100. $req_line .= " $uri";
  101. my $proto = $self->protocol;
  102. $req_line .= " $proto" if $proto;
  103. push(@result, $req_line);
  104. push(@result, $self->headers_as_string);
  105. my $content = $self->content;
  106. if (defined $content) {
  107. push(@result, $content);
  108. }
  109. #push(@result, ("-" x 40));
  110. join("\n", @result, "");
  111. }
  112. 1;
  113. =back
  114. =head1 SEE ALSO
  115. L<HTTP::Headers>, L<HTTP::Message>, L<HTTP::Request::Common>
  116. =head1 COPYRIGHT
  117. Copyright 1995-1998 Gisle Aas.
  118. This library is free software; you can redistribute it and/or
  119. modify it under the same terms as Perl itself.
  120. =cut