home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / g-request.bat < prev    next >
Encoding:
DOS Batch File  |  2003-11-16  |  2.4 KB  |  107 lines
  1. @rem = '--*-Perl-*--
  2. @echo off
  3. if "%OS%" == "Windows_NT" goto WinNT
  4. perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
  5. goto endofperl
  6. :WinNT
  7. perl -x -S %0 %*
  8. if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
  9. if %errorlevel% == 9009 echo You do not have Perl in your PATH.
  10. if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
  11. goto endofperl
  12. @rem ';
  13. #!/usr/bin/perl -w
  14. #line 15
  15. use HTTP::GHTTP;
  16. use Getopt::Long;
  17. $|=1;
  18. use strict;
  19. use vars qw/$VERSION/;
  20.  
  21. $VERSION = '1.0';
  22.  
  23. my @getopt_args = qw(
  24.         p=s  P   H=s@   u   U
  25.         s    e      d   v
  26.         h    V
  27.         );
  28.  
  29. my %options;
  30.  
  31. Getopt::Long::config("noignorecase", "bundling");
  32. unless (GetOptions(\%options, @getopt_args)) {
  33.     usage();
  34. }
  35.  
  36. if ($options{V}) {
  37.     print <<EOT;
  38. This is g-request version $VERSION
  39.  
  40. Copyright 2000, AxKit.com Ltd
  41.  
  42. EOT
  43. }
  44.  
  45. usage() if $options{h} || !@ARGV;
  46.  
  47. $options{u} = 1 if $options{U};
  48.  
  49. unless($options{P}) {
  50.     $options{p} ||= $ENV{http_proxy};
  51. }
  52.  
  53. my $r = HTTP::GHTTP->new();
  54.  
  55. $r->set_header(Connection => 'close');
  56.  
  57. for my $extra_header (@{ $options{H} || [] }) {
  58.     my ($name, $value) = split /:\s*/, $extra_header, 2;
  59.     $r->set_header($name, $value);
  60. }
  61.  
  62. $r->set_proxy($ENV{http_proxy}) if $ENV{http_proxy} && !$options{P};
  63. $r->set_proxy($options{p}) if $options{p};
  64.  
  65. my $URI = shift @ARGV;
  66.  
  67. $r->set_uri($URI);
  68.  
  69. $r->process_request();
  70.  
  71. if ($options{e}) {
  72.     eval {
  73.         my @headers = $r->get_headers;
  74.         print join("\n", map { "$_: " . $r->get_header($_) } @headers), "\n\n";
  75.     };
  76.     if ($@) {
  77.         warn $@, "\n", "get_headers (and thus -e) only available in libghttp 1.08 and higher";
  78.     }
  79. }
  80.  
  81. unless ($options{d}) {
  82.     print $r->get_body();
  83. }
  84.  
  85. sub usage {
  86.     print <<EOT;
  87. Usage: g-request [-options] <url>
  88.     -p <proxy>    Use this as a proxy server
  89.     -P            Don't pick up proxy settings from environment
  90.     -H <header>   Send this HTTP header (you can specify several)
  91.     -u            Display method and URL before any response
  92.     -U            Display request headers (implies -u)
  93.     -s            Display response status code
  94.     -e            Display response headers
  95.     -d            Do not display content
  96.     -v            Be verbose
  97.     -h            Print this help message
  98.     -V            Show program version
  99. EOT
  100.     exit; #'
  101. }
  102.  
  103. exit(0);
  104.  
  105. __END__
  106. :endofperl
  107.